Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/abort_gcm.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/abort_gcm.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/abort_gcm.F90	(revision 5116)
@@ -19,9 +19,9 @@
   !     ierr    = severity of situation ( = 0 normal )
 
-  character(len = *), intent(in) :: modname
+  CHARACTER(LEN = *), intent(in) :: modname
   integer, intent(in) :: ierr
-  character(len = *), intent(in) :: message
+  CHARACTER(LEN = *), intent(in) :: message
 
-  write(lunout, *) 'in abort_gcm'
+  WRITE(lunout, *) 'in abort_gcm'
 
   IF (using_xios) THEN
@@ -33,11 +33,11 @@
   CALL restclo
   CALL getin_dump
-  write(lunout, *) 'Stopping in ', modname
-  write(lunout, *) 'Reason = ', message
-  if (ierr == 0) then
-    write(lunout, *) 'Everything is cool'
+  WRITE(lunout, *) 'Stopping in ', modname
+  WRITE(lunout, *) 'Reason = ', message
+  if (ierr == 0) THEN
+    WRITE(lunout, *) 'Everything is cool'
     stop
   else
-    write(lunout, *) 'Houston, we have a problem, ierr = ', ierr
+    WRITE(lunout, *) 'Houston, we have a problem, ierr = ', ierr
     stop 1
   endif
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/addfi.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/addfi.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/addfi.F90	(revision 5116)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90	(revision 5116)
@@ -15,4 +15,5 @@
   USE strings_mod, ONLY: int2str
   USE lmdz_description, ONLY: descript
+  USE lmdz_libmath, ONLY: minmax
 
   IMPLICIT NONE
@@ -49,5 +50,4 @@
   REAL, DIMENSION(ip1jmp1, llm) :: pbaruc, pbarug, massem, wg
   REAL, DIMENSION(ip1jm, llm) :: pbarvc, pbarvg
-  EXTERNAL  minmax
   SAVE massem, pbaruc, pbarvc
   !---------------------------------------------------------------------------
@@ -129,5 +129,5 @@
   ! Calcul des criteres CFL en X, Y et Z
   !-------------------------------------------------------------------------
-  IF(countcfl == 0.) then
+  IF(countcfl == 0.) THEN
     cflxmax(:) = 0.
     cflymax(:) = 0.
@@ -141,5 +141,5 @@
   DO l = 1, llm
     DO ij = iip2, ip1jm - 1
-      IF(pbarug(ij, l)>=0.) then
+      IF(pbarug(ij, l)>=0.) THEN
         cflx(ij, l) = pbarug(ij, l) * dtvr / masse(ij, l)
       ELSE
@@ -157,5 +157,5 @@
   DO l = 1, llm
     DO ij = 1, ip1jm
-      IF(pbarvg(ij, l)>=0.) then
+      IF(pbarvg(ij, l)>=0.) THEN
         cfly(ij, l) = pbarvg(ij, l) * dtvr / masse(ij, l)
       ELSE
@@ -184,7 +184,7 @@
   ! Par defaut, on sort le diagnostic des CFL tous les jours.
   ! Si on veut le sortir a chaque pas d'advection en cas de plantage
-  !       IF(countcfl==iapp_tracvl) then
+  !       IF(countcfl==iapp_tracvl) THEN
   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  IF(countcfl==day_step) then
+  IF(countcfl==day_step) THEN
     DO l = 1, llm
       WRITE(lunout, *) 'L, CFL[xyz]max:', l, cflxmax(l), cflymax(l), cflzmax(l)
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/bilan_dyn.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/bilan_dyn.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/bilan_dyn.F90	(revision 5116)
@@ -36,24 +36,24 @@
   !   ===========
 
-  integer :: ntrac
-  real :: dt_app, dt_cum
-  real :: ps(iip1, jjp1)
-  real :: masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)
-  real :: flux_u(iip1, jjp1, llm)
-  real :: flux_v(iip1, jjm, llm)
-  real :: teta(iip1, jjp1, llm)
-  real :: phi(iip1, jjp1, llm)
-  real :: ucov(iip1, jjp1, llm)
-  real :: vcov(iip1, jjm, llm)
-  real :: trac(iip1, jjp1, llm, ntrac)
+  INTEGER :: ntrac
+  REAL :: dt_app, dt_cum
+  REAL :: ps(iip1, jjp1)
+  REAL :: masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)
+  REAL :: flux_u(iip1, jjp1, llm)
+  REAL :: flux_v(iip1, jjm, llm)
+  REAL :: teta(iip1, jjp1, llm)
+  REAL :: phi(iip1, jjp1, llm)
+  REAL :: ucov(iip1, jjp1, llm)
+  REAL :: vcov(iip1, jjm, llm)
+  REAL :: trac(iip1, jjp1, llm, ntrac)
 
   !   Local :
   !   =======
 
-  integer :: icum, ncum
+  INTEGER :: icum, ncum
   logical :: first
-  real :: zz, zqy, zfactv(jjm, llm)
-
-  integer :: nQ
+  REAL :: zz, zqy, zfactv(jjm, llm)
+
+  INTEGER :: nQ
   parameter (nQ = 7)
 
@@ -64,10 +64,10 @@
   character*6, save :: unites(nQ)
 
-  character(len = 10) :: file
-  integer :: ifile
+  CHARACTER(LEN = 10) :: file
+  INTEGER :: ifile
   parameter (ifile = 4)
 
-  integer :: itemp, igeop, iecin, iang, iu, iovap, iun
-  integer :: i_sortie
+  INTEGER :: itemp, igeop, iecin, iang, iu, iovap, iun
+  INTEGER :: i_sortie
 
   save first, icum, ncum
@@ -75,6 +75,6 @@
   save i_sortie
 
-  real :: time
-  integer :: itau
+  REAL :: time
+  INTEGER :: itau
   save time, itau
   data time, itau/0., 0/
@@ -84,5 +84,5 @@
   data i_sortie/1/
 
-  real :: ww
+  REAL :: ww
 
   !   variables dynamiques intermédiaires
@@ -95,16 +95,16 @@
 
   !   champ contenant les scalaires advectés.
-  real :: Q(iip1, jjp1, llm, nQ)
+  REAL :: Q(iip1, jjp1, llm, nQ)
 
   !   champs cumulés
-  real :: ps_cum(iip1, jjp1)
-  real :: masse_cum(iip1, jjp1, llm)
-  real :: flux_u_cum(iip1, jjp1, llm)
-  real :: flux_v_cum(iip1, jjm, llm)
-  real :: Q_cum(iip1, jjp1, llm, nQ)
-  real :: flux_uQ_cum(iip1, jjp1, llm, nQ)
-  real :: flux_vQ_cum(iip1, jjm, llm, nQ)
-  real :: flux_wQ_cum(iip1, jjp1, llm, nQ)
-  real :: dQ(iip1, jjp1, llm, nQ)
+  REAL :: ps_cum(iip1, jjp1)
+  REAL :: masse_cum(iip1, jjp1, llm)
+  REAL :: flux_u_cum(iip1, jjp1, llm)
+  REAL :: flux_v_cum(iip1, jjm, llm)
+  REAL :: Q_cum(iip1, jjp1, llm, nQ)
+  REAL :: flux_uQ_cum(iip1, jjp1, llm, nQ)
+  REAL :: flux_vQ_cum(iip1, jjm, llm, nQ)
+  REAL :: flux_wQ_cum(iip1, jjp1, llm, nQ)
+  REAL :: dQ(iip1, jjp1, llm, nQ)
 
   save ps_cum, masse_cum, flux_u_cum, flux_v_cum
@@ -112,5 +112,5 @@
 
   !   champs de tansport en moyenne zonale
-  integer :: ntr, itr
+  INTEGER :: ntr, itr
   parameter (ntr = 5)
 
@@ -122,16 +122,16 @@
   character*10, save :: zunites(ntr, nQ)
 
-  integer :: iave, itot, immc, itrs, istn
+  INTEGER :: iave, itot, immc, itrs, istn
   data iave, itot, immc, itrs, istn/1, 2, 3, 4, 5/
-  character(len = 3) :: ctrs(ntr)
+  CHARACTER(LEN = 3) :: ctrs(ntr)
   data ctrs/'  ', 'TOT', 'MMC', 'TRS', 'STN'/
 
-  real :: zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)
-  real :: zavQ(jjm, ntr, nQ), psiQ(jjm, llm + 1, nQ)
-  real :: zmasse(jjm, llm), zamasse(jjm)
-
-  real :: zv(jjm, llm), psi(jjm, llm + 1)
-
-  integer :: i, j, l, iQ
+  REAL :: zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)
+  REAL :: zavQ(jjm, ntr, nQ), psiQ(jjm, llm + 1, nQ)
+  REAL :: zmasse(jjm, llm), zamasse(jjm)
+
+  REAL :: zv(jjm, llm), psi(jjm, llm + 1)
+
+  INTEGER :: i, j, l, iQ
 
 
@@ -139,22 +139,22 @@
   !   ---------------------------------------------------------
 
-  character(len = 10) :: infile
-
-  integer :: fileid
-  integer :: thoriid, zvertiid
+  CHARACTER(LEN = 10) :: infile
+
+  INTEGER :: fileid
+  INTEGER :: thoriid, zvertiid
   save fileid
 
-  integer :: ndex3d(jjm * llm)
+  INTEGER :: ndex3d(jjm * llm)
 
   !   Variables locales
   !
-  integer :: tau0
-  real :: zjulian
-  character(len = 3) :: str
-  character(len = 10) :: ctrac
-  integer :: ii, jj
-  integer :: zan, dayref
-  !
-  real :: rlong(jjm), rlatg(jjm)
+  INTEGER :: tau0
+  REAL :: zjulian
+  CHARACTER(LEN = 3) :: str
+  CHARACTER(LEN = 10) :: ctrac
+  INTEGER :: ii, jj
+  INTEGER :: zan, dayref
+  !
+  REAL :: rlong(jjm), rlatg(jjm)
 
 
@@ -169,6 +169,5 @@
   ndex3d = 0
 
-  if (first) then
-
+  if (first) THEN
     icum = 0
     ! initialisation des fichiers
@@ -176,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'
@@ -184,5 +183,5 @@
     endif
 
-    if (i_sortie==1) then
+    if (i_sortie==1) THEN
       file = 'dynzon'
       CALL inigrads(ifile, 1 &
@@ -235,5 +234,5 @@
     do iQ = 1, nQ
       do itr = 1, ntr
-        if(itr==1) then
+        IF(itr==1) THEN
           znom(itr, iQ) = nom(iQ)
           znoml(itr, iQ) = nom(iQ)
@@ -327,5 +326,5 @@
   !=====================================================================
   !
-  if(icum==0) then
+  IF(icum==0) THEN
     ps_cum = 0.
     masse_cum = 0.
@@ -408,5 +407,5 @@
   !   PAS DE TEMPS D'ECRITURE
   !=====================================================================
-  if (icum==ncum) then
+  if (icum==ncum) THEN
     !=====================================================================
 
@@ -529,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
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90	(revision 5116)
@@ -30,5 +30,5 @@
   REAL :: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm), masse(ip1jmp1, llm)
   REAL :: p(ip1jmp1, llmp1), q(ip1jmp1, llm, nqtot)
-  real :: dq(ip1jmp1, llm, nqtot)
+  REAL :: dq(ip1jmp1, llm, nqtot)
   REAL :: teta(ip1jmp1, llm), pk(ip1jmp1, llm)
   REAL :: flxw(ip1jmp1, llm)
@@ -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
@@ -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)
       !
@@ -84,7 +84,7 @@
       ENDDO
 
-      !write(*,*) 'caladvtrac 87'
+      !WRITE(*,*) 'caladvtrac 87'
       CALL qminimum(q, nqtot, finmasse)
-      !write(*,*) 'caladvtrac 89'
+      !WRITE(*,*) 'caladvtrac 89'
 
       CALL SCOPY   (ip1jmp1 * llm, masse, 1, finmasse, 1)
@@ -107,5 +107,5 @@
     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.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/check_isotopes.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/check_isotopes.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/check_isotopes.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/conf_gcm.f90	(revision 5116)
@@ -6,5 +6,5 @@
   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, &
@@ -414,5 +414,5 @@
 
     IF(ABS(clat - clatt)>= 0.001)  THEN
-      write(lunout, *)'conf_gcm: La valeur de clat passee par run.def', &
+      WRITE(lunout, *)'conf_gcm: La valeur de clat passee par run.def', &
               ' est differente de celle lue sur le fichier  start '
       CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -428,5 +428,5 @@
 
     IF(ABS(grossismx - grossismxx)>= 0.001)  THEN
-      write(lunout, *)'conf_gcm: La valeur de grossismx passee par ', &
+      WRITE(lunout, *)'conf_gcm: La valeur de grossismx passee par ', &
               'run.def est differente de celle lue sur le fichier  start '
       CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -442,5 +442,5 @@
 
     IF(ABS(grossismy - grossismyy)>= 0.001)  THEN
-      write(lunout, *)'conf_gcm: La valeur de grossismy passee par ', &
+      WRITE(lunout, *)'conf_gcm: La valeur de grossismy passee par ', &
               'run.def est differente de celle lue sur le fichier  start '
       CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -448,5 +448,5 @@
 
     IF(grossismx<1.)  THEN
-      write(lunout, *) &
+      WRITE(lunout, *) &
               'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
       CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -456,5 +456,5 @@
 
     IF(grossismy<1.)  THEN
-      write(lunout, *) &
+      WRITE(lunout, *) &
               'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
       CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -463,5 +463,5 @@
     ENDIF
 
-    write(lunout, *)'conf_gcm: alphax alphay', alphax, alphay
+    WRITE(lunout, *)'conf_gcm: alphax alphay', alphax, alphay
 
     !    alphax et alphay sont les anciennes formulat. des grossissements
@@ -477,6 +477,6 @@
     IF(.NOT.fxyhypb)  THEN
       IF(fxyhypbb)     THEN
-        write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
-        write(lunout, *)' *** fxyhypb lu sur le fichier start est ', &
+        WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
+        WRITE(lunout, *)' *** fxyhypb lu sur le fichier start est ', &
                 'F alors  qu il est  T  sur  run.def  ***'
         CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -484,6 +484,6 @@
     ELSE
       IF(.NOT.fxyhypbb)   THEN
-        write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
-        write(lunout, *)' ***  fxyhypb lu sur le fichier start est ', &
+        WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
+        WRITE(lunout, *)' ***  fxyhypb lu sur le fichier start est ', &
                 'T alors  qu il est  F  sur  run.def  ****  '
         CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -501,5 +501,5 @@
     IF(fxyhypb)  THEN
       IF(ABS(dzoomx - dzoomxx)>= 0.001)  THEN
-        write(lunout, *)'conf_gcm: La valeur de dzoomx passee par ', &
+        WRITE(lunout, *)'conf_gcm: La valeur de dzoomx passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -517,5 +517,5 @@
     IF(fxyhypb)  THEN
       IF(ABS(dzoomy - dzoomyy)>= 0.001)  THEN
-        write(lunout, *)'conf_gcm: La valeur de dzoomy passee par ', &
+        WRITE(lunout, *)'conf_gcm: La valeur de dzoomy passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -532,5 +532,5 @@
     IF(fxyhypb)  THEN
       IF(ABS(taux - tauxx)>= 0.001)  THEN
-        write(lunout, *)'conf_gcm: La valeur de taux passee par ', &
+        WRITE(lunout, *)'conf_gcm: La valeur de taux passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -547,5 +547,5 @@
     IF(fxyhypb)  THEN
       IF(ABS(tauy - tauyy)>= 0.001)  THEN
-        write(lunout, *)'conf_gcm: La valeur de tauy passee par ', &
+        WRITE(lunout, *)'conf_gcm: La valeur de tauy passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -567,6 +567,6 @@
       IF(.NOT.ysinus)  THEN
         IF(ysinuss)     THEN
-          write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
-          write(lunout, *)' *** ysinus lu sur le fichier start est F', &
+          WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
+          WRITE(lunout, *)' *** ysinus lu sur le fichier start est F', &
                   ' alors  qu il est  T  sur  run.def  ***'
           CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -574,6 +574,6 @@
       ELSE
         IF(.NOT.ysinuss)   THEN
-          write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
-          write(lunout, *)' *** ysinus lu sur le fichier start est T', &
+          WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
+          WRITE(lunout, *)' *** ysinus lu sur le fichier start est T', &
                   ' alors  qu il est  F  sur  run.def  ****  '
           CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -634,46 +634,46 @@
     CALL getin('ok_dyn_ave', ok_dyn_ave)
 
-    write(lunout, *)' #########################################'
-    write(lunout, *)' Configuration des parametres du gcm: '
-    write(lunout, *)' planet_type = ', planet_type
-    write(lunout, *)' calend = ', calend
-    write(lunout, *)' dayref = ', dayref
-    write(lunout, *)' anneeref = ', anneeref
-    write(lunout, *)' nday = ', nday
-    write(lunout, *)' day_step = ', day_step
-    write(lunout, *)' iperiod = ', iperiod
-    write(lunout, *)' nsplit_phys = ', nsplit_phys
-    write(lunout, *)' iconser = ', iconser
-    write(lunout, *)' iecri = ', iecri
-    write(lunout, *)' periodav = ', periodav
-    write(lunout, *)' output_grads_dyn = ', output_grads_dyn
-    write(lunout, *)' dissip_period = ', dissip_period
-    write(lunout, *)' lstardis = ', lstardis
-    write(lunout, *)' nitergdiv = ', nitergdiv
-    write(lunout, *)' nitergrot = ', nitergrot
-    write(lunout, *)' niterh = ', niterh
-    write(lunout, *)' tetagdiv = ', tetagdiv
-    write(lunout, *)' tetagrot = ', tetagrot
-    write(lunout, *)' tetatemp = ', tetatemp
-    write(lunout, *)' coefdis = ', coefdis
-    write(lunout, *)' purmats = ', purmats
-    write(lunout, *)' read_start = ', read_start
-    write(lunout, *)' iflag_phys = ', iflag_phys
-    write(lunout, *)' iphysiq = ', iphysiq
-    write(lunout, *)' clonn = ', clonn
-    write(lunout, *)' clatt = ', clatt
-    write(lunout, *)' grossismx = ', grossismx
-    write(lunout, *)' grossismy = ', grossismy
-    write(lunout, *)' fxyhypbb = ', fxyhypbb
-    write(lunout, *)' dzoomxx = ', dzoomxx
-    write(lunout, *)' dzoomy = ', dzoomyy
-    write(lunout, *)' tauxx = ', tauxx
-    write(lunout, *)' tauyy = ', tauyy
-    write(lunout, *)' offline = ', offline
-    write(lunout, *)' type_trac = ', type_trac
-    write(lunout, *)' ok_dynzon = ', ok_dynzon
-    write(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
-    write(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
-    write(lunout, *)' adv_qsat_liq = ', adv_qsat_liq
+    WRITE(lunout, *)' #########################################'
+    WRITE(lunout, *)' Configuration des parametres du gcm: '
+    WRITE(lunout, *)' planet_type = ', planet_type
+    WRITE(lunout, *)' calend = ', calend
+    WRITE(lunout, *)' dayref = ', dayref
+    WRITE(lunout, *)' anneeref = ', anneeref
+    WRITE(lunout, *)' nday = ', nday
+    WRITE(lunout, *)' day_step = ', day_step
+    WRITE(lunout, *)' iperiod = ', iperiod
+    WRITE(lunout, *)' nsplit_phys = ', nsplit_phys
+    WRITE(lunout, *)' iconser = ', iconser
+    WRITE(lunout, *)' iecri = ', iecri
+    WRITE(lunout, *)' periodav = ', periodav
+    WRITE(lunout, *)' output_grads_dyn = ', output_grads_dyn
+    WRITE(lunout, *)' dissip_period = ', dissip_period
+    WRITE(lunout, *)' lstardis = ', lstardis
+    WRITE(lunout, *)' nitergdiv = ', nitergdiv
+    WRITE(lunout, *)' nitergrot = ', nitergrot
+    WRITE(lunout, *)' niterh = ', niterh
+    WRITE(lunout, *)' tetagdiv = ', tetagdiv
+    WRITE(lunout, *)' tetagrot = ', tetagrot
+    WRITE(lunout, *)' tetatemp = ', tetatemp
+    WRITE(lunout, *)' coefdis = ', coefdis
+    WRITE(lunout, *)' purmats = ', purmats
+    WRITE(lunout, *)' read_start = ', read_start
+    WRITE(lunout, *)' iflag_phys = ', iflag_phys
+    WRITE(lunout, *)' iphysiq = ', iphysiq
+    WRITE(lunout, *)' clonn = ', clonn
+    WRITE(lunout, *)' clatt = ', clatt
+    WRITE(lunout, *)' grossismx = ', grossismx
+    WRITE(lunout, *)' grossismy = ', grossismy
+    WRITE(lunout, *)' fxyhypbb = ', fxyhypbb
+    WRITE(lunout, *)' dzoomxx = ', dzoomxx
+    WRITE(lunout, *)' dzoomy = ', dzoomyy
+    WRITE(lunout, *)' tauxx = ', tauxx
+    WRITE(lunout, *)' tauyy = ', tauyy
+    WRITE(lunout, *)' offline = ', offline
+    WRITE(lunout, *)' type_trac = ', type_trac
+    WRITE(lunout, *)' ok_dynzon = ', ok_dynzon
+    WRITE(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
+    WRITE(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
+    WRITE(lunout, *)' adv_qsat_liq = ', adv_qsat_liq
   ELSE
     !Config  Key  = clon
@@ -710,5 +710,5 @@
 
     IF(grossismx<1.)  THEN
-      write(lunout, *) &
+      WRITE(lunout, *) &
               'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
       CALL abort_gcm("conf_gcm", "stopped", 1)
@@ -718,5 +718,5 @@
 
     IF(grossismy<1.)  THEN
-      write(lunout, *) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
+      WRITE(lunout, *) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
       CALL abort_gcm("conf_gcm", "stopped", 1)
     ELSE
@@ -724,5 +724,5 @@
     ENDIF
 
-    write(lunout, *)'conf_gcm: alphax alphay ', alphax, alphay
+    WRITE(lunout, *)'conf_gcm: alphax alphay ', alphax, alphay
 
     !    alphax et alphay sont les anciennes formulat. des grossissements
@@ -865,50 +865,50 @@
     CALL getin('read_orop', read_orop)
 
-    write(lunout, *)' #########################################'
-    write(lunout, *)' Configuration des parametres de cel0_limit: '
-    write(lunout, *)' planet_type = ', planet_type
-    write(lunout, *)' calend = ', calend
-    write(lunout, *)' dayref = ', dayref
-    write(lunout, *)' anneeref = ', anneeref
-    write(lunout, *)' nday = ', nday
-    write(lunout, *)' day_step = ', day_step
-    write(lunout, *)' iperiod = ', iperiod
-    write(lunout, *)' iconser = ', iconser
-    write(lunout, *)' iecri = ', iecri
-    write(lunout, *)' periodav = ', periodav
-    write(lunout, *)' output_grads_dyn = ', output_grads_dyn
-    write(lunout, *)' dissip_period = ', dissip_period
-    write(lunout, *)' lstardis = ', lstardis
-    write(lunout, *)' nitergdiv = ', nitergdiv
-    write(lunout, *)' nitergrot = ', nitergrot
-    write(lunout, *)' niterh = ', niterh
-    write(lunout, *)' tetagdiv = ', tetagdiv
-    write(lunout, *)' tetagrot = ', tetagrot
-    write(lunout, *)' tetatemp = ', tetatemp
-    write(lunout, *)' coefdis = ', coefdis
-    write(lunout, *)' purmats = ', purmats
-    write(lunout, *)' read_start = ', read_start
-    write(lunout, *)' iflag_phys = ', iflag_phys
-    write(lunout, *)' iphysiq = ', iphysiq
-    write(lunout, *)' clon = ', clon
-    write(lunout, *)' clat = ', clat
-    write(lunout, *)' grossismx = ', grossismx
-    write(lunout, *)' grossismy = ', grossismy
-    write(lunout, *)' fxyhypb = ', fxyhypb
-    write(lunout, *)' dzoomx = ', dzoomx
-    write(lunout, *)' dzoomy = ', dzoomy
-    write(lunout, *)' taux = ', taux
-    write(lunout, *)' tauy = ', tauy
-    write(lunout, *)' offline = ', offline
-    write(lunout, *)' type_trac = ', type_trac
-    write(lunout, *)' ok_dynzon = ', ok_dynzon
-    write(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
-    write(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
-    write(lunout, *)' ok_strato = ', ok_strato
-    write(lunout, *)' ok_gradsfile = ', ok_gradsfile
-    write(lunout, *)' ok_limit = ', ok_limit
-    write(lunout, *)' ok_etat0 = ', ok_etat0
-    write(lunout, *)' ok_guide = ', ok_guide
-    write(lunout, *)' read_orop = ', read_orop
+    WRITE(lunout, *)' #########################################'
+    WRITE(lunout, *)' Configuration des parametres de cel0_limit: '
+    WRITE(lunout, *)' planet_type = ', planet_type
+    WRITE(lunout, *)' calend = ', calend
+    WRITE(lunout, *)' dayref = ', dayref
+    WRITE(lunout, *)' anneeref = ', anneeref
+    WRITE(lunout, *)' nday = ', nday
+    WRITE(lunout, *)' day_step = ', day_step
+    WRITE(lunout, *)' iperiod = ', iperiod
+    WRITE(lunout, *)' iconser = ', iconser
+    WRITE(lunout, *)' iecri = ', iecri
+    WRITE(lunout, *)' periodav = ', periodav
+    WRITE(lunout, *)' output_grads_dyn = ', output_grads_dyn
+    WRITE(lunout, *)' dissip_period = ', dissip_period
+    WRITE(lunout, *)' lstardis = ', lstardis
+    WRITE(lunout, *)' nitergdiv = ', nitergdiv
+    WRITE(lunout, *)' nitergrot = ', nitergrot
+    WRITE(lunout, *)' niterh = ', niterh
+    WRITE(lunout, *)' tetagdiv = ', tetagdiv
+    WRITE(lunout, *)' tetagrot = ', tetagrot
+    WRITE(lunout, *)' tetatemp = ', tetatemp
+    WRITE(lunout, *)' coefdis = ', coefdis
+    WRITE(lunout, *)' purmats = ', purmats
+    WRITE(lunout, *)' read_start = ', read_start
+    WRITE(lunout, *)' iflag_phys = ', iflag_phys
+    WRITE(lunout, *)' iphysiq = ', iphysiq
+    WRITE(lunout, *)' clon = ', clon
+    WRITE(lunout, *)' clat = ', clat
+    WRITE(lunout, *)' grossismx = ', grossismx
+    WRITE(lunout, *)' grossismy = ', grossismy
+    WRITE(lunout, *)' fxyhypb = ', fxyhypb
+    WRITE(lunout, *)' dzoomx = ', dzoomx
+    WRITE(lunout, *)' dzoomy = ', dzoomy
+    WRITE(lunout, *)' taux = ', taux
+    WRITE(lunout, *)' tauy = ', tauy
+    WRITE(lunout, *)' offline = ', offline
+    WRITE(lunout, *)' type_trac = ', type_trac
+    WRITE(lunout, *)' ok_dynzon = ', ok_dynzon
+    WRITE(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
+    WRITE(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
+    WRITE(lunout, *)' ok_strato = ', ok_strato
+    WRITE(lunout, *)' ok_gradsfile = ', ok_gradsfile
+    WRITE(lunout, *)' ok_limit = ', ok_limit
+    WRITE(lunout, *)' ok_etat0 = ', ok_etat0
+    WRITE(lunout, *)' ok_guide = ', ok_guide
+    WRITE(lunout, *)' read_orop = ', read_orop
   ENDIF test_etatinit
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90	(revision 5116)
@@ -157,8 +157,8 @@
       iqParent = tracers(iq)%iqParent
       IF(tracers(iq)%iso_iZone == 0) THEN
-         if (tnat1) then
+         if (tnat1) THEN
                  tnat=1.0
                  alpha_ideal=1.0
-                 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
+                 WRITE(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
          else
           IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/fluxstokenc.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/fluxstokenc.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/fluxstokenc.F90	(revision 5116)
@@ -31,9 +31,9 @@
 
   REAL :: pbarvst(iip1, jjp1, llm), zistdyn
-  real :: dtcum
+  REAL :: dtcum
 
   INTEGER :: iadvtr, ndex(1)
-  integer :: nscal
-  real :: tst(1), ist(1), istp(1)
+  INTEGER :: nscal
+  REAL :: tst(1), ist(1), istp(1)
   INTEGER :: ij, l, irec, i, j, itau
   INTEGER, SAVE :: fluxid, fluxvid, fluxdid
@@ -52,6 +52,5 @@
   wg(:, :) = 0.
 
-  if(first) then
-
+  IF(first) THEN
     CALL initfluxsto('fluxstoke', &
             time_step, istdyn * time_step, istdyn * time_step, &
@@ -134,5 +133,5 @@
 
     iadvtr = 0
-    write(lunout, *)'ITAU auquel on stoke les fluxmasses', itau
+    WRITE(lunout, *)'ITAU auquel on stoke les fluxmasses', itau
 
     CALL histwrite(fluxid, 'masse', itau, massem, &
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F90	(revision 5116)
@@ -47,7 +47,7 @@
     ! 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
+      WRITE(lunout, *)'Friction: wrong friction type', friction_type
       CALL abort_gcm(modname, abort_message, 42)
     endif
@@ -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
@@ -118,5 +118,5 @@
   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))
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90	(revision 5116)
@@ -167,13 +167,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'
-  else if (calend == 'earth_365d') then
+     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
+  else if (calend == 'earth_365d') THEN
      CALL ioconf_calendar('noleap')
-     write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-  else if (calend == 'gregorian') then
+     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
+  else if (calend == 'gregorian') THEN
      CALL ioconf_calendar('gregorian')
-     write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
+     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
   else
      abort_message = 'Mauvais choix de calendrier'
@@ -203,12 +203,12 @@
 
   !  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, &
@@ -216,9 +216,9 @@
      !        endif ! of if (planet_type.eq."earth")
 
-     !       write(73,*) 'ucov',ucov
-     !       write(74,*) 'vcov',vcov
-     !       write(75,*) 'teta',teta
-     !       write(76,*) 'ps',ps
-     !       write(77,*) 'q',q
+     !       WRITE(73,*) 'ucov',ucov
+     !       WRITE(74,*) 'vcov',vcov
+     !       WRITE(75,*) 'teta',teta
+     !       WRITE(76,*) 'ps',ps
+     !       WRITE(77,*) 'q',q
 
   endif ! of if (read_start)
@@ -228,5 +228,5 @@
   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
@@ -260,8 +260,8 @@
   ! on remet le calendrier \`a zero si demande
 
-  IF (start_time /= starttime) then
+  IF (start_time /= starttime) THEN
      WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
           ,' fichier restart ne correspond pas a celle lue dans le run.def'
-     IF (raz_date == 1) then
+     IF (raz_date == 1) THEN
         WRITE(lunout,*)'Je prends l''heure lue dans run.def'
         start_time = starttime
@@ -277,27 +277,27 @@
      itau_phy = 0
      time_0 = 0.
-     write(lunout,*) &
+     WRITE(lunout,*) &
           'GCM: On reinitialise a la date lue dans gcm.def'
   ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN
-     write(lunout,*) &
+     WRITE(lunout,*) &
           'GCM: Attention les dates initiales lues dans le fichier'
-     write(lunout,*) &
+     WRITE(lunout,*) &
           ' restart ne correspondent pas a celles lues dans '
-     write(lunout,*)' gcm.def'
-     write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
-     write(lunout,*)' day_ref=',day_ref," dayref=",dayref
-     write(lunout,*)' Pas de remise a zero'
-  ENDIF
-
-  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
-  !        write(lunout,*)
+     WRITE(lunout,*)' gcm.def'
+     WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+     WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
+     WRITE(lunout,*)' Pas de remise a zero'
+  ENDIF
+
+  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
+  !        WRITE(lunout,*)
   !     .  'GCM: Attention les dates initiales lues dans le fichier'
-  !        write(lunout,*)
+  !        WRITE(lunout,*)
   !     .  ' restart ne correspondent pas a celles lues dans '
-  !        write(lunout,*)' gcm.def'
-  !        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
-  !        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
-  !        if (raz_date .ne. 1) then
-  !          write(lunout,*)
+  !        WRITE(lunout,*)' gcm.def'
+  !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+  !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
+  !        if (raz_date .ne. 1) THEN
+  !          WRITE(lunout,*)
   !     .    'GCM: On garde les dates du fichier restart'
   !        else
@@ -308,5 +308,5 @@
   !          itau_phy = 0
   !          time_0 = 0.
-  !          write(lunout,*)
+  !          WRITE(lunout,*)
   !     .   'GCM: On reinitialise a la date lue dans gcm.def'
   !        endif
@@ -323,13 +323,13 @@
   CALL ioconf_startdate(INT(jD_ref), jH_ref)
 
-  write(lunout,*)'DEBUG'
-  write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
-  write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
+  WRITE(lunout,*)'DEBUG'
+  WRITE(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
+  WRITE(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
   CALL ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
-  write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
-  write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
-
-
-  if (iflag_phys==1) then
+  WRITE(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
+  WRITE(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
+
+
+  if (iflag_phys==1) THEN
      ! these initialisations have already been done (via iniacademic)
      ! if running in SW or Newtonian mode
@@ -365,5 +365,5 @@
 
 
-  if (nday>=0) then
+  if (nday>=0) THEN
      day_end = day_ini + nday
   else
@@ -395,5 +395,5 @@
   ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
 
-  !      if (planet_type.eq."earth") then
+  !      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
@@ -432,9 +432,9 @@
   !   ----------------------------------
 
-  !       write(78,*) 'ucov',ucov
-  !       write(78,*) 'vcov',vcov
-  !       write(78,*) 'teta',teta
-  !       write(78,*) 'ps',ps
-  !       write(78,*) 'q',q
+  !       WRITE(78,*) 'ucov',ucov
+  !       WRITE(78,*) 'vcov',vcov
+  !       WRITE(78,*) 'teta',teta
+  !       WRITE(78,*) 'ps',ps
+  !       WRITE(78,*) 'q',q
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/getparam.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/getparam.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/getparam.F90	(revision 5116)
@@ -46,7 +46,7 @@
     CALL getin(TARGET,ret_val)
 
-    write(out_eff,*) '######################################'
-    write(out_eff,*) '#### ',comment,' #####'
-    write(out_eff,*) TARGET,'=',ret_val
+    WRITE(out_eff,*) '######################################'
+    WRITE(out_eff,*) '#### ',comment,' #####'
+    WRITE(out_eff,*) TARGET,'=',ret_val
 
   END SUBROUTINE getparamr
@@ -69,8 +69,8 @@
     CALL getin(TARGET,ret_val)
 
-    write(out_eff,*) '######################################'
-    write(out_eff,*) '#### ',comment,' #####'
-    write(out_eff,*) comment
-    write(out_eff,*) TARGET,'=',ret_val
+    WRITE(out_eff,*) '######################################'
+    WRITE(out_eff,*) '#### ',comment,' #####'
+    WRITE(out_eff,*) comment
+    WRITE(out_eff,*) TARGET,'=',ret_val
 
   END SUBROUTINE getparami
@@ -93,7 +93,7 @@
     CALL getin(TARGET,ret_val)
 
-    write(out_eff,*) '######################################'
-    write(out_eff,*) '#### ',comment,' #####'
-    write(out_eff,*) TARGET,'=',ret_val
+    WRITE(out_eff,*) '######################################'
+    WRITE(out_eff,*) '#### ',comment,' #####'
+    WRITE(out_eff,*) TARGET,'=',ret_val
 
   END SUBROUTINE getparaml
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90	(revision 5116)
@@ -3,5 +3,5 @@
 SUBROUTINE groupe(pext, pbaru, pbarv, pbarum, pbarvm, wm)
 
-  use comconst_mod, only: ngroup
+  use comconst_mod, ONLY: ngroup
 
   IMPLICIT NONE
@@ -25,15 +25,15 @@
   ! parameter (ngroup=3)
 
-  real :: pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
-  real :: pext(iip1, jjp1, llm)
+  REAL :: pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
+  REAL :: pext(iip1, jjp1, llm)
 
-  real :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
-  real :: wm(iip1, jjp1, llm)
+  REAL :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
+  REAL :: wm(iip1, jjp1, llm)
 
-  real :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
+  REAL :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
 
-  real :: uu
+  REAL :: uu
 
-  integer :: i, j, l
+  INTEGER :: i, j, l
 
   logical :: firstcall, groupe_ok
@@ -43,11 +43,11 @@
   data groupe_ok/.TRUE./
 
-  if (iim==1) then
+  if (iim==1) THEN
     groupe_ok = .FALSE.
   endif
 
-  if (firstcall) then
-    if (groupe_ok) then
-      if(mod(iim, 2**ngroup)/=0) &
+  if (firstcall) THEN
+    if (groupe_ok) THEN
+      IF(mod(iim, 2**ngroup)/=0) &
               CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
     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)
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90	(revision 5116)
@@ -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
@@ -127,5 +127,5 @@
     IF (iguide_sav>0) THEN
        iguide_sav=day_step/iguide_sav
-    ELSE if (iguide_sav == 0) then
+    ELSE if (iguide_sav == 0) THEN
        iguide_sav = huge(0)
     ELSE
@@ -173,6 +173,6 @@
 ! ---------------------------------------------
     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
@@ -181,6 +181,6 @@
           endif
        endif
-    elseif (guide_plevs==2) then
-       if (ncidpl==-99) then
+    elseif (guide_plevs==2) THEN
+       if (ncidpl==-99) THEN
           rcod=nf90_open('P.nc',nf90_nowrite,ncidpl)
           if (rcod/=nf90_noerr) THEN
@@ -190,6 +190,6 @@
        endif
 
-    elseif (guide_u) then
-           if (ncidpl==-99) then
+    elseif (guide_u) THEN
+           if (ncidpl==-99) THEN
                rcod=nf90_open('u.nc',nf90_nowrite,ncidpl)
                if (rcod/=nf90_noerr) THEN
@@ -199,6 +199,6 @@
            endif
 
-    elseif (guide_v) then
-           if (ncidpl==-99) then
+    elseif (guide_v) THEN
+           if (ncidpl==-99) THEN
                rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
                if (rcod/=nf90_noerr) THEN
@@ -207,6 +207,6 @@
                endif
            endif
-    elseif (guide_T) then
-           if (ncidpl==-99) then
+    elseif (guide_T) THEN
+           if (ncidpl==-99) THEN
                rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
                if (rcod/=nf90_noerr) THEN
@@ -215,6 +215,6 @@
                endif
            endif
-    elseif (guide_Q) then
-           if (ncidpl==-99) then
+    elseif (guide_Q) THEN
+           if (ncidpl==-99) THEN
                rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
                if (rcod/=nf90_noerr) THEN
@@ -232,5 +232,5 @@
     ENDIF
     error=nf90_inquire_dimension(ncidpl,rid,len=nlevnc)
-    write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc 
+    WRITE(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
     rcod = nf90_close(ncidpl)
 
@@ -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
@@ -453,5 +453,5 @@
       IF (reste==0.) THEN
           IF (itau_test==itau) THEN
-            write(lunout,*)trim(modname)//' second pass in advreel at itau=',&
+            WRITE(lunout,*)trim(modname)//' second pass in advreel at itau=',&
             itau
               abort_message='stopped'
@@ -466,5 +466,5 @@
               step_rea=step_rea+1
               itau_test=itau
-              write(*,*)trim(modname)//' Reading nudging files, step ',&
+              WRITE(*,*)trim(modname)//' Reading nudging files, step ',&
                      step_rea,'after ',count_no_rea,' skips'
               IF (guide_2D) THEN
@@ -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,6 +515,6 @@
     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
@@ -529,6 +529,6 @@
     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
@@ -541,6 +541,6 @@
     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
@@ -555,6 +555,6 @@
     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
@@ -567,6 +567,6 @@
     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
@@ -670,8 +670,8 @@
   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
   IMPLICIT NONE
 
@@ -705,9 +705,9 @@
   CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
   
-    write(*,*)trim(modname)//': interpolate nudging variables'
+    WRITE(*,*)trim(modname)//': interpolate nudging variables'
 ! -----------------------------------------------------------------
 ! Calcul des niveaux de pression champs guidage
 ! -----------------------------------------------------------------
-IF (guide_modele) then
+IF (guide_modele) THEN
     do i=1,iip1
         do j=1,jjp1
@@ -729,25 +729,25 @@
 
 END IF
-    if (first) then
+    if (first) THEN
         first=.FALSE.
-        write(*,*)trim(modname)//' : check vertical level order'
-        write(*,*)trim(modname)//' LMDZ :'
+        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. &
+          WRITE(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
                   +psi(1,jjp1)*(bp(l)+bp(l+1))/2.
         enddo
-        write(*,*)trim(modname)//' nudging file :'
+        WRITE(*,*)trim(modname)//' nudging file :'
         do l=1,nlevnc
-          write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,1,l)
+          WRITE(*,*)trim(modname)//' PL(',l,')=',plnc2(1,1,l)
         enddo
-        write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
-        if (guide_u) then
+        WRITE(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
+        if (guide_u) THEN
             do l=1,nlevnc
-              write(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l)
+              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)
+              WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l)
             enddo
         endif
@@ -758,5 +758,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 +803,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 +921,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
@@ -948,5 +948,5 @@
     real alphamin,alphamax,xi
     integer i,j,ilon,ilat
-    character(len=20),parameter :: modname="tau2alpha"
+    CHARACTER(LEN=20),parameter :: modname="tau2alpha"
     CHARACTER (len = 80)   :: abort_message
 
@@ -962,11 +962,11 @@
             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
-                    elseif (typ==1) then
+                    elseif (typ==1) THEN
                        zlat=rlatu(j)*180./pi
                        zlon=rlonv(i)*180./pi
-                    elseif (typ==3) then
+                    elseif (typ==3) THEN
                        zlat=rlatv(j)*180./pi
                        zlon=rlonv(i)*180./pi
@@ -1037,21 +1037,21 @@
             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'
+            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'
+              WRITE(*,*)trim(modname)//' gamma=',gamma
+              if (gamma<1.e-5) THEN
+                WRITE(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
                 abort_message='stopped'
                 CALL abort_gcm(modname,abort_message,1)
               endif
               gamma=log(0.5)/log(gamma)
-              if (gamma4) then 
+              if (gamma4) THEN
                 gamma=min(gamma,4.)
               endif
-              write(*,*)trim(modname)//' gamma=',gamma
+              WRITE(*,*)trim(modname)//' gamma=',gamma
             endif
         ENDIF !first
@@ -1059,15 +1059,15 @@
         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
-                elseif (typ==2) then
+                elseif (typ==2) THEN
                    dxdy_=dxdyu(i,j)
                    zlat=rlatu(j)*180./pi
-                elseif (typ==3) then
+                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
+                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 +1075,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
@@ -1113,10 +1113,10 @@
 ! Premier appel: initialisation de la lecture des fichiers
 ! -----------------------------------------------------------------
-    if (first) then
+    if (first) THEN
          ncidpl=-99
-         write(*,*) trim(modname)//': opening nudging files '
+         WRITE(*,*) trim(modname)//': opening nudging files '
 ! Niveaux de pression si non constants
-         if (guide_plevs==1) then
-             write(*,*) trim(modname)//' Reading nudging on model levels'
+         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
@@ -1134,9 +1134,9 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
+             WRITE(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
          endif
 
 ! 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
@@ -1149,10 +1149,10 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
+             WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
              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
@@ -1165,5 +1165,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
+             WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
              if (ncidpl==-99) ncidpl=ncidu
 
@@ -1185,5 +1185,5 @@
 
 ! Vent meridien
-         if (guide_v) then
+         if (guide_v) THEN
              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
              IF (rcode/=nf90_noerr) THEN
@@ -1196,5 +1196,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
+             WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
              if (ncidpl==-99) ncidpl=ncidv
              
@@ -1218,5 +1218,5 @@
 
 ! Temperature
-         if (guide_T) then
+         if (guide_T) THEN
              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
              IF (rcode/=nf90_noerr) THEN
@@ -1229,5 +1229,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
+             WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
              if (ncidpl==-99) ncidpl=ncidt
 
@@ -1249,5 +1249,5 @@
 
 ! Humidite
-         if (guide_Q) then
+         if (guide_Q) THEN
              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
              IF (rcode/=nf90_noerr) THEN
@@ -1260,5 +1260,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
+             WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
              if (ncidpl==-99) ncidpl=ncidQ
 
@@ -1280,5 +1280,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
@@ -1291,14 +1291,14 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
+             WRITE(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
          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)
-              write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,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
+         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 +1328,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 +1338,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 +1346,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 +1354,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 +1363,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 +1372,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,10 +1413,10 @@
 ! Premier appel: initialisation de la lecture des fichiers
 ! -----------------------------------------------------------------
-    if (first) then
+    if (first) THEN
          ncidpl=-99
-         write(*,*)trim(modname)//' : opening nudging files '
+         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'
+         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
@@ -1434,8 +1434,8 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
+           WRITE(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
          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
@@ -1448,9 +1448,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
+           WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
            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
@@ -1463,9 +1463,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
+           WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
            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
@@ -1478,9 +1478,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
+           WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
            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
@@ -1493,9 +1493,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
+           WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
            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
@@ -1508,9 +1508,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
+           WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
            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
@@ -1523,14 +1523,14 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
+           WRITE(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
          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)
-           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,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
+         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 +1559,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 +1572,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 +1585,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 +1598,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 +1611,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 +1625,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
@@ -1674,5 +1674,5 @@
     CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
 
-    write(*,*)trim(modname)//': output timestep',timestep,'var ',varname
+    WRITE(*,*)trim(modname)//': output timestep',timestep,'var ',varname
     IF (timestep==0) THEN
 ! ----------------------------------------------
@@ -1804,5 +1804,5 @@
     do l=1,nl
         do i=2,iim-1
-            if(abs(x(i,l))>1.e10) then
+            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
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90	(revision 5116)
@@ -7,6 +7,6 @@
   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
@@ -60,5 +60,5 @@
   INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
 
-  integer :: nid_relief,varid,ierr
+  INTEGER :: nid_relief,varid,ierr
   real, dimension(iip1,jjp1) :: relief
 
@@ -75,12 +75,12 @@
   LOGICAL,PARAMETER :: tnat1=.TRUE.
   
-  character(len=*),parameter :: modname="iniacademic"
-  character(len=80) :: abort_message
+  CHARACTER(LEN=*),parameter :: modname="iniacademic"
+  CHARACTER(LEN=80) :: abort_message
 
   ! Sanity check: verify that options selected by user are not incompatible
-  if ((iflag_phys==1).and. .not. read_start) then
-    write(lunout,*) trim(modname)," error: if read_start is set to ", &
+  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"
-    write(lunout,*) "You most likely want an aquaplanet initialisation", &
+    WRITE(lunout,*) "You most likely want an aquaplanet initialisation", &
     " (iflag_phys >= 100)"
     CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1)
@@ -109,5 +109,5 @@
   ang0       = 0.
 
-  if (llm == 1) then
+  if (llm == 1) THEN
      ! specific initializations for the shallow water case
      kappa=1
@@ -164,5 +164,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,7 +172,7 @@
   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
@@ -181,5 +181,5 @@
   endif
 
-  academic_case: if (iflag_phys >= 2) then
+  academic_case: if (iflag_phys >= 2) THEN
      ! initializations
 
@@ -249,5 +249,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 +293,5 @@
 
         ! winds
-        if (ok_geost) then
+        if (ok_geost) THEN
            CALL ugeostr(phi,ucov)
         else
@@ -301,5 +301,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
@@ -315,8 +315,8 @@
               iqParent = tracers(iq)%iqParent
               IF(tracers(iq)%iso_iZone == 0) THEN
-                 if (tnat1) then
+                 if (tnat1) THEN
                          tnat=1.0
                          alpha_ideal=1.0
-                         write(*,*) 'Attention dans iniacademic: alpha_ideal=1'
+                         WRITE(*,*) 'Attention dans iniacademic: alpha_ideal=1'
                  else
                     IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F90	(revision 5116)
@@ -32,17 +32,17 @@
   !  """""""""
   ! INPUT
-  integer :: imo, jmo ! dimensions ancienne grille
-  integer :: imn, jmn  ! dimensions nouvelle grille
-  integer :: kllm ! taille du tableau des intersections
-  real :: rlonuo(imo + 1)     !  Latitude et
-  real :: rlatvo(jmo)       !  longitude des
-  real :: rlonun(imn + 1)     !  bord des
-  real :: rlatvn(jmn)     !  cases "scalaires" (input)
+  INTEGER :: imo, jmo ! dimensions ancienne grille
+  INTEGER :: imn, jmn  ! dimensions nouvelle grille
+  INTEGER :: kllm ! taille du tableau des intersections
+  REAL :: rlonuo(imo + 1)     !  Latitude et
+  REAL :: rlatvo(jmo)       !  longitude des
+  REAL :: rlonun(imn + 1)     !  bord des
+  REAL :: rlatvn(jmn)     !  cases "scalaires" (input)
 
   ! OUTPUT
-  integer :: ktotal ! nombre totale d'intersections reperees
-  integer :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
-  real :: intersec(kllm)  ! surface des intersections (m2)
-  real :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
+  INTEGER :: ktotal ! nombre totale d'intersections reperees
+  INTEGER :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
+  REAL :: intersec(kllm)  ! surface des intersections (m2)
+  REAL :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
 
 
@@ -51,9 +51,9 @@
   ! Autres variables
   ! """"""""""""""""
-  integer :: i, j, ii, jj, k
-  real :: a(imo + 1), b(imo + 1), c(jmo + 1), d(jmo + 1)
-  real :: an(imn + 1), bn(imn + 1), cn(jmn + 1), dn(jmn + 1)
-  real :: aa, bb, cc, dd
-  real :: pi
+  INTEGER :: i, j, ii, jj, k
+  REAL :: a(imo + 1), b(imo + 1), c(jmo + 1), d(jmo + 1)
+  REAL :: an(imn + 1), bn(imn + 1), cn(jmn + 1), dn(jmn + 1)
+  REAL :: aa, bb, cc, dd
+  REAL :: pi
 
   pi = 2. * ASIN(1.)
@@ -116,5 +116,5 @@
   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
@@ -124,5 +124,5 @@
                     .or. ((an(ii)<b(i) + 2 * pi).and.(bn(ii)>a(i) + 2 * pi) &
                             .and.(a(i) + 2 * pi>pi)) &
-                    )then
+                    )THEN
               ktotal = ktotal + 1
               iik(ktotal) = ii
@@ -135,10 +135,10 @@
               if (cc< c(j))cc = c(j)
               if((an(ii)<b(i) - 2 * pi).and. &
-                      (bn(ii)>a(i) - 2 * pi)) then
+                      (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. &
-                      (bn(ii)>a(i) + 2 * pi)) then
+                      (bn(ii)>a(i) + 2 * pi)) THEN
                 bb = min(b(i) + 2 * pi, bn(ii))
                 aa = an(ii)
@@ -165,12 +165,12 @@
   !  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
-  !      write(*,*) '**************** jj=',jj,'ii=',ii
-  !      write(*,*) 'i,j =',i,j
-  !      write(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj)
-  !      write(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j)
-  !      write(*,*) 'intersec(k)',intersec(k)
-  !      write(*,*) 'airen(ii,jj)=',airen(ii,jj)
+  !  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
+  !      WRITE(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj)
+  !      WRITE(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j)
+  !      WRITE(*,*) 'intersec(k)',intersec(k)
+  !      WRITE(*,*) 'airen(ii,jj)=',airen(ii,jj)
   !  end if
   ! END DO
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90	(revision 5116)
@@ -7,7 +7,7 @@
 
   use control_mod, ONLY: planet_type
-  use comconst_mod, only: pi
+  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
 
@@ -98,10 +98,10 @@
   DO ij = 1, ip1jmp1
     IF(ps(ij)<0.) THEN
-      write(lunout, *) "integrd: negative surface pressure ", ps(ij)
-      write(lunout, *) " at node ij =", ij
+      WRITE(lunout, *) "integrd: negative surface pressure ", ps(ij)
+      WRITE(lunout, *) " at node ij =", ij
       ! since ij=j+(i-1)*jjp1 , we have
       j = modulo(ij, jjp1)
       i = 1 + (ij - j) / jjp1
-      write(lunout, *) " lon = ", rlonv(i) * 180. / pi, " deg", &
+      WRITE(lunout, *) " lon = ", rlonv(i) * 180. / pi, " deg", &
               " lat = ", rlatu(j) * 180. / pi, " deg"
       CALL abort_gcm("integrd", "", 1)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F90	(revision 5116)
@@ -22,29 +22,29 @@
   !  """""""""
 
-  integer :: imo, jmo ! dimensions ancienne grille (input)
-  integer :: imn, jmn  ! dimensions nouvelle grille (input)
+  INTEGER :: imo, jmo ! dimensions ancienne grille (input)
+  INTEGER :: imn, jmn  ! dimensions nouvelle grille (input)
 
-  real :: rlonuo(imo + 1)     !  Latitude et
-  real :: rlatvo(jmo)       !  longitude des
-  real :: rlonun(imn + 1)     !  bord des
-  real :: rlatvn(jmn)     !  cases "scalaires" (input)
+  REAL :: rlonuo(imo + 1)     !  Latitude et
+  REAL :: rlatvo(jmo)       !  longitude des
+  REAL :: rlonun(imn + 1)     !  bord des
+  REAL :: rlatvn(jmn)     !  cases "scalaires" (input)
 
-  integer :: lm ! dimension verticale (input)
-  real :: varo (imo + 1, jmo + 1, lm) ! var dans l'ancienne grille (input)
-  real :: varn (imn + 1, jmn + 1, lm) ! var dans la nouvelle grille (output)
+  INTEGER :: lm ! dimension verticale (input)
+  REAL :: varo (imo + 1, jmo + 1, lm) ! var dans l'ancienne grille (input)
+  REAL :: varn (imn + 1, jmn + 1, lm) ! var dans la nouvelle grille (output)
 
   ! Autres variables
   ! """"""""""""""""
-  real :: airetest(imn + 1, jmn + 1)
-  integer :: ii, jj, l
+  REAL :: airetest(imn + 1, jmn + 1)
+  INTEGER :: ii, jj, l
 
-  real :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
+  REAL :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
   !    Info sur les ktotal intersection entre les cases new/old grille
-  integer :: kllm, k, ktotal
+  INTEGER :: kllm, k, ktotal
   parameter (kllm = 400 * 200 * 10)
-  integer :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
-  real :: intersec(kllm)
-  real :: R
-  real :: totn, tots
+  INTEGER :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
+  REAL :: intersec(kllm)
+  REAL :: R
+  REAL :: totn, tots
 
   logical :: firstcall, firsttest, aire_ok
@@ -128,8 +128,8 @@
   !!        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'
-  !! !             write(*,*)'ii,jj,airen,airetest',
+  !! !             WRITE(*,*)'ii,jj,airen,airetest',
   !! !     &          ii,jj,airen(ii,jj),airetest(ii,jj)
   !!              aire_ok = .FALSE.
@@ -137,5 +137,5 @@
   !!        END DO
   !!       END DO
-  !! !      if (aire_ok) write(*,*) 'INTERP. HORIZ. : AIRES OK'
+  !! !      if (aire_ok) WRITE(*,*) 'INTERP. HORIZ. : AIRES OK'
   !!  99   continue
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90	(revision 5116)
@@ -15,6 +15,6 @@
           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
@@ -85,5 +85,5 @@
   REAL :: w(ip1jmp1, llm)                    ! vertical velocity
 
-  real :: zqmin, zqmax
+  REAL :: zqmin, zqmax
 
   ! variables dynamiques intermediaire pour le transport
@@ -124,5 +124,5 @@
   INTEGER :: ik
 
-  real :: time_step, t_wrt, t_ops
+  REAL :: time_step, t_wrt, t_ops
 
   ! REAL rdayvrai,rdaym_ini
@@ -137,13 +137,13 @@
   save first
   data first/.TRUE./
-  real :: dt_cum
-  character(len = 10) :: infile
-  integer :: zan, tau0, thoriid
-  integer :: nid_ctesGCM
+  REAL :: dt_cum
+  CHARACTER(LEN = 10) :: infile
+  INTEGER :: zan, tau0, thoriid
+  INTEGER :: nid_ctesGCM
   save nid_ctesGCM
-  real :: degres
-  real :: rlong(iip1), rlatg(jjp1)
-  real :: zx_tmp_2d(iip1, jjp1)
-  integer :: ndex2d(iip1 * jjp1)
+  REAL :: degres
+  REAL :: rlong(iip1), rlatg(jjp1)
+  REAL :: zx_tmp_2d(iip1, jjp1)
+  INTEGER :: ndex2d(iip1 * jjp1)
   logical :: ok_sync
   parameter (ok_sync = .TRUE.)
@@ -151,5 +151,5 @@
 
   data callinigrads/.TRUE./
-  character(len = 10) :: string10
+  CHARACTER(LEN = 10) :: string10
 
   REAL :: flxw(ip1jmp1, llm)  ! flux de masse verticale
@@ -170,7 +170,7 @@
   !-jld
 
-  character(len = 80) :: dynhist_file, dynhistave_file
-  character(len = *), parameter :: modname = "leapfrog"
-  character(len = 80) :: abort_message
+  CHARACTER(LEN = 80) :: dynhist_file, dynhistave_file
+  CHARACTER(LEN = *), parameter :: modname = "leapfrog"
+  CHARACTER(LEN = 80) :: abort_message
 
   logical :: dissip_conservative
@@ -186,7 +186,7 @@
   logical, parameter :: flag_verif = .FALSE.
 
-  integer :: itau_w   ! pas de temps ecriture = itap + itau_phy
-
-  if (nday>=0) then
+  INTEGER :: itau_w   ! pas de temps ecriture = itap + itau_phy
+
+  if (nday>=0) THEN
     itaufin = nday * day_step
   else
@@ -212,5 +212,5 @@
   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
@@ -236,5 +236,5 @@
   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
@@ -310,5 +310,5 @@
   ! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
   ! supress dissipation step
-  if (llm==1) then
+  if (llm==1) THEN
     apdiss = .FALSE.
   endif
@@ -341,5 +341,5 @@
             p, masse, dq, teta, &
             flxw, pk)
-    !write(*,*) 'caladvtrac 346'
+    !WRITE(*,*) 'caladvtrac 346'
 
     IF (offline) THEN
@@ -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
@@ -417,7 +417,7 @@
     jD_cur = jD_cur + int(jH_cur)
     jH_cur = jH_cur - int(jH_cur)
-    ! write(lunout,*)'itau, jD_cur = ', itau, jD_cur, jH_cur
+    ! WRITE(lunout,*)'itau, jD_cur = ', itau, jD_cur, jH_cur
     ! CALL ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
-    ! write(lunout,*)'current date = ',an, mois, jour, secondes
+    ! WRITE(lunout,*)'current date = ',an, mois, jour, secondes
 
     ! rajout debug
@@ -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,5 +511,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
@@ -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
@@ -590,5 +590,5 @@
 
   ! ajout debug
-  ! IF( lafin ) then
+  ! IF( lafin ) THEN
   !   abort_message = 'Simulation finished'
   !   CALL abort_gcm(modname,abort_message,0)
@@ -620,11 +620,11 @@
     ENDIF
 
-    IF(itau == itaufinp1) then
-      if (flag_verif) then
-        write(79, *) 'ucov', ucov
-        write(80, *) 'vcov', vcov
-        write(81, *) 'teta', teta
-        write(82, *) 'ps', ps
-        write(83, *) 'q', q
+    IF(itau == itaufinp1) THEN
+      if (flag_verif) THEN
+        WRITE(79, *) 'ucov', ucov
+        WRITE(80, *) 'vcov', vcov
+        WRITE(81, *) 'teta', teta
+        WRITE(82, *) 'ps', ps
+        WRITE(83, *) 'q', q
         WRITE(85, *) 'q1 = ', q(:, :, 1)
         WRITE(86, *) 'q3 = ', q(:, :, 3)
@@ -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,6 +675,6 @@
           vnat(:, l) = vcov(:, l) / cv(:)
         enddo
-          if (ok_dyn_ins) then
-            ! write(lunout,*) "leapfrog: CALL writehist, itau=",itau
+          if (ok_dyn_ins) THEN
+            ! WRITE(lunout,*) "leapfrog: CALL writehist, itau=",itau
            CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
             ! CALL WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
@@ -685,5 +685,5 @@
           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
@@ -694,5 +694,5 @@
 
 
-      ! if (planet_type.eq."earth") then
+      ! if (planet_type.eq."earth") THEN
       ! Write an Earth-format restart file
       CALL dynredem1("restart.nc", start_time, &
@@ -701,5 +701,5 @@
 
       CLOSE(99)
-      if (ok_guide) then
+      if (ok_guide) THEN
         ! ! set ok_guide to false to avoid extra output
         ! ! in following forward step
@@ -760,5 +760,5 @@
 
       forward = .FALSE.
-      IF(itau == itaufinp1) then
+      IF(itau == itaufinp1) THEN
         abort_message = 'Simulation finished'
         CALL abort_gcm(modname, abort_message, 0)
@@ -799,11 +799,11 @@
           vnat(:, l) = vcov(:, l) / cv(:)
         enddo
-          if (ok_dyn_ins) then
-             ! write(lunout,*) "leapfrog: CALL writehist (b)",
+          if (ok_dyn_ins) THEN
+             ! WRITE(lunout,*) "leapfrog: CALL writehist (b)",
   ! &                        itau,iecri
             CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
           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
+        if (ok_guide) THEN
           ! ! set ok_guide to false to avoid extra output
           ! ! in following forward step
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90	(revision 5116)
@@ -33,6 +33,6 @@
   REAL :: zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
 
-  real :: zx_defau_diag(ip1jmp1, llm, 2)
-  real :: q_follow(ip1jmp1, llm, 2)
+  REAL :: zx_defau_diag(ip1jmp1, llm, 2)
+  REAL :: q_follow(ip1jmp1, llm, 2)
   !
   REAL :: SSUM
@@ -64,6 +64,5 @@
   DO k = 1, llm
     DO i = 1, ip1jmp1
-      if (seuil_liq - q(i, k, iq_liq) > 0.d0) then
-
+      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)
@@ -81,6 +80,5 @@
     !cc      zx_abc = dpres(k) / dpres(k-1)
     DO i = 1, ip1jmp1
-      if (seuil_vap - q(i, k, iq_vap) > 0.d0) then
-
+      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)
@@ -113,6 +111,6 @@
   ENDIF
 
-  !write(*,*) 'qminimum 128'
-  if (niso > 0) then
+  !WRITE(*,*) 'qminimum 128'
+  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
@@ -123,14 +121,14 @@
     ! 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
+      endif !if (zx_pump(i).gt.0.0) THEN
     enddo !DO i = 1,ip1jmp1
 
     ! 2) transfert de vap vers les couches plus hautes
-    !write(*,*) 'qminimum 139'
+    !WRITE(*,*) 'qminimum 139'
     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
@@ -153,5 +151,5 @@
                   - zx_defau_diag(i, k, 1) &
                           * deltap(i, k) / deltap(i, k - 1)
-        endif !if (zx_defau_diag(i,k,1).gt.0.0) then
+        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
       enddo !DO i = 1, ip1jmp1
     enddo !do k=2,llm
@@ -161,9 +159,8 @@
 
     ! 3) transfert d'eau de la vapeur au liquide
-    !write(*,*) 'qminimum 164'
+    !WRITE(*,*) 'qminimum 164'
     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
@@ -180,5 +177,5 @@
           q_follow(i, k, 1) = q_follow(i, k, 1) &
                   - zx_defau_diag(i, k, 2)
-        endif !if (zx_defau_diag(i,k,1).gt.0.0) then
+        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
       enddo !DO i = 1, ip1jmp1
     enddo !do k=2,llm
@@ -186,6 +183,6 @@
     CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 197')
 
-  endif !if (niso > 0) then
-  ! !write(*,*) 'qminimum 188'
+  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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/replay3d.F90	(revision 5116)
@@ -71,5 +71,5 @@
   LOGICAL lafin
 
-  integer :: ntime=10000,it,klon,klev
+  INTEGER :: ntime=10000,it,klon,klev
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/sw_case_williamson91_6.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/sw_case_williamson91_6.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/sw_case_williamson91_6.F90	(revision 5116)
@@ -87,5 +87,5 @@
       enddo
     enddo
-    write(lunout, *) 'W91 ps', MAXVAL(ps), MINVAL(ps)
+    WRITE(lunout, *) 'W91 ps', MAXVAL(ps), MINVAL(ps)
     ! vitesse zonale ucov
     do j = 1, jjp1
@@ -101,5 +101,5 @@
       enddo
     enddo
-    write(lunout, *) 'W91 u', MAXVAL(ucov(:, 1)), MINVAL(ucov(:, 1))
+    WRITE(lunout, *) 'W91 u', MAXVAL(ucov(:, 1)), MINVAL(ucov(:, 1))
     ucov(:, 1) = ucov(:, 1) * cu
     ! vitesse meridienne vcov
@@ -114,5 +114,5 @@
       enddo
     enddo
-    write(lunout, *) 'W91 v', MAXVAL(vcov(:, 1)), MINVAL(vcov(:, 1))
+    WRITE(lunout, *) 'W91 v', MAXVAL(vcov(:, 1)), MINVAL(vcov(:, 1))
     vcov(:, 1) = vcov(:, 1) * cv
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F90	(revision 5116)
@@ -33,5 +33,5 @@
   REAL :: pgcm(ilon, ilev)
   REAL :: Qgcm(ilon, ilev)
-  real :: pres
+  REAL :: pres
   REAL :: Qpres(ilon)
 
@@ -54,5 +54,5 @@
   ! PRINT*,'tetalevel pres=',pres
   !=====================================================================
-  if (lnew) then
+  if (lnew) THEN
     !   on réinitialise les réindicages et les poids
     !=====================================================================
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90	(revision 5116)
@@ -33,5 +33,5 @@
   REAL :: pgcm(ilon, ilev)
   REAL :: Qgcm(ilon, ilev)
-  real :: pres
+  REAL :: pres
   REAL :: Qpres(ilon)
 
@@ -54,5 +54,5 @@
   ! PRINT*,'tetalevel pres=',pres
   !=====================================================================
-  if (lnew) then
+  if (lnew) THEN
     !   on réinitialise les réindicages et les poids
     !=====================================================================
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F90	(revision 5116)
@@ -70,5 +70,5 @@
   REAL :: uzon(jjp1, llm), vzon(jjm, llm), tzon(jjp1, llm)
 
-  integer :: i
+  INTEGER :: i
   REAL, SAVE :: rdamp(llm) ! quenching coefficient
   real, save :: lambda(llm) ! inverse or quenching time scale (Hz)
@@ -80,6 +80,6 @@
   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
@@ -99,10 +99,10 @@
     rdamp(:) = 1. - exp(-lambda(:) * dt)
 
-    write(lunout, *)'TOP_BOUND mode', mode_top_bound
-    write(lunout, *)'Sponge layer coefficients'
-    write(lunout, *)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
+    WRITE(lunout, *)'TOP_BOUND mode', mode_top_bound
+    WRITE(lunout, *)'Sponge layer coefficients'
+    WRITE(lunout, *)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
     do l = 1, llm
-      if (rdamp(l)/=0.) then
-        write(lunout, '(6(1pe12.4,1x))') &
+      if (rdamp(l)/=0.) THEN
+        WRITE(lunout, '(6(1pe12.4,1x))') &
                 presnivs(l), log(preff / presnivs(l)) * scaleheight, &
                 1. / lambda(l), lambda(l)
@@ -115,5 +115,5 @@
 
   ! 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
@@ -147,5 +147,5 @@
 
   ! 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
@@ -161,5 +161,5 @@
   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
@@ -183,5 +183,5 @@
   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
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F90	(revision 5116)
@@ -361,5 +361,5 @@
   ! CRisi: appel récursif de l'advection sur les fils.
   ! Il faut faire ça avant d'avoir mis à jour q et masse
-  !write(*,*) 'vlsplt 326: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
+  !WRITE(*,*) 'vlsplt 326: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
 
   do ifils=1,tracers(iq)%nqDescen
@@ -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
@@ -464,5 +464,5 @@
 
   REAL :: convpn,convps,convmpn,convmps
-  real :: massepn,masseps,qpn,qps
+  REAL :: massepn,masseps,qpn,qps
   REAL :: sinlon(iip1),sinlondlon(iip1)
   REAL :: coslon(iip1),coslondlon(iip1)
@@ -479,5 +479,5 @@
   DATA first/.TRUE./
 
-  ! !write(*,*) 'vly 578: entree, iq=',iq
+  ! !WRITE(*,*) 'vly 578: entree, iq=',iq
 
   IF(first) THEN
@@ -658,5 +658,5 @@
   ENDDO
 
-  ! !write(*,*) 'vly 756'
+  ! !WRITE(*,*) 'vly 756'
   DO l=1,llm
    DO ij=1,ip1jm
@@ -676,5 +676,5 @@
   ! CRisi: appel récursif de l'advection sur les fils.
   ! Il faut faire ça avant d'avoir mis à jour q et masse
-   ! write(*,*) 'vly 689: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
+   ! WRITE(*,*) 'vly 689: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
 
   do ifils=1,tracers(iq)%nqDescen
@@ -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
@@ -744,5 +744,5 @@
   enddo
 
-  ! !write(*,*) 'vly 853: sortie'
+  ! !WRITE(*,*) 'vly 853: sortie'
 
 
@@ -814,5 +814,5 @@
   ENDDO
 
-  ! !write(*,*) 'vlz 954'
+  ! !WRITE(*,*) 'vlz 954'
   DO ij=1,ip1jmp1
      dzq(ij,1)=0.
@@ -846,5 +846,5 @@
   ! CRisi: appel récursif de l'advection sur les fils.
   ! Il faut faire ça avant d'avoir mis à jour q et masse
-  ! !write(*,*) 'vlsplt 942: iq,nqChildren(iq)=',iq,nqChildren(iq)
+  ! !WRITE(*,*) 'vlsplt 942: iq,nqChildren(iq)=',iq,nqChildren(iq)
   do ifils=1,tracers(iq)%nqDescen
     iq2=tracers(iq)%iqDescen(ifils)
@@ -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
@@ -897,8 +897,8 @@
   INCLUDE "paramet.h"
 
-  character(len=20) :: comment
-  real :: qmin,qmax
-  real :: zq(ip1jmp1,llm)
-  real :: zzq(iip1,jjp1,llm)
+  CHARACTER(LEN=20) :: comment
+  REAL :: qmin,qmax
+  REAL :: zq(ip1jmp1,llm)
+  REAL :: zzq(iip1,jjp1,llm)
 
 END SUBROUTINE  minmaxq
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F90	(revision 5116)
@@ -171,5 +171,5 @@
     ENDDO
   enddo
-  !write(*,*) 'vlspltqs 183: fin de la routine'
+  !WRITE(*,*) 'vlspltqs 183: fin de la routine'
 
 
@@ -452,5 +452,5 @@
   ! CRisi: appel récursif de l'advection sur les fils.
   ! Il faut faire ça avant d'avoir mis à jour q et masse
-  !write(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq,
+  !WRITE(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq,
   ! &                 tracers(iq)%nqChildren
 
@@ -758,5 +758,5 @@
   ! CRisi: appel récursif de l'advection sur les fils.
   ! Il faut faire ça avant d'avoir mis à jour q et masse
-  !write(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq,
+  !WRITE(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq,
   ! &              tracers(iq)%nqChildren
 
@@ -772,5 +772,5 @@
   do ifils = 1, tracers(iq)%nqChildren
     iq2 = tracers(iq)%iqDescen(ifils)
-    ! !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
+    ! !WRITE(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
     CALL vly(Ratio, pente_max, masseq, qbyv, iq2)
   enddo
@@ -827,5 +827,5 @@
   ENDDO
 
-  ! !write(*,*) 'vly 866'
+  ! !WRITE(*,*) 'vly 866'
 
   ! retablir les fils en rapport de melange par rapport a l'air:
@@ -838,5 +838,5 @@
     enddo
   enddo
-  ! !write(*,*) 'vly 879'
+  ! !WRITE(*,*) 'vly 879'
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.f90	(revision 5116)
@@ -2,4 +2,5 @@
 
 subroutine wrgrads(if, nl, field, name, titlevar)
+  USE lmdz_formcoord, ONLY: formcoord
   IMPLICIT NONE
 
@@ -14,16 +15,16 @@
 
   !   arguments
-  integer :: if, nl
-  real :: field(imx * jmx * lmx)
+  INTEGER :: if, nl
+  REAL :: field(imx * jmx * lmx)
 
   integer, parameter :: wp = selected_real_kind(p = 6, r = 36)
   real(wp) field4(imx * jmx * lmx)
 
-  character(len = 10) :: name, file
-  character(len = 10) :: titlevar
+  CHARACTER(LEN = 10) :: name, file
+  CHARACTER(LEN = 10) :: titlevar
 
   !   local
 
-  integer :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
+  INTEGER :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
 
   logical :: writectl
@@ -43,6 +44,6 @@
   ! print*,im,jm,lm,name,firsttime(if)
 
-  if(firsttime(if)) then
-    if(name==var(1, if)) then
+  IF(firsttime(if)) THEN
+    IF(name==var(1, if)) THEN
       firsttime(if) = .false.
       ivar(if) = 1
@@ -66,10 +67,10 @@
   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
     endif
 
-    if(var(ivar(if), if)/=name) then
+    IF(var(ivar(if), if)/=name) THEN
       print*, 'Il faut stoker la meme succession de champs a chaque'
       print*, 'pas de temps'
@@ -90,32 +91,31 @@
     !    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
     !    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
-    write(unit(if) + 1, rec = irec(if)) &
+    WRITE(unit(if) + 1, rec = irec(if)) &
             ((field4((l - 1) * imd(if) * jmd(if) + (j - 1) * imd(if) + i) &
                     , 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
     open(unit(if), file = trim(file) // '.ctl' &
             , form = 'formatted', status = 'unknown')
-    write(unit(if), '(a5,1x,a40)') &
+    WRITE(unit(if), '(a5,1x,a40)') &
             'DSET ', '^' // trim(file) // '.dat'
 
-    write(unit(if), '(a12)') 'UNDEF 1.0E30'
-    write(unit(if), '(a5,1x,a40)') 'TITLE ', title(if)
+    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')
-    write(unit(if), '(a4,i10,a30)') &
+    WRITE(unit(if), '(a4,i10,a30)') &
             'TDEF ', itime(if), ' LINEAR 02JAN1987 1MO '
-    write(unit(if), '(a4,2x,i5)') 'VARS', nvar(if)
+    WRITE(unit(if), '(a4,2x,i5)') 'VARS', nvar(if)
     do iv = 1, nvar(if)
       ! print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
       ! print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
-      write(unit(if), 1000) var(iv, if), nld(iv, if) - 1 / nld(iv, if) &
+      WRITE(unit(if), 1000) var(iv, if), nld(iv, if) - 1 / nld(iv, if) &
               , 99, tvar(iv, if)
     enddo
-    write(unit(if), '(a7)') 'ENDVARS'
+    WRITE(unit(if), '(a7)') 'ENDVARS'
     !
     1000   format(a5, 3x, i4, i3, 1x, a39)
@@ -125,6 +125,4 @@
   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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d/write_paramLMDZ_dyn.h	(revision 5116)
@@ -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/academic.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/academic.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/academic.h	(revision 5116)
@@ -3,7 +3,7 @@
 
       common/academic/tetarappel,knewt_t,kfrict,knewt_g,clat4
-      real :: tetarappel(ip1jmp1,llm)
-      real :: knewt_t(llm)
-      real :: kfrict(llm)
-      real :: knewt_g
-      real :: clat4(ip1jmp1)
+      REAL :: tetarappel(ip1jmp1,llm)
+      REAL :: knewt_t(llm)
+      REAL :: kfrict(llm)
+      REAL :: knewt_g
+      REAL :: clat4(ip1jmp1)
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90	(revision 5116)
@@ -43,6 +43,6 @@
     dtbon=dtvr/n
 
-   return
-end subroutine adaptdt
+   RETURN
+END SUBROUTINE adaptdt
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.f90	(revision 5116)
@@ -25,6 +25,6 @@
   !   Arguments:
   !   ----------
-  integer :: mode
-  real :: masse(ip1jmp1,llm)
+  INTEGER :: mode
+  REAL :: masse(ip1jmp1,llm)
   REAL :: pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
   REAL :: q(ip1jmp1,llm)
@@ -35,21 +35,21 @@
   !
   INTEGER :: i,ij,l,j,ii
-  integer :: ijlqmin,iqmin,jqmin,lqmin
-  integer :: ismin
-  !
-  real :: zm(ip1jmp1,llm),newmasse
-  real :: mu(ip1jmp1,llm)
-  real :: mv(ip1jm,llm)
-  real :: mw(ip1jmp1,llm+1)
-  real :: zq(ip1jmp1,llm),zz,qpn,qps
-  real :: zqg(ip1jmp1,llm),zqd(ip1jmp1,llm)
-  real :: zqs(ip1jmp1,llm),zqn(ip1jmp1,llm)
-  real :: zqh(ip1jmp1,llm),zqb(ip1jmp1,llm)
-  real :: temps0,temps1,temps2,temps3
-  real :: ztemps1,ztemps2,ssum
+  INTEGER :: ijlqmin,iqmin,jqmin,lqmin
+  INTEGER :: ismin
+  !
+  REAL :: zm(ip1jmp1,llm),newmasse
+  REAL :: mu(ip1jmp1,llm)
+  REAL :: mv(ip1jm,llm)
+  REAL :: mw(ip1jmp1,llm+1)
+  REAL :: zq(ip1jmp1,llm),zz,qpn,qps
+  REAL :: zqg(ip1jmp1,llm),zqd(ip1jmp1,llm)
+  REAL :: zqs(ip1jmp1,llm),zqn(ip1jmp1,llm)
+  REAL :: zqh(ip1jmp1,llm),zqb(ip1jmp1,llm)
+  REAL :: temps0,temps1,temps2,temps3
+  REAL :: ztemps1,ztemps2,ssum
   save temps1,temps2,temps3
-  real :: zzpbar,zzw
-
-  real :: qmin,qmax
+  REAL :: zzpbar,zzw
+
+  REAL :: qmin,qmax
   data qmin,qmax/0.,1./
   data temps1,temps2,temps3/0.,0.,0./
@@ -139,5 +139,5 @@
   !   Arguments:
   !   ----------
-  real :: q(ip1jmp1,llm),qg(ip1jmp1,llm),qd(ip1jmp1,llm)
+  REAL :: q(ip1jmp1,llm),qg(ip1jmp1,llm),qd(ip1jmp1,llm)
   !
   !  Local
@@ -146,9 +146,9 @@
   INTEGER :: ij,l
   !
-  real :: dxqu(ip1jmp1),zqu(ip1jmp1)
-  real :: zqmax(ip1jmp1),zqmin(ip1jmp1)
+  REAL :: dxqu(ip1jmp1),zqu(ip1jmp1)
+  REAL :: zqmax(ip1jmp1),zqmin(ip1jmp1)
   logical :: extremum(ip1jmp1)
 
-  integer :: mode
+  INTEGER :: mode
   save mode
   data mode/1/
@@ -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
@@ -206,5 +206,5 @@
      enddo
      do ij=iip2+1,ip1jm
-        if(extremum(ij)) then
+        IF(extremum(ij)) THEN
            qg(ij,l)=q(ij,l)
            qd(ij,l)=q(ij,l)
@@ -222,5 +222,5 @@
 
      do ij=iip2+1,ip1jm
-        if(extremum(ij).and..not.extremum(ij-1)) &
+        IF(extremum(ij).and..not.extremum(ij-1)) &
               qd(ij-1,l)=q(ij,l)
      enddo
@@ -256,5 +256,5 @@
   !   Arguments:
   !   ----------
-  real :: q(ip1jmp1,llm),qs(ip1jmp1,llm),qn(ip1jmp1,llm)
+  REAL :: q(ip1jmp1,llm),qs(ip1jmp1,llm),qn(ip1jmp1,llm)
   !
   !  Local
@@ -263,13 +263,13 @@
   INTEGER :: ij,l
   !
-  real :: dyqv(ip1jm),zqv(ip1jm,llm)
-  real :: zqmax(ip1jm),zqmin(ip1jm)
+  REAL :: dyqv(ip1jm),zqv(ip1jm,llm)
+  REAL :: zqmax(ip1jm),zqmin(ip1jm)
   logical :: extremum(ip1jmp1)
 
-  integer :: mode
+  INTEGER :: mode
   save mode
   data mode/1/
 
-  if (mode==0) then
+  if (mode==0) THEN
      do l=1,llm
         do ij=1,ip1jmp1
@@ -315,5 +315,5 @@
 
      do ij=iip2,ip1jm
-        if(extremum(ij)) then
+        IF(extremum(ij)) THEN
            qs(ij,l)=q(ij,l)
            qn(ij,l)=q(ij,l)
@@ -352,5 +352,5 @@
   !   Arguments:
   !   ----------
-  real :: q(ip1jmp1,llm),qh(ip1jmp1,llm),qb(ip1jmp1,llm)
+  REAL :: q(ip1jmp1,llm),qh(ip1jmp1,llm),qb(ip1jmp1,llm)
   !
   !  Local
@@ -359,9 +359,9 @@
   INTEGER :: ij,l
   !
-  real :: dzqw(ip1jmp1,llm+1),zqw(ip1jmp1,llm+1)
-  real :: zqmax(ip1jmp1,llm),zqmin(ip1jmp1,llm)
+  REAL :: dzqw(ip1jmp1,llm+1),zqw(ip1jmp1,llm+1)
+  REAL :: zqmax(ip1jmp1,llm),zqmin(ip1jmp1,llm)
   logical :: extremum(ip1jmp1,llm)
 
-  integer :: mode
+  INTEGER :: mode
   save mode
 
@@ -371,5 +371,5 @@
   !   -----------------------
 
-  if (mode==0) then
+  if (mode==0) THEN
      do l=1,llm
         do ij=1,ip1jmp1
@@ -424,5 +424,5 @@
   do l=2,llm-1
      do ij=1,ip1jmp1
-        if(extremum(ij,l)) then
+        IF(extremum(ij,l)) THEN
            qh(ij,l)=q(ij,l)
            qb(ij,l)=q(ij,l)
@@ -435,5 +435,5 @@
   ! do l=2,llm-1
   !    do ij=1,ip1jmp1
-  !       if(extremum(ij,l)) then
+  !       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)
@@ -474,8 +474,8 @@
   !   Arguments:
   !   ----------
-  integer :: mode
-  real :: masse(ip1jmp1,llm)
-  real :: u_m( ip1jmp1,llm )
-  real :: q(ip1jmp1,llm),qd(ip1jmp1,llm),qg(ip1jmp1,llm)
+  INTEGER :: mode
+  REAL :: masse(ip1jmp1,llm)
+  REAL :: u_m( ip1jmp1,llm )
+  REAL :: q(ip1jmp1,llm),qd(ip1jmp1,llm),qg(ip1jmp1,llm)
   !
   !  Local
@@ -483,15 +483,15 @@
   !
   INTEGER :: i,j,ij,l,indu(ip1jmp1),niju,iju,ijq
-  integer :: n0,nl(llm)
-  !
-  real :: new_m,zu_m,zdq,zz
-  real :: zsigg(ip1jmp1,llm),zsigd(ip1jmp1,llm),zsig
-  real :: u_mq(ip1jmp1,llm)
-
-  real :: zm,zq,zsigm,zsigp,zqm,zqp,zu
+  INTEGER :: n0,nl(llm)
+  !
+  REAL :: new_m,zu_m,zdq,zz
+  REAL :: zsigg(ip1jmp1,llm),zsigd(ip1jmp1,llm),zsig
+  REAL :: u_mq(ip1jmp1,llm)
+
+  REAL :: zm,zq,zsigm,zsigp,zqm,zqp,zu
 
   logical :: ladvplus(ip1jmp1,llm)
 
-  real :: prec
+  REAL :: prec
   save prec
 
@@ -501,5 +501,5 @@
         do ij=iip2,ip1jm
            zdq=qd(ij,l)-qg(ij,l)
-           ! if((qd(ij,l)-q(ij,l))*(q(ij,l)-qg(ij,l)).lt.0.) then
+           ! if((qd(ij,l)-q(ij,l))*(q(ij,l)-qg(ij,l)).lt.0.) THEN
            !    PRINT*,'probleme au point ij=',ij,'  l=',l
            !    PRINT*,qd(ij,l),q(ij,l),qg(ij,l)
@@ -507,9 +507,9 @@
            !    qg(ij,l)=q(ij,l)
            ! endif
-           if(abs(zdq)>prec) then
+           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.
-  !    s               zsigg(ij,l).ge.0..or.zsigg(ij,l).le.1.) ) then
+              ! 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
               !    PRINT*,'sigg=',zsigg(ij,l),'  sigd=',zsigd(ij,l)
@@ -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)
@@ -548,14 +548,14 @@
       ladvplus(ij,l)=zu>zm
       zsig=zu/zm
-      if(zsig==0.) zsigp=0.1
-      if (mode==1) then
-         if (zsig<=zsigp) then
+      IF(zsig==0.) zsigp=0.1
+      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
@@ -565,5 +565,5 @@
          endif
       endif
-      ! if(zsig.lt.0.) then
+      ! IF(zsig.lt.0.) THEN
       !    PRINT*,'au point ij=',ij,'  l=',l,'  sig=',zsig
       !    stop
@@ -587,5 +587,5 @@
      nl(l)=0
      do ij=iip2,ip1jm
-        if(ladvplus(ij,l)) then
+        IF(ladvplus(ij,l)) THEN
            nl(l)=nl(l)+1
            u_mq(ij,l)=0.
@@ -595,5 +595,5 @@
   enddo
 
-  if(n0>1) then
+  IF(n0>1) THEN
   IF (prt_level > 9) WRITE(lunout,*) &
         'Nombre de points pour lesquels on advect plus que le' &
@@ -601,9 +601,9 @@
 
      do l=1,llm
-        if(nl(l)>0) then
+        IF(nl(l)>0) THEN
            iju=0
   !   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
@@ -619,5 +619,5 @@
               zu_m=u_m(ij,l)
               u_mq(ij,l)=0.
-              if(zu_m>0.) then
+              IF(zu_m>0.) THEN
                  ijq=ij
                  i=ijq-(j-1)*iip1
@@ -632,5 +632,5 @@
   !   ajout de la maille non completement advectee
          zsig=zu_m/masse(ijq,l)
-         if(zsig<=zsigd(ijq,l)) then
+         IF(zsig<=zsigd(ijq,l)) THEN
             u_mq(ij,l)=u_mq(ij,l)+zu_m*(qd(ijq,l) &
                   -0.5*zsig/zsigd(ijq,l)*(qd(ijq,l)-q(ijq,l)))
@@ -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
@@ -662,5 +662,5 @@
   ! 2eme MODIF SPECIFIQUE
          zsig=-zu_m/masse(ij+1,l)
-         if(zsig<=zsigg(ijq,l)) then
+         IF(zsig<=zsigg(ijq,l)) THEN
             u_mq(ij,l)=u_mq(ij,l)+zu_m*(qg(ijq,l) &
                   -0.5*zsig/zsigg(ijq,l)*(qg(ijq,l)-q(ijq,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
@@ -736,7 +736,7 @@
   !   Arguments:
   !   ----------
-  real :: masse(ip1jmp1,llm)
-  real :: v_m( ip1jm,llm )
-  real :: q(ip1jmp1,llm),qn(ip1jmp1,llm),qs(ip1jmp1,llm)
+  REAL :: masse(ip1jmp1,llm)
+  REAL :: v_m( ip1jm,llm )
+  REAL :: q(ip1jmp1,llm),qn(ip1jmp1,llm),qs(ip1jmp1,llm)
   !
   !  Local
@@ -745,11 +745,11 @@
   INTEGER :: ij,l
   !
-  real :: new_m,zdq,zz
-  real :: zsigs(ip1jmp1),zsign(ip1jmp1),zsig
-  real :: v_mq(ip1jm,llm)
-  real :: convpn,convps,convmpn,convmps,massen,masses
-  real :: zm,zq,zsigm,zsigp,zqm,zqp
-  real :: ssum
-  real :: prec
+  REAL :: new_m,zdq,zz
+  REAL :: zsigs(ip1jmp1),zsign(ip1jmp1),zsig
+  REAL :: v_mq(ip1jm,llm)
+  REAL :: convpn,convps,convmpn,convmps,massen,masses
+  REAL :: zm,zq,zsigm,zsigp,zqm,zqp
+  REAL :: ssum
+  REAL :: prec
   save prec
 
@@ -758,5 +758,5 @@
         do ij=1,ip1jmp1
            zdq=qn(ij,l)-qs(ij,l)
-           ! if((qn(ij,l)-q(ij,l))*(q(ij,l)-qs(ij,l)).lt.0.) then
+           ! if((qn(ij,l)-q(ij,l))*(q(ij,l)-qs(ij,l)).lt.0.) THEN
            !    PRINT*,'probleme au point ij=',ij,'  l=',l,'  advnqx'
            !    PRINT*,qn(ij,l),q(ij,l),qs(ij,l)
@@ -764,9 +764,9 @@
            !    qs(ij,l)=q(ij,l)
            ! endif
-           if(abs(zdq)>prec) then
+           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.
-  !    s               zsigs(ij).ge.0..or.zsigs(ij).le.1.) ) then
+              ! 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)
@@ -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)
@@ -798,6 +798,6 @@
       endif
       zsig=abs(v_m(ij,l))/zm
-      if(zsig==0.) zsigp=0.1
-      if (zsig<=zsigp) then
+      IF(zsig==0.) zsigp=0.1
+      if (zsig<=zsigp) THEN
           v_mq(ij,l)=v_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
       else
@@ -863,7 +863,7 @@
   !   Arguments:
   !   ----------
-  real :: masse(ip1jmp1,llm)
-  real :: w_m( ip1jmp1,llm+1)
-  real :: q(ip1jmp1,llm),qb(ip1jmp1,llm),qh(ip1jmp1,llm)
+  REAL :: masse(ip1jmp1,llm)
+  REAL :: w_m( ip1jmp1,llm+1)
+  REAL :: q(ip1jmp1,llm),qb(ip1jmp1,llm),qh(ip1jmp1,llm)
 
   !
@@ -873,9 +873,9 @@
   INTEGER :: ij,l
   !
-  real :: new_m,zdq,zz
-  real :: zsigh(ip1jmp1,llm),zsigb(ip1jmp1,llm),zsig
-  real :: w_mq(ip1jmp1,llm+1)
-  real :: zm,zq,zsigm,zsigp,zqm,zqp
-  real :: prec
+  REAL :: new_m,zdq,zz
+  REAL :: zsigh(ip1jmp1,llm),zsigb(ip1jmp1,llm),zsig
+  REAL :: w_mq(ip1jmp1,llm+1)
+  REAL :: zm,zq,zsigm,zsigp,zqm,zqp
+  REAL :: prec
   save prec
 
@@ -885,5 +885,5 @@
         do ij=1,ip1jmp1
            zdq=qb(ij,l)-qh(ij,l)
-           ! if((qh(ij,l)-q(ij,l))*(q(ij,l)-qb(ij,l)).lt.0.) then
+           ! if((qh(ij,l)-q(ij,l))*(q(ij,l)-qb(ij,l)).lt.0.) THEN
            !    PRINT*,'probleme au point ij=',ij,'  l=',l
            !    PRINT*,qh(ij,l),q(ij,l),qb(ij,l)
@@ -892,5 +892,5 @@
            ! endif
 
-           if(abs(zdq)>prec) then
+           IF(abs(zdq)>prec) THEN
               zsigb(ij,l)=(q(ij,l)-qh(ij,l))/zdq
               zsigh(ij,l)=1.-zsigb(ij,l)
@@ -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)
@@ -923,6 +923,6 @@
       endif
       zsig=abs(w_m(ij,l))/zm
-      if(zsig==0.) zsigp=0.1
-      if (zsig<=zsigp) then
+      IF(zsig==0.) zsigp=0.1
+      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/advy.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advy.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advy.f90	(revision 5116)
@@ -91,5 +91,5 @@
   REAL :: cy1(llm,ntra), cyLAT(llm,ntra)
   REAL :: z1(iim), zcos(iim), zsin(iim)
-  real :: smpn,smps,s0pn,s0ps
+  REAL :: smpn,smps,s0pn,s0ps
   REAL :: SSUM
   EXTERNAL SSUM
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/com_io_dyn_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/com_io_dyn_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/com_io_dyn_mod.F90	(revision 5116)
@@ -8,24 +8,24 @@
 ! Names of various files for outputs (in the dynamics)
   ! to store instantaneous values:
-  character(len=18),parameter :: dynhist_file="dyn_hist.nc" ! on scalar grid
-  character(len=18),parameter :: dynhistv_file="dyn_histv.nc" ! on v grid
-  character(len=18),parameter :: dynhistu_file="dyn_histu.nc" ! on u grid
+  CHARACTER(LEN=18),parameter :: dynhist_file="dyn_hist.nc" ! on scalar grid
+  CHARACTER(LEN=18),parameter :: dynhistv_file="dyn_histv.nc" ! on v grid
+  CHARACTER(LEN=18),parameter :: dynhistu_file="dyn_histu.nc" ! on u grid
 
   ! to store averaged values:
-  character(len=18),parameter :: dynhistave_file="dyn_hist_ave.nc"
-  character(len=18),parameter :: dynhistvave_file="dyn_histv_ave.nc"
-  character(len=18),parameter :: dynhistuave_file="dyn_histu_ave.nc"
+  CHARACTER(LEN=18),parameter :: dynhistave_file="dyn_hist_ave.nc"
+  CHARACTER(LEN=18),parameter :: dynhistvave_file="dyn_histv_ave.nc"
+  CHARACTER(LEN=18),parameter :: dynhistuave_file="dyn_histu_ave.nc"
   
 ! Ids of various files for outputs (in the dynamics)
 
   ! instantaneous (these are set by inithist.F)
-  integer :: histid
-  integer :: histvid
-  integer :: histuid
+  INTEGER :: histid
+  INTEGER :: histvid
+  INTEGER :: histuid
   
   ! averages (these are set by initdynav.F)
-  integer :: histaveid
-  integer :: histvaveid
-  integer :: histuaveid
+  INTEGER :: histaveid
+  INTEGER :: histvaveid
+  INTEGER :: histuaveid
   
 end module com_io_dyn_mod
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/coordij.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/coordij.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/coordij.f90	(revision 5116)
@@ -22,5 +22,5 @@
   include "comgeom.h"
 
-  real :: zlon,zlat
+  REAL :: zlon,zlat
 
   zlon=lon*pi/180.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.f90	(revision 5116)
@@ -138,5 +138,5 @@
   INTEGER :: ndiag     ! max number of diagnostic in parallel
   PARAMETER (ndiag=10)
-  integer :: pas(ndiag)
+  INTEGER :: pas(ndiag)
   save pas
   data pas/ndiag*0/
@@ -160,5 +160,5 @@
   !
   PRINT*,'MAIS POURQUOI DONC DIAGEDYN NE MARCHE PAS ?'
-  return
+  RETURN
   ! On ne garde les donnees que dans les colonnes i=1,iim
   DO jj = 1,jjp1
@@ -325,5 +325,5 @@
   !
   ELSE
-    write(lunout,*)'diagedyn: set to function with Earth parameters'
+    WRITE(lunout,*)'diagedyn: set to function with Earth parameters'
   ENDIF ! of if (planet_type=="earth")
   RETURN
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90	(revision 5116)
@@ -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 new_unit_m, 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
@@ -47,7 +47,7 @@
   REAL alpha, beta, deltaz
   REAL x
-  character(len=*),parameter :: modname="disvert"
-
-  character(len=24):: vert_sampling
+  CHARACTER(LEN=*),parameter :: modname="disvert"
+
+  CHARACTER(LEN=24):: vert_sampling
   ! (allowed values are "param", "tropo", "strato" and "read")
 
@@ -62,5 +62,5 @@
   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
@@ -82,5 +82,5 @@
      CLOSE(99)
      alpha=deltaz/(llm*scaleheight)
-     write(lunout, *)trim(modname),':scaleheight, alpha, k0, k1, beta', &
+     WRITE(lunout, *)trim(modname),':scaleheight, alpha, k0, k1, beta', &
                                scaleheight, alpha, k0, k1, beta
 
@@ -96,5 +96,5 @@
         dzk1=alpha*tanh(l/k0)
         dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
-        write(lunout, *)l, sig(l+1), zk, zk-zkm1, dzk1, dzk2
+        WRITE(lunout, *)l, sig(l+1), zk, zk-zkm1, dzk1, dzk2
         zkm1=zk
      enddo
@@ -332,13 +332,13 @@
   ENDDO
 
-  write(lunout, *)  trim(modname),': BP '
-  write(lunout, *) bp
-  write(lunout, *)  trim(modname),': AP '
-  write(lunout, *) ap
-
-  write(lunout, *) 'Niveaux de pressions approximatifs aux centres des'
-  write(lunout, *)'couches calcules pour une pression de surface =', preff
-  write(lunout, *) 'et altitudes equivalentes pour une hauteur d echelle de '
-  write(lunout, *) scaleheight,' km'
+  WRITE(lunout, *)  trim(modname),': BP '
+  WRITE(lunout, *) bp
+  WRITE(lunout, *)  trim(modname),': AP '
+  WRITE(lunout, *) ap
+
+  WRITE(lunout, *) 'Niveaux de pressions approximatifs aux centres des'
+  WRITE(lunout, *)'couches calcules pour une pression de surface =', preff
+  WRITE(lunout, *) 'et altitudes equivalentes pour une hauteur d echelle de '
+  WRITE(lunout, *) scaleheight,' km'
   DO l = 1, llm
      dpres(l) = bp(l) - bp(l+1)
@@ -347,5 +347,5 @@
      presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
      pseudoalt(l) = log(preff/presnivs(l))*scaleheight
-     write(lunout, *)'PRESNIVS(', l, ')=', presnivs(l), ' Z ~ ', &
+     WRITE(lunout, *)'PRESNIVS(', l, ')=', presnivs(l), ' Z ~ ', &
           pseudoalt(l) &
           , ' DZ ~ ', scaleheight*log((ap(l)+bp(l)*preff)/ &
@@ -354,9 +354,9 @@
   DO l=1, llmp1
      presinter(l)= ( ap(l)+bp(l)*preff)
-     write(lunout, *)'PRESINTER(', l, ')=', presinter(l)
+     WRITE(lunout, *)'PRESINTER(', l, ')=', presinter(l)
   ENDDO
 
-  write(lunout, *) trim(modname),': PRESNIVS '
-  write(lunout, *) presnivs
+  WRITE(lunout, *) trim(modname),': PRESNIVS '
+  WRITE(lunout, *) presnivs
 
 CONTAINS
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90	(revision 5116)
@@ -30,20 +30,20 @@
   REAL :: snorm
   REAL :: alpha,beta,gama,delta,deltaz
-  real :: quoi,quand
+  REAL :: quoi,quand
   REAL :: zsig(llm),sig(llm+1)
   INTEGER :: np,ierr
-  integer :: ierr1,ierr2,ierr3,ierr4
+  INTEGER :: ierr1,ierr2,ierr3,ierr4
   REAL :: x
 
   REAL :: SSUM
   EXTERNAL SSUM
-  real :: newsig
+  REAL :: newsig
   REAL :: dz0,dz1,nhaut,sig1,esig,csig,zz
-  real :: tt,rr,gg, prevz
-  real :: s(llm),dsig(llm)
-
-  integer :: iz
-  real :: z, ps,p
-  character(len=*),parameter :: modname="disvert_noterre"
+  REAL :: tt,rr,gg, prevz
+  REAL :: s(llm),dsig(llm)
+
+  INTEGER :: iz
+  REAL :: z, ps,p
+  CHARACTER(LEN=*),parameter :: modname="disvert_noterre"
 
   !
@@ -55,5 +55,5 @@
   hybrid=.TRUE. ! default value for hybrid (ie: use hybrid coordinates)
   CALL getin('hybrid',hybrid)
-  write(lunout,*) trim(modname),': hybrid=',hybrid
+  WRITE(lunout,*) trim(modname),': hybrid=',hybrid
 
   ! Ouverture possible de fichiers typiquement E.T.
@@ -61,5 +61,5 @@
      open(99,file="esasig.def",status='old',form='formatted', &
            iostat=ierr2)
-     if(ierr2/=0) then
+     IF(ierr2/=0) THEN
           close(99)
           open(99,file="z2sig.def",status='old',form='formatted', &
@@ -71,6 +71,5 @@
   !   ----------------------------------------
 
-  IF(ierr2==0) then
-
+  IF(ierr2==0) THEN
      ! Lecture de esasig.def :
      ! Systeme peu souple, mais qui respecte en theorie
@@ -78,7 +77,7 @@
      ! <-> energie cinetique, d'apres la note de Frederic Hourdin...
 
-     write(lunout,*)'*****************************'
-     write(lunout,*)'WARNING reading esasig.def'
-     write(lunout,*)'*****************************'
+     WRITE(lunout,*)'*****************************'
+     WRITE(lunout,*)'WARNING reading esasig.def'
+     WRITE(lunout,*)'*****************************'
      READ(99,*) scaleheight
      READ(99,*) dz0
@@ -126,8 +125,8 @@
   !   ----------------------------------------
 
-  ELSE IF(ierr4==0) then
-     write(lunout,*)'****************************'
-     write(lunout,*)'Reading z2sig.def'
-     write(lunout,*)'****************************'
+  ELSE IF(ierr4==0) THEN
+     WRITE(lunout,*)'****************************'
+     WRITE(lunout,*)'Reading z2sig.def'
+     WRITE(lunout,*)'****************************'
 
      READ(99,*) scaleheight
@@ -146,6 +145,6 @@
   !-----------------------------------------------------------------------
   ELSE
-     write(lunout,*) 'didn t you forget something ??? '
-     write(lunout,*) 'We need file  z2sig.def ! (OR esasig.def)'
+     WRITE(lunout,*) 'didn t you forget something ??? '
+     WRITE(lunout,*) 'We need file  z2sig.def ! (OR esasig.def)'
      stop
   ENDIF
@@ -170,7 +169,7 @@
 
   if (hybrid) then  ! use hybrid coordinates
-     write(lunout,*) "*********************************"
-     write(lunout,*) "Using hybrid vertical coordinates"
-     write(lunout,*)
+     WRITE(lunout,*) "*********************************"
+     WRITE(lunout,*) "Using hybrid vertical coordinates"
+     WRITE(lunout,*)
      ! Coordonnees hybrides avec mod
      DO l = 1, llm
@@ -183,7 +182,7 @@
      ap(llmp1) = 0.
   else ! use sigma coordinates
-     write(lunout,*) "********************************"
-     write(lunout,*) "Using sigma vertical coordinates"
-     write(lunout,*)
+     WRITE(lunout,*) "********************************"
+     WRITE(lunout,*) "Using sigma vertical coordinates"
+     WRITE(lunout,*)
      ! Pour ne pas passer en coordonnees hybrides
      DO l = 1, llm
@@ -196,8 +195,8 @@
   bp(llmp1) =   0.
 
-  write(lunout,*) trim(modname),': BP '
-  write(lunout,*)  bp
-  write(lunout,*) trim(modname),': AP '
-  write(lunout,*)  ap
+  WRITE(lunout,*) trim(modname),': BP '
+  WRITE(lunout,*)  bp
+  WRITE(lunout,*) trim(modname),': AP '
+  WRITE(lunout,*)  ap
 
   ! Calcul au milieu des couches :
@@ -214,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))
@@ -222,8 +221,8 @@
   end if
 
-  write(lunout,*) trim(modname),': BPs '
-  write(lunout,*)  bps
-  write(lunout,*) trim(modname),': APs'
-  write(lunout,*)  aps
+  WRITE(lunout,*) trim(modname),': BPs '
+  WRITE(lunout,*)  bps
+  WRITE(lunout,*) trim(modname),': APs'
+  WRITE(lunout,*)  aps
 
   DO l = 1, llm
@@ -232,9 +231,9 @@
   ENDDO
 
-  write(lunout,*)trim(modname),' : PRESNIVS'
-  write(lunout,*)presnivs
-  write(lunout,*)'Pseudo altitude of Presnivs : (for a scale ', &
+  WRITE(lunout,*)trim(modname),' : PRESNIVS'
+  WRITE(lunout,*)presnivs
+  WRITE(lunout,*)'Pseudo altitude of Presnivs : (for a scale ', &
         'height of ',scaleheight,' km)'
-  write(lunout,*)pseudoalt
+  WRITE(lunout,*)pseudoalt
 
   ! --------------------------------------------------
@@ -252,5 +251,5 @@
   !   do l=2,llm
   ! approximation of scale height for Venus
-  !      if (zsig(l-1).le.55.) then
+  !      if (zsig(l-1).le.55.) THEN
   !         scaleheight = 15.5 - zsig(l-1)/55.*10.
   !      else
@@ -260,5 +259,5 @@
   !    .    log((aps(l) + bps(l)*ps)/(aps(l-1) + bps(l-1)*ps))
   !   END DO
-  !   write(53,'(I3,50F10.5)') iz, zsig
+  !   WRITE(53,'(I3,50F10.5)') iz, zsig
   !  END DO
   !  close(53)
@@ -296,17 +295,17 @@
 
   IMPLICIT NONE
-  real :: x1, x2, sig,pa,preff, newsig, F
-  integer :: j
+  REAL :: x1, x2, sig,pa,preff, newsig, F
+  INTEGER :: j
 
   newsig = sig
   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
+      ! WRITE(0,*) J, ' newsig =', newsig, ' F= ', F
+      if (F>1) THEN
           X2 = newsig
           newsig=(X1+newsig)*0.5
@@ -319,5 +318,5 @@
       IF(abs(10.*log(F))<1.E-5) goto 999
     END DO
-   else   !    if (sig*preff/pa.le.0.25) then
+   else   !    if (sig*preff/pa.le.0.25) THEN
          newsig= sig*preff/pa
    end if
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90	(revision 5116)
@@ -54,15 +54,15 @@
 
     logical,save :: firstcall=.TRUE.
-    character(len=*),parameter :: modname="exner_hyb"
+    CHARACTER(LEN=*),parameter :: modname="exner_hyb"
 
     ! 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)
@@ -74,6 +74,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) then
-
+    if (llm==1) THEN
        ! Compute pks(:),pk(:),pkf(:)
 
@@ -83,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 +88,5 @@
 
        ! our work is done, exit routine
-       return
+       RETURN
     endif ! of if (llm.eq.1)
 
@@ -138,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_milieu_m.F90	(revision 5116)
@@ -51,15 +51,15 @@
 
     logical,save :: firstcall=.TRUE.
-    character(len=*),parameter :: modname="exner_milieu"
+    CHARACTER(LEN=*),parameter :: modname="exner_milieu"
 
     ! 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)
@@ -71,6 +71,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) then
-
+    if (llm==1) THEN
        ! Compute pks(:),pk(:),pkf(:)
 
@@ -80,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 +85,5 @@
 
        ! our work is done, exit routine
-       return
+       RETURN
     endif ! of if (llm.eq.1)
 
@@ -117,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxhyp_m.F90	(revision 5116)
@@ -18,9 +18,9 @@
     ! 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 nrtype, 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"
@@ -45,5 +45,5 @@
     print *, "Call sequence information: fxhyp"
 
-    test_iim: if (iim==1) then
+    test_iim: if (iim==1) THEN
        rlonv(1)=0.
        rlonu(1)=pi
@@ -56,5 +56,5 @@
        xprimp025(:)=1.
     else test_iim
-       test_grossismx: if (grossismx == 1.) then
+       test_grossismx: if (grossismx == 1.) THEN
           step = twopi / iim
 
@@ -193,5 +193,5 @@
              END DO
 
-             if (rlonm025(is2) < - pi) then
+             if (rlonm025(is2) < - pi) THEN
                 print *, 'Rlonm025 plus petit que - pi !'
                 STOP 1
@@ -204,5 +204,5 @@
              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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fyhyp_m.F90	(revision 5116)
@@ -16,7 +16,7 @@
     ! 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 nrtype, ONLY: k8
+    use serre_mod, ONLY: clat, grossismy, dzoomy, tauy
 
     include "dimensions.h"
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gr_int_dyn.f90	(revision 5116)
@@ -12,10 +12,10 @@
 
   INTEGER :: iim
-  integer :: ip1, jp1
+  INTEGER :: ip1, jp1
   REAL :: champin(iim, jp1)
   REAL :: champdyn(iim+1, jp1)
 
   INTEGER :: i, j
-  real :: polenord, polesud
+  REAL :: polenord, polesud
 
   !-----------------------------------------------------------------------
@@ -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/grilles_gcm_netcdf_sub.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90	(revision 5116)
@@ -226,5 +226,5 @@
   ! CLOSE netcdf file
   CALL ncclos(ncid_out,rcode_out)
-  write(*,*) "END grilles_gcm_netcdf_sub OK"
+  WRITE(*,*) "END grilles_gcm_netcdf_sub OK"
 
 END SUBROUTINE grilles_gcm_netcdf_sub
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iniconst.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iniconst.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iniconst.F90	(revision 5116)
@@ -21,6 +21,6 @@
   include "iniprint.h"
 
-  character(len=*),parameter :: modname="iniconst"
-  character(len=80) :: abort_message
+  CHARACTER(LEN=*),parameter :: modname="iniconst"
+  CHARACTER(LEN=80) :: abort_message
 
 
@@ -48,10 +48,10 @@
   r       = cpp * kappa
 
-  write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
+  WRITE(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
 
   !-----------------------------------------------------------------------
 
   ! vertical discretization: default behavior depends on planet_type flag
-  if (planet_type=="earth") then
+  if (planet_type=="earth") THEN
      disvert_type=1
   else
@@ -60,17 +60,17 @@
   ! but user can also specify using one or the other in run.def:
   CALL getin('disvert_type',disvert_type)
-  write(lunout,*) trim(modname),': disvert_type=',disvert_type
+  WRITE(lunout,*) trim(modname),': disvert_type=',disvert_type
 
   pressure_exner = disvert_type == 1 ! default value
   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
   else
-     write(abort_message,*) "Wrong value for disvert_type: ", disvert_type
+     WRITE(abort_message,*) "Wrong value for disvert_type: ", disvert_type
      CALL abort_gcm(modname,abort_message,0)
   endif
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inidissip.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inidissip.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inidissip.F90	(revision 5116)
@@ -1,7 +1,6 @@
-
 ! $Id$
 
-SUBROUTINE inidissip( lstardis,nitergdiv,nitergrot,niterh  , &
-     tetagdiv,tetagrot,tetatemp, vert_prof_dissip)
+SUBROUTINE inidissip(lstardis, nitergdiv, nitergrot, niterh, &
+        tetagdiv, tetagrot, tetatemp, vert_prof_dissip)
   !=======================================================================
   !   initialisation de la dissipation horizontale
@@ -11,9 +10,10 @@
   !   -------------
 
-  USE control_mod, ONLY: dissip_period,iperiod
+  USE control_mod, ONLY: dissip_period, iperiod
   USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
-                          dtdiss, dtvr, rad
+          dtdiss, dtvr, rad
   USE comvert_mod, ONLY: preff, presnivs
   USE lmdz_filtreg, ONLY: filtreg
+  USE lmdz_libmath, ONLY: minmax
 
   IMPLICIT NONE
@@ -23,9 +23,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:
@@ -33,15 +33,15 @@
   ! 1: tanh of altitude
 
-! Local variables:
-  REAL fact,zvert(llm),zz
-  REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
-  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm)
-  REAL ullm,vllm,umin,vmin,zhmin,zhmax
+  ! Local variables:
+  REAL fact, zvert(llm), zz
+  REAL zh(ip1jmp1), zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
+  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1, llm)
+  REAL ullm, vllm, umin, vmin, zhmin, zhmax
   REAL zllm
 
-  INTEGER l,ij,idum,ii
+  INTEGER l, ij, idum, ii
   REAL tetamin
   REAL pseudoz
-  character (len=80) :: abort_message
+  character (len = 80) :: abort_message
 
   REAL ran1
@@ -53,7 +53,7 @@
   !   -----------------------------------------------------------------
 
-  crot     = -1.
-  cdivu    = -1.
-  cdivh    = -1.
+  crot = -1.
+  cdivu = -1.
+  cdivh = -1.
 
   !   calcul de la valeur propre de divgrad:
@@ -61,99 +61,99 @@
   idum = 0
   DO l = 1, llm
-     DO ij = 1, ip1jmp1
-        deltap(ij,l) = 1.
-     ENDDO
-  ENDDO
-
-  idum  = -1
-  zh(1) = RAN1(idum)-.5
-  idum  = 0
+    DO ij = 1, ip1jmp1
+      deltap(ij, l) = 1.
+    ENDDO
+  ENDDO
+
+  idum = -1
+  zh(1) = RAN1(idum) - .5
+  idum = 0
   DO ij = 2, ip1jmp1
-     zh(ij) = RAN1(idum) -.5
-  ENDDO
-
-  CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
-
-  CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
-
-  IF ( zhmin >= zhmax  )     THEN
-     write(lunout,*)'  Inidissip  zh min max  ',zhmin,zhmax
-     abort_message='probleme generateur alleatoire dans inidissip'
-     CALL abort_gcm('inidissip',abort_message,1)
+    zh(ij) = RAN1(idum) - .5
+  ENDDO
+
+  CALL filtreg (zh, jjp1, 1, 2, 1, .TRUE., 1)
+
+  CALL minmax(iip1 * jjp1, zh, zhmin, zhmax)
+
+  IF (zhmin >= zhmax)     THEN
+    WRITE(lunout, *)'  Inidissip  zh min max  ', zhmin, zhmax
+    abort_message = 'probleme generateur alleatoire dans inidissip'
+    CALL abort_gcm('inidissip', abort_message, 1)
   ENDIF
 
-  zllm = ABS( zhmax )
-  DO l = 1,50
-     IF(lstardis) THEN
-        CALL divgrad2(1,zh,deltap,niterh,divgra)
-     ELSE
-        CALL divgrad (1,zh,niterh,divgra)
-     ENDIF
-
-     zllm  = ABS(maxval(divgra))
-     zh = divgra / zllm
+  zllm = ABS(zhmax)
+  DO l = 1, 50
+    IF(lstardis) THEN
+      CALL divgrad2(1, zh, deltap, niterh, divgra)
+    ELSE
+      CALL divgrad (1, zh, niterh, divgra)
+    ENDIF
+
+    zllm = ABS(maxval(divgra))
+    zh = divgra / zllm
   ENDDO
 
   IF(lstardis) THEN
-     cdivh = 1./ zllm
+    cdivh = 1. / zllm
   ELSE
-     cdivh = zllm ** ( -1./niterh )
+    cdivh = zllm ** (-1. / niterh)
   ENDIF
 
   !   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
   !   -----------------------------------------------------------------
-  write(lunout,*)'inidissip: calcul des valeurs propres'
+  WRITE(lunout, *)'inidissip: calcul des valeurs propres'
 
   DO    ii = 1, 2
 
-     DO ij = 1, ip1jmp1
-        zu(ij)  = RAN1(idum) -.5
-     ENDDO
-     CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
-     DO ij = 1, ip1jm
-        zv(ij) = RAN1(idum) -.5
-     ENDDO
-     CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
-
-     CALL minmax(iip1*jjp1,zu,umin,ullm )
-     CALL minmax(iip1*jjm, zv,vmin,vllm )
-
-     ullm = ABS ( ullm )
-     vllm = ABS ( vllm )
-
-     DO    l = 1, 50
-        IF(ii==1) THEN
-           !cccc             CALL covcont( 1,zu,zv,zu,zv )
-           IF(lstardis) THEN
-              CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy )
-           ELSE
-              CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy )
-           ENDIF
+    DO ij = 1, ip1jmp1
+      zu(ij) = RAN1(idum) - .5
+    ENDDO
+    CALL filtreg (zu, jjp1, 1, 2, 1, .TRUE., 1)
+    DO ij = 1, ip1jm
+      zv(ij) = RAN1(idum) - .5
+    ENDDO
+    CALL filtreg (zv, jjm, 1, 2, 1, .FALSE., 1)
+
+    CALL minmax(iip1 * jjp1, zu, umin, ullm)
+    CALL minmax(iip1 * jjm, zv, vmin, vllm)
+
+    ullm = ABS (ullm)
+    vllm = ABS (vllm)
+
+    DO    l = 1, 50
+      IF(ii==1) THEN
+        !cccc             CALL covcont( 1,zu,zv,zu,zv )
+        IF(lstardis) THEN
+          CALL gradiv2(1, zu, zv, nitergdiv, gx, gy)
         ELSE
-           IF(lstardis) THEN
-              CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy )
-           ELSE
-              CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy )
-           ENDIF
+          CALL gradiv (1, zu, zv, nitergdiv, gx, gy)
         ENDIF
-
-        zllm = max(abs(maxval(gx)), abs(maxval(gy)))
-        zu = gx / zllm
-        zv = gy / zllm
-     end DO
-
-     IF ( ii==1 ) THEN
+      ELSE
         IF(lstardis) THEN
-           cdivu  = 1./zllm
+          CALL nxgraro2(1, zu, zv, nitergrot, gx, gy)
         ELSE
-           cdivu  = zllm **( -1./nitergdiv )
+          CALL nxgrarot(1, zu, zv, nitergrot, gx, gy)
         ENDIF
-     ELSE
-        IF(lstardis) THEN
-           crot   = 1./ zllm
-        ELSE
-           crot   = zllm **( -1./nitergrot )
-        ENDIF
-     ENDIF
+      ENDIF
+
+      zllm = max(abs(maxval(gx)), abs(maxval(gy)))
+      zu = gx / zllm
+      zv = gy / zllm
+    end DO
+
+    IF (ii==1) THEN
+      IF(lstardis) THEN
+        cdivu = 1. / zllm
+      ELSE
+        cdivu = zllm **(-1. / nitergdiv)
+      ENDIF
+    ELSE
+      IF(lstardis) THEN
+        crot = 1. / zllm
+      ELSE
+        crot = zllm **(-1. / nitergrot)
+      ENDIF
+    ENDIF
 
   end DO
@@ -163,9 +163,9 @@
 
   !     IF(.NOT.lstardis) THEN
-  fact    = rad*24./REAL(jjm)
-  fact    = fact*fact
-  write(lunout,*)'inidissip: coef u ', fact/cdivu, 1./cdivu
-  write(lunout,*)'inidissip: coef r ', fact/crot , 1./crot
-  write(lunout,*)'inidissip: coef h ', fact/cdivh, 1./cdivh
+  fact = rad * 24. / REAL(jjm)
+  fact = fact * fact
+  WRITE(lunout, *)'inidissip: coef u ', fact / cdivu, 1. / cdivu
+  WRITE(lunout, *)'inidissip: coef r ', fact / crot, 1. / crot
+  WRITE(lunout, *)'inidissip: coef h ', fact / cdivh, 1. / cdivh
   !     ENDIF
 
@@ -174,50 +174,49 @@
   !   --------------------------------------------------
 
-  if (vert_prof_dissip == 1) then
-     do l=1,llm
-        pseudoz=8.*log(preff/presnivs(l))
-        zvert(l)=1+ &
-             (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2. &
-             *(dissip_factz-1.)
-     enddo
+  if (vert_prof_dissip == 1) THEN
+    do l = 1, llm
+      pseudoz = 8. * log(preff / presnivs(l))
+      zvert(l) = 1 + &
+              (tanh((pseudoz - dissip_zref) / dissip_deltaz) + 1.) / 2. &
+                      * (dissip_factz - 1.)
+    enddo
   else
-     DO l=1,llm
-        zvert(l)=1.
-     ENDDO
-     fact=2.
-     DO l = 1, llm
-        zz      = 1. - preff/presnivs(l)
-        zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
-     ENDDO
+    DO l = 1, llm
+      zvert(l) = 1.
+    ENDDO
+    fact = 2.
+    DO l = 1, llm
+      zz = 1. - preff / presnivs(l)
+      zvert(l) = fact - (fact - 1.) / (1. + zz * zz)
+    ENDDO
   endif
 
-
-  write(lunout,*)'inidissip: Constantes de temps de la diffusion horizontale'
-
-  tetamin =  1.e+6
-
-  DO l=1,llm
-     tetaudiv(l)   = zvert(l)/tetagdiv
-     tetaurot(l)   = zvert(l)/tetagrot
-     tetah(l)      = zvert(l)/tetatemp
-
-     IF( tetamin> (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
-     IF( tetamin> (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
-     IF( tetamin> (1./   tetah(l)) ) tetamin = 1./    tetah(l)
+  WRITE(lunout, *)'inidissip: Constantes de temps de la diffusion horizontale'
+
+  tetamin = 1.e+6
+
+  DO l = 1, llm
+    tetaudiv(l) = zvert(l) / tetagdiv
+    tetaurot(l) = zvert(l) / tetagrot
+    tetah(l) = zvert(l) / tetatemp
+
+    IF(tetamin> (1. / tetaudiv(l))) tetamin = 1. / tetaudiv(l)
+    IF(tetamin> (1. / tetaurot(l))) tetamin = 1. / tetaurot(l)
+    IF(tetamin> (1. / tetah(l))) tetamin = 1. / tetah(l)
   ENDDO
 
   ! If dissip_period=0 calculate value for dissipation period, else keep value read from gcm.def
   IF (dissip_period == 0) THEN
-     dissip_period = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
-     write(lunout,*)'inidissip: tetamin dtvr iperiod dissip_period(intermed) ',tetamin,dtvr,iperiod,dissip_period
-     dissip_period = MAX(iperiod,dissip_period)
+    dissip_period = INT(tetamin / (2. * dtvr * iperiod)) * iperiod
+    WRITE(lunout, *)'inidissip: tetamin dtvr iperiod dissip_period(intermed) ', tetamin, dtvr, iperiod, dissip_period
+    dissip_period = MAX(iperiod, dissip_period)
   END IF
 
-  dtdiss  = dissip_period * dtvr
-  write(lunout,*)'inidissip: dissip_period=',dissip_period,' dtdiss=',dtdiss,' dtvr=',dtvr
-
-  DO l = 1,llm
-     write(lunout,*)zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l), &
-          dtdiss*tetah(l)
+  dtdiss = dissip_period * dtvr
+  WRITE(lunout, *)'inidissip: dissip_period=', dissip_period, ' dtdiss=', dtdiss, ' dtvr=', dtvr
+
+  DO l = 1, llm
+    WRITE(lunout, *)zvert(l), dtdiss * tetaudiv(l), dtdiss * tetaurot(l), &
+            dtdiss * tetah(l)
   ENDDO
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.f90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigrads.f90	(revision 5116)
@@ -7,15 +7,15 @@
   IMPLICIT NONE
 
-  integer :: if, im, jm, lm, i, j, l
-  real :: x(im), y(jm), z(lm), fx, fy, fz, dt
-  real :: xmin, xmax, ymin, ymax
+  INTEGER :: if, im, jm, lm, i, j, l
+  REAL :: x(im), y(jm), z(lm), fx, fy, fz, dt
+  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"
 
   ! data unit/66,32,34,36,38,40,42,44,46,48/
-  integer :: nf
+  INTEGER :: nf
   save nf
   data nf/0/
@@ -49,6 +49,6 @@
   do i = 1, im
     xd(i, if) = x(i) * fx
-    if(xd(i, if)<xmin) iid(if) = i + 1
-    if(xd(i, if)<=xmax) ifd(if) = i
+    IF(xd(i, if)<xmin) iid(if) = i + 1
+    IF(xd(i, if)<=xmax) ifd(if) = i
   enddo
   PRINT*, 'On stoke du point ', iid(if), '  a ', ifd(if), ' en x'
@@ -59,6 +59,6 @@
   do j = 1, jm
     yd(j, if) = y(j) * fy
-    if(yd(j, if)>ymax) jid(if) = j + 1
-    if(yd(j, if)>=ymin) jfd(if) = j
+    IF(yd(j, if)>ymax) jid(if) = j + 1
+    IF(yd(j, if)>=ymin) jfd(if) = j
   enddo
   PRINT*, 'On stoke du point ', jid(if), '  a ', jfd(if), ' en y'
@@ -89,3 +89,3 @@
 
 
-end subroutine inigrads
+END SUBROUTINE inigrads
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90	(revision 5116)
@@ -47,21 +47,21 @@
   !   Arguments
   !
-  character(len = *) :: infile
-  real :: tstep, t_ops, t_wrt
-  integer :: fileid, filevid, filedid
+  CHARACTER(LEN = *) :: infile
+  REAL :: tstep, t_ops, t_wrt
+  INTEGER :: fileid, filevid, filedid
 
   ! This routine needs IOIPSL to work
   !   Variables locales
   !
-  real :: nivd(1)
-  integer :: tau0
-  real :: zjulian
-  character(len = 3) :: str
-  character(len = 10) :: ctrac
-  integer :: iq
-  real :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1)
-  integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
-  integer :: ii, jj
-  integer :: zan, idayref
+  REAL :: nivd(1)
+  INTEGER :: tau0
+  REAL :: zjulian
+  CHARACTER(LEN = 3) :: str
+  CHARACTER(LEN = 10) :: ctrac
+  INTEGER :: iq
+  REAL :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1)
+  INTEGER :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
+  INTEGER :: ii, jj
+  INTEGER :: zan, idayref
   logical :: ok_sync
   !
@@ -211,5 +211,5 @@
   CALL histend(filevid)
   CALL histend(filedid)
-  if (ok_sync) then
+  if (ok_sync) THEN
     CALL histsync(fileid)
     CALL histsync(filevid)
@@ -217,4 +217,4 @@
   endif
 
-  return
-end subroutine initfluxsto
+  RETURN
+END SUBROUTINE initfluxsto
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90	(revision 5116)
@@ -46,17 +46,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
   !
   !  Initialisations
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90	(revision 5116)
@@ -1,3 +1,2 @@
-
 ! $Id$
 
@@ -15,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"
@@ -27,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)
@@ -55,9 +54,9 @@
 
     jnterfd = assert_eq(size(champ, 2) - 1, size(dlatid), &
-         "inter_barxy jnterfd")
+            "inter_barxy jnterfd")
     jmods = size(champint, 2)
     CALL assert(size(champ, 1) == size(dlonid), "inter_barxy size(champ, 1)")
     CALL assert((/size(rlonimod), size(champint, 1)/) == iim, &
-         "inter_barxy iim")
+            "inter_barxy iim")
     CALL assert(any(jmods == (/jjm, jjm + 1/)), 'inter_barxy jmods')
     CALL assert(size(rlatimod) == jjm, "inter_barxy size(rlatimod)")
@@ -65,16 +64,16 @@
     ! Check decreasing order for "rlatimod":
     DO i = 2, jjm
-       IF (rlatimod(i) >= rlatimod(i-1)) stop &
-            '"inter_barxy": "rlatimod" should be strictly decreasing'
+      IF (rlatimod(i) >= rlatimod(i - 1)) stop &
+              '"inter_barxy": "rlatimod" should be strictly decreasing'
     ENDDO
 
     yjmod(:jjm) = ord_coordm(rlatimod)
     IF (jmods == jjm + 1) THEN
-       IF (90. - yjmod(jjm) < 0.01) stop &
-            '"inter_barxy": with jmods = jjm + 1, yjmod(jjm) should be < 90.'
+      IF (90. - yjmod(jjm) < 0.01) stop &
+              '"inter_barxy": with jmods = jjm + 1, yjmod(jjm) should be < 90.'
     ELSE
-       ! jmods = jjm
-       IF (ABS(yjmod(jjm) - 90.) > 0.01) stop &
-            '"inter_barxy": with jmods = jjm, yjmod(jjm) should be 90.'
+      ! jmods = jjm
+      IF (ABS(yjmod(jjm) - 90.) > 0.01) stop &
+              '"inter_barxy": with jmods = jjm, yjmod(jjm) should be 90.'
     ENDIF
 
@@ -82,19 +81,19 @@
 
     DO j = 1, jnterfd + 1
-       champy(:, j) = inter_barx(dlonid, champ(:, j), rlonimod)
-    ENDDO
-
-    CALL ord_coord(dlatid, yjdat, decrois) 
+      champy(:, j) = inter_barx(dlonid, champ(:, j), rlonimod)
+    ENDDO
+
+    CALL ord_coord(dlatid, yjdat, decrois)
     IF (decrois) champy(:, :) = champy(:, jnterfd + 1:1:-1)
     DO i = 1, iim
-       champint(i, :) = inter_bary(yjdat, champy(i, :), yjmod)
+      champint(i, :) = inter_bary(yjdat, champy(i, :), yjmod)
     ENDDO
     champint(:, :) = champint(:, jmods:1:-1)
 
     IF (jmods == jjm + 1) THEN
-       ! Valeurs uniques aux poles
-       champint(:, 1) = SUM(aire(:iim,  1) * champint(:, 1)) / apoln
-       champint(:, jjm + 1) = SUM(aire(:iim, jjm + 1) &
-            * champint(:, jjm + 1)) / apols
+      ! Valeurs uniques aux poles
+      champint(:, 1) = SUM(aire(:iim, 1) * champint(:, 1)) / apoln
+      champint(:, jjm + 1) = SUM(aire(:iim, jjm + 1) &
+              * champint(:, jjm + 1)) / apols
     ENDIF
 
@@ -103,5 +102,5 @@
   !******************************
 
-  function inter_barx(dlonid, fdat, rlonimod) 
+  function inter_barx(dlonid, fdat, rlonimod)
 
     !        INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES
@@ -117,11 +116,12 @@
     !      ( Les abscisses sont exprimees en degres)
 
-    use lmdz_assert_eq, only: assert_eq
+    USE lmdz_assert_eq, ONLY: assert_eq
+    USE lmdz_libmath, ONLY: minmax
 
     IMPLICIT NONE
 
-    REAL, intent(in):: dlonid(:)
-    real, intent(in):: fdat(:)
-    real, intent(in):: rlonimod(:)
+    REAL, intent(in) :: dlonid(:)
+    real, intent(in) :: fdat(:)
+    real, intent(in) :: rlonimod(:)
 
     real inter_barx(size(rlonimod))
@@ -130,6 +130,6 @@
 
     INTEGER idatmax, imodmax
-    REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1)
-    REAL  fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1) 
+    REAL xxid(size(dlonid) + 1), xxd(size(dlonid) + 1), fdd(size(dlonid) + 1)
+    REAL  fxd(size(dlonid) + 1), xchan(size(dlonid) + 1), fdchan(size(dlonid) + 1)
     REAL  xxim(size(rlonimod))
 
@@ -149,12 +149,12 @@
     !    A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE  
     DO imod = 1, imodmax
-       xxim(imod) = rlonimod(imod)
-    ENDDO
-
-    CALL minmax( imodmax, xxim, chmin, chmax)
-    IF( chmax<6.50 )   THEN
-       DO imod = 1, imodmax
-          xxim(imod) = xxim(imod) * 180./pi
-       ENDDO
+      xxim(imod) = rlonimod(imod)
+    ENDDO
+
+    CALL minmax(imodmax, xxim, chmin, chmax)
+    IF(chmax<6.50)   THEN
+      DO imod = 1, imodmax
+        xxim(imod) = xxim(imod) * 180. / pi
+      ENDDO
     ENDIF
 
@@ -162,45 +162,45 @@
 
     DO imod = 1, imodmax
-       xxim(imod) = xxim(imod) - xim0
-    ENDDO
-
-    idatmax1 = idatmax +1
+      xxim(imod) = xxim(imod) - xim0
+    ENDDO
+
+    idatmax1 = idatmax + 1
 
     DO idat = 1, idatmax
-       xxd(idat) = dlonid(idat)
-    ENDDO
-
-    CALL minmax( idatmax, xxd, chmin, chmax)
-    IF( chmax<6.50 )  THEN
-       DO idat = 1, idatmax
-          xxd(idat) = xxd(idat) * 180./pi
-       ENDDO
+      xxd(idat) = dlonid(idat)
+    ENDDO
+
+    CALL minmax(idatmax, xxd, chmin, chmax)
+    IF(chmax<6.50)  THEN
+      DO idat = 1, idatmax
+        xxd(idat) = xxd(idat) * 180. / pi
+      ENDDO
     ENDIF
 
     DO idat = 1, idatmax
-       xxd(idat) = MOD( xxd(idat) - xim0, 360. )
-       fdd(idat) = fdat (idat)
+      xxd(idat) = MOD(xxd(idat) - xim0, 360.)
+      fdd(idat) = fdat (idat)
     ENDDO
 
     i = 2
-    DO while (xxd(i) >= xxd(i-1) .and. i < idatmax)
-       i = i + 1
-    ENDDO
-    IF (xxd(i) < xxd(i-1)) THEN
-       ichang = i
-       !  ***  reorganisation  des longitudes entre 0. et 360. degres ****
-       nid = idatmax - ichang +1
-       DO i = 1, nid
-          xchan (i) = xxd(i+ichang -1 )
-          fdchan(i) = fdd(i+ichang -1 )
-       ENDDO
-       DO i=1, ichang -1
-          xchan (i+ nid) = xxd(i)
-          fdchan(i+nid) = fdd(i) 
-       ENDDO
-       DO i =1, idatmax
-          xxd(i) = xchan(i)
-          fdd(i) = fdchan(i)
-       ENDDO
+    DO while (xxd(i) >= xxd(i - 1) .and. i < idatmax)
+      i = i + 1
+    ENDDO
+    IF (xxd(i) < xxd(i - 1)) THEN
+      ichang = i
+      !  ***  reorganisation  des longitudes entre 0. et 360. degres ****
+      nid = idatmax - ichang + 1
+      DO i = 1, nid
+        xchan (i) = xxd(i + ichang - 1)
+        fdchan(i) = fdd(i + ichang - 1)
+      ENDDO
+      DO i = 1, ichang - 1
+        xchan (i + nid) = xxd(i)
+        fdchan(i + nid) = fdd(i)
+      ENDDO
+      DO i = 1, idatmax
+        xxd(i) = xchan(i)
+        fdd(i) = fdchan(i)
+      ENDDO
     end IF
 
@@ -213,39 +213,39 @@
 
     DO idat = 1, idatmax
-       IF ( xxd( idatmax1- idat )<360.) exit
-       id1 = id1 + 1
+      IF (xxd(idatmax1 - idat)<360.) exit
+      id1 = id1 + 1
     ENDDO
 
     DO idat = 1, idatmax
-       IF (xxd(idat)>0.) exit
-       id0 = id0 + 1
+      IF (xxd(idat)>0.) exit
+      id0 = id0 + 1
     END DO
 
-    IF( id1 /= 0 ) then
-       DO idat = 1, id1
-          xxid(idat) = xxd(idatmax - id1 + idat) - 360.
-          fxd (idat) = fdd(idatmax - id1 + idat)     
-       END DO
-       DO idat = 1, idatmax - id1
-          xxid(idat + id1) = xxd(idat)
-          fxd (idat + id1) = fdd(idat)
-       END DO
+    IF(id1 /= 0) THEN
+      DO idat = 1, id1
+        xxid(idat) = xxd(idatmax - id1 + idat) - 360.
+        fxd (idat) = fdd(idatmax - id1 + idat)
+      END DO
+      DO idat = 1, idatmax - id1
+        xxid(idat + id1) = xxd(idat)
+        fxd (idat + id1) = fdd(idat)
+      END DO
     end IF
 
-    IF(id0 /= 0) then
-       DO idat = 1, idatmax - id0
-          xxid(idat) = xxd(idat + id0)
-          fxd (idat) = fdd(idat + id0)
-       END DO
-
-       DO idat = 1, id0
-          xxid (idatmax - id0 + idat) =  xxd(idat) + 360.
-          fxd  (idatmax - id0 + idat) =  fdd(idat)   
-       END DO
-    else 
-       DO idat = 1, idatmax
-          xxid(idat)  = xxd(idat)
-          fxd (idat)  = fdd(idat)
-       ENDDO
+    IF(id0 /= 0) THEN
+      DO idat = 1, idatmax - id0
+        xxid(idat) = xxd(idat + id0)
+        fxd (idat) = fdd(idat + id0)
+      END DO
+
+      DO idat = 1, id0
+        xxid (idatmax - id0 + idat) = xxd(idat) + 360.
+        fxd  (idatmax - id0 + idat) = fdd(idat)
+      END DO
+    else
+      DO idat = 1, idatmax
+        xxid(idat) = xxd(idat)
+        fxd (idat) = fdd(idat)
+      ENDDO
     end IF
     xxid(idatmax1) = xxid(1) + 360.
@@ -258,33 +258,33 @@
     ! iteration
 
-    x0   = xim0
-    dxm  = 0.
+    x0 = xim0
+    dxm = 0.
     imod = 1
     idat = 1
 
     do while (imod <= imodmax)
-       do while (xxim(imod)>xxid(idat))
-          dx   = xxid(idat) - x0
-          dxm  = dxm + dx
-          inter_barx(imod) = inter_barx(imod) + dx * fxd(idat)
-          x0   = xxid(idat)
-          idat = idat + 1
-       END DO
-       IF (xxim(imod)<xxid(idat)) THEN
-          dx   = xxim(imod) - x0
-          dxm  = dxm + dx
-          inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
-          x0   = xxim(imod)
-          dxm  = 0.
-          imod = imod + 1
-       ELSE
-          dx   = xxim(imod) - x0
-          dxm  = dxm + dx
-          inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
-          x0   = xxim(imod)
-          dxm  = 0.
-          imod = imod + 1
-          idat = idat + 1
-       END IF
+      do while (xxim(imod)>xxid(idat))
+        dx = xxid(idat) - x0
+        dxm = dxm + dx
+        inter_barx(imod) = inter_barx(imod) + dx * fxd(idat)
+        x0 = xxid(idat)
+        idat = idat + 1
+      END DO
+      IF (xxim(imod)<xxid(idat)) THEN
+        dx = xxim(imod) - x0
+        dxm = dxm + dx
+        inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
+        x0 = xxim(imod)
+        dxm = 0.
+        imod = imod + 1
+      ELSE
+        dx = xxim(imod) - x0
+        dxm = dxm + dx
+        inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
+        x0 = xxim(imod)
+        dxm = 0.
+        imod = imod + 1
+        idat = idat + 1
+      END IF
     END DO
 
@@ -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)
@@ -317,5 +317,5 @@
     ! Variables local to the procedure:
 
-    REAL y0, dy, dym 
+    REAL y0, dy, dym
     INTEGER jdat ! indice du champ de données
     integer jmod ! indice du champ du modèle
@@ -327,34 +327,34 @@
     ! Initialisation des variables
     inter_bary(:) = 0.
-    y0    = -90.
-    dym   = 0.
-    jmod  = 1
-    jdat  = 1
+    y0 = -90.
+    dym = 0.
+    jmod = 1
+    jdat = 1
 
     do while (jmod <= size(yjmod))
-       do while (yjmod(jmod) > yjdat(jdat))
-          dy         = yjdat(jdat) - y0
-          dym        = dym + dy
-          inter_bary(jmod) = inter_bary(jmod) + dy * fdat(jdat)
-          y0         = yjdat(jdat)
-          jdat       = jdat + 1
-       END DO
-       IF (yjmod(jmod) < yjdat(jdat)) THEN
-          dy         = yjmod(jmod) - y0
-          dym        = dym + dy
-          inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
-          y0         = yjmod(jmod)
-          dym        = 0.
-          jmod       = jmod + 1
-       ELSE
-          ! {yjmod(jmod) == yjdat(jdat)}
-          dy         = yjmod(jmod) - y0
-          dym        = dym + dy
-          inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
-          y0         = yjmod(jmod)
-          dym        = 0.
-          jmod       = jmod + 1
-          jdat       = jdat + 1
-       END IF
+      do while (yjmod(jmod) > yjdat(jdat))
+        dy = yjdat(jdat) - y0
+        dym = dym + dy
+        inter_bary(jmod) = inter_bary(jmod) + dy * fdat(jdat)
+        y0 = yjdat(jdat)
+        jdat = jdat + 1
+      END DO
+      IF (yjmod(jmod) < yjdat(jdat)) THEN
+        dy = yjmod(jmod) - y0
+        dym = dym + dy
+        inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
+        y0 = yjmod(jmod)
+        dym = 0.
+        jmod = jmod + 1
+      ELSE
+        ! {yjmod(jmod) == yjdat(jdat)}
+        dy = yjmod(jmod) - y0
+        dym = dym + dy
+        inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
+        y0 = yjmod(jmod)
+        dym = 0.
+        jmod = jmod + 1
+        jdat = jdat + 1
+      END IF
     END DO
     ! Le test de fin suppose que l'interface 0 est commune aux deux
@@ -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:
@@ -398,21 +398,21 @@
     decrois = xi(2) < xi(1)
     DO i = 3, nmax
-       IF (decrois .neqv. xi(i) < xi(i-1)) stop &
-            '"ord_coord":  latitudes are not monotonic'
-    ENDDO
-
-    IF (abs(xi(1)) < pi) then
-       ! "xi" contains latitudes in radians
-       xo(:nmax) = xi(:) * 180. / pi
+      IF (decrois .neqv. xi(i) < xi(i - 1)) stop &
+              '"ord_coord":  latitudes are not monotonic'
+    ENDDO
+
+    IF (abs(xi(1)) < pi) THEN
+      ! "xi" contains latitudes in radians
+      xo(:nmax) = xi(:) * 180. / pi
     else
-       ! "xi" contains latitudes in degrees
-       xo(:nmax) = xi(:)
+      ! "xi" contains latitudes in degrees
+      xo(:nmax) = xi(:)
     end IF
 
     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 ' &
-            // 'grid cells, not the centers of grid cells.'
-       STOP
+      print *, "ord_coord"
+      PRINT *, '"xi" should contain the latitudes of the boundaries of ' &
+              // 'grid cells, not the centers of grid cells.'
+      STOP
     ENDIF
 
@@ -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
 
@@ -439,9 +439,9 @@
 
     IF (xi(1) < 6.5) THEN
-       ! "xi" is in rad
-       ord_coordm(:) = xi(size(xi):1:-1) * 180. / pi
+      ! "xi" is in rad
+      ord_coordm(:) = xi(size(xi):1:-1) * 180. / pi
     else
-       ! "xi" is in degrees
-       ord_coordm(:) = xi(size(xi):1:-1)
+      ! "xi" is in degrees
+      ord_coordm(:) = xi(size(xi):1:-1)
     ENDIF
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpost.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpost.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpost.f90	(revision 5116)
@@ -12,8 +12,8 @@
 
   ! Arguments
-  real :: q(iip1,jjp1,llm)
-  real :: qppm(iim,jjp1,llm)
+  REAL :: q(iip1,jjp1,llm)
+  REAL :: qppm(iim,jjp1,llm)
   ! Local
-  integer :: l,i,j
+  INTEGER :: l,i,j
 
   ! RE-INVERSION DES NIVEAUX
@@ -41,3 +41,3 @@
    return
 
-end subroutine interpost
+END SUBROUTINE interpost
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpre.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpre.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpre.f90	(revision 5116)
@@ -18,24 +18,24 @@
   !---------------------------------------------------
   ! Arguments
-  real :: apppm(llm + 1), bpppm(llm + 1)
-  real :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
+  REAL :: apppm(llm + 1), bpppm(llm + 1)
+  REAL :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
   !---------------------------------------------------
-  real :: masse(iip1, jjp1, llm)
-  real :: massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
-  real :: w(iip1, jjp1, llm)
-  real :: fluxwppm(iim, jjp1, llm)
-  real :: pbaru(iip1, jjp1, llm)
-  real :: pbarv(iip1, jjm, llm)
-  real :: unatppm(iim, jjp1, llm)
-  real :: vnatppm(iim, jjp1, llm)
-  real :: psppm(iim, jjp1)
+  REAL :: masse(iip1, jjp1, llm)
+  REAL :: massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
+  REAL :: w(iip1, jjp1, llm)
+  REAL :: fluxwppm(iim, jjp1, llm)
+  REAL :: pbaru(iip1, jjp1, llm)
+  REAL :: pbarv(iip1, jjm, llm)
+  REAL :: unatppm(iim, jjp1, llm)
+  REAL :: vnatppm(iim, jjp1, llm)
+  REAL :: psppm(iim, jjp1)
   !---------------------------------------------------
   ! Local
-  real :: vnat(iip1, jjp1, llm)
-  real :: unat(iip1, jjp1, llm)
-  real :: fluxw(iip1, jjp1, llm)
-  real :: smass(iip1, jjp1)
+  REAL :: vnat(iip1, jjp1, llm)
+  REAL :: unat(iip1, jjp1, llm)
+  REAL :: fluxw(iip1, jjp1, llm)
+  REAL :: smass(iip1, jjp1)
   !----------------------------------------------------
-  integer :: l, ij, i, j
+  INTEGER :: l, ij, i, j
 
   ! CALCUL DE LA PRESSION DE SURFACE
@@ -118,6 +118,6 @@
   enddo
 
-  return
-end subroutine interpre
+  RETURN
+END SUBROUTINE interpre
 
 
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90	(revision 5116)
@@ -9,7 +9,7 @@
   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 nrtype, ONLY: pi, pi_d, twopi_d, k8
+    use serre_mod, ONLY: clon
 
     include "dimensions.h"
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90	(revision 5116)
@@ -5,23 +5,23 @@
 
     ! input:
-    real :: x
-    character(len=*) :: err_msg ! message d''erreur à afficher
+    REAL :: x
+    CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
 
     ! output
-    real :: borne
+    REAL :: borne
     parameter (borne=1e19)
-    integer :: iso_verif_noNaN_nostop
+    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
-        write(*,*) 'erreur detectee par iso_verif_nonNaN:'
-        write(*,*) err_msg
-        write(*,*) 'x=',x
+        WRITE(*,*) 'erreur detectee par iso_verif_nonNaN:'
+        WRITE(*,*) err_msg
+        WRITE(*,*) 'x=',x
         iso_verif_noNaN_nostop=1
     endif
 
-    return
-end function iso_verif_nonan_nostop
+    RETURN
+END FUNCTION iso_verif_nonan_nostop
 
   function iso_verif_egalite_nostop &
@@ -33,31 +33,31 @@
 
     ! input:
-    real :: a, b
-    character(len=*) :: err_msg ! message d''erreur à afficher
+    REAL :: a, b
+    CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
 
     ! locals
-    real :: errmax ! erreur maximale en absolu.
-    real :: errmaxrel ! erreur maximale en relatif autorisée
+    REAL :: errmax ! erreur maximale en absolu.
+    REAL :: errmaxrel ! erreur maximale en relatif autorisée
     parameter (errmax=1e-8)
     parameter (errmaxrel=1e-3)
 
     ! output
-    integer :: iso_verif_egalite_nostop
+    INTEGER :: iso_verif_egalite_nostop
 
     iso_verif_egalite_nostop=0
 
-    if (abs(a-b)>errmax) then
+    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:'
-        write(*,*) err_msg
-        write(*,*) 'a=',a
-        write(*,*) 'b=',b
+            >errmaxrel) THEN
+        WRITE(*,*) 'erreur detectee par iso_verif_egalite:'
+        WRITE(*,*) err_msg
+        WRITE(*,*) 'a=',a
+        WRITE(*,*) 'b=',b
         iso_verif_egalite_nostop=1
       endif
     endif
 
-    return
-end function iso_verif_egalite_nostop
+    RETURN
+END FUNCTION iso_verif_egalite_nostop
 
 
@@ -68,21 +68,21 @@
 
     ! input:
-    real :: x,q
-    integer :: iso ! 2=HDO, 1=O18
-    character(len=*) :: err_msg ! message d''erreur à afficher
+    REAL :: x,q
+    INTEGER :: iso ! 2=HDO, 1=O18
+    CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
 
     ! locals
-    real :: qmin,deltaD
-    real :: deltaDmax,deltaDmin,tnat
+    REAL :: qmin,deltaD
+    REAL :: deltaDmax,deltaDmin,tnat
     parameter (qmin=1e-11)
     parameter (deltaDmax=200.0,deltaDmin=-999.9)
 
     ! output
-    integer :: iso_verif_aberrant_nostop
+    INTEGER :: iso_verif_aberrant_nostop
 
     iso_verif_aberrant_nostop=0
 
     ! 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,16 +91,14 @@
          END IF
          deltaD=(x/q/tnat-1)*1000
-         if ((deltaD>deltaDmax).or.(deltaD<deltaDmin)) then
-              write(*,*) 'erreur detectee par iso_verif_aberrant:'
-              write(*,*) err_msg
-              write(*,*) 'q=',q
-              write(*,*) 'deltaD=',deltaD
-              write(*,*) 'iso=',iso
+         if ((deltaD>deltaDmax).or.(deltaD<deltaDmin)) THEN
+              WRITE(*,*) 'erreur detectee par iso_verif_aberrant:'
+              WRITE(*,*) err_msg
+              WRITE(*,*) 'q=',q
+              WRITE(*,*) 'deltaD=',deltaD
+              WRITE(*,*) 'iso=',iso
               iso_verif_aberrant_nostop=1
-         endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
-      endif !if (q(i,k,iq).gt.qmin) then
+         endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) THEN
+      endif !if (q(i,k,iq).gt.qmin) THEN
+    RETURN
+END FUNCTION iso_verif_aberrant_nostop
 
-
-    return
-end function iso_verif_aberrant_nostop
-
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90	(revision 5116)
@@ -22,7 +22,7 @@
   !   Arguments:
   !   ----------
-  real :: pente_max
+  REAL :: pente_max
   REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm)
-  real :: sx(ip1jmp1,llm)
+  REAL :: sx(ip1jmp1,llm)
   !
   !  Local
@@ -30,13 +30,13 @@
   !
   INTEGER :: ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
-  integer :: n0,iadvplus(ip1jmp1,llm),nl(llm)
+  INTEGER :: n0,iadvplus(ip1jmp1,llm),nl(llm)
   !
   REAL :: q(ip1jmp1,llm)
-  real :: dxq(ip1jmp1,llm)
+  REAL :: dxq(ip1jmp1,llm)
 
 
   REAL :: new_m,zm
-  real :: dxqu(ip1jmp1)
-  real :: adxqu(ip1jmp1),dxqmax(ip1jmp1)
+  REAL :: dxqu(ip1jmp1)
+  REAL :: adxqu(ip1jmp1),dxqmax(ip1jmp1)
 
   Logical :: extremum,first
@@ -44,5 +44,5 @@
 
   REAL :: SSUM
-  integer :: ismax,ismin
+  INTEGER :: ismax,ismin
   EXTERNAL  SSUM, ismin,ismax
 
@@ -84,6 +84,6 @@
 
      do ij=iip2+1,ip1jm
-        if(     dxqu(ij-1)*dxqu(ij)>0. &
-              .and. dxq(ij,l)*dxqu(ij)>0.) then
+        IF(     dxqu(ij-1)*dxqu(ij)>0. &
+              .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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limy.f90	(revision 5116)
@@ -15,4 +15,5 @@
   !   --------------------------------------------------------------------
   USE comconst_mod, ONLY: pi
+  USE lmdz_libmath, ONLY: ismax, ismin
   IMPLICIT NONE
   !
@@ -24,6 +25,6 @@
   !   Arguments:
   !   ----------
-  real :: pente_max
-  real :: s0(ip1jmp1,llm),sy(ip1jmp1,llm),sm(ip1jmp1,llm)
+  REAL :: pente_max
+  REAL :: s0(ip1jmp1,llm),sy(ip1jmp1,llm),sm(ip1jmp1,llm)
   !
   !  Local
@@ -34,6 +35,6 @@
   REAL :: q(ip1jmp1,llm)
   REAL :: airej2,airejjm,airescb(iim),airesch(iim)
-  real :: sigv,dyq(ip1jmp1),dyqv(ip1jm)
-  real :: adyqv(ip1jm),dyqmax(ip1jmp1)
+  REAL :: sigv,dyq(ip1jmp1),dyqv(ip1jm)
+  REAL :: adyqv(ip1jm),dyqmax(ip1jmp1)
   REAL :: qbyv(ip1jm,llm)
 
@@ -42,18 +43,16 @@
   save first
 
-  real :: convpn,convps,convmpn,convmps
-  real :: sinlon(iip1),sinlondlon(iip1)
-  real :: coslon(iip1),coslondlon(iip1)
+  REAL :: convpn,convps,convmpn,convmps
+  REAL :: sinlon(iip1),sinlondlon(iip1)
+  REAL :: coslon(iip1),coslondlon(iip1)
   save sinlon,coslon,sinlondlon,coslondlon
   !
   !
   REAL :: SSUM
-  integer :: ismax,ismin
-  EXTERNAL  SSUM, convflu,ismin,ismax
-  EXTERNAL filtreg
+  EXTERNAL  SSUM
 
   data first/.TRUE./
 
-  if(first) then
+  IF(first) THEN
      PRINT*,'SCHEMA AMONT NOUVEAU'
      first=.FALSE.
@@ -129,7 +128,7 @@
   !   cas ou on a un extremum au pole
 
-  ! if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+  ! IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
   !    &   appn=0.
-  ! if(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+  ! IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
   !    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
   !    &   apps=0.
@@ -150,6 +149,6 @@
   !  enddo
 
-  if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1))<=0.) &
-        then
+  IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1))<=0.) &
+        THEN
      do ij=1,iip1
         dyqmax(ij)=0.
@@ -161,7 +160,7 @@
   endif
 
-  if(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)* &
+  IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)* &
         dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)<=0.) &
-        then
+        THEN
      do ij=ip1jm+1,ip1jmp1
         dyqmax(ij)=0.
@@ -176,5 +175,5 @@
 
   do ij=1,ip1jmp1 ! cf below: should it be ip1jm instead ?
-     if(dyqv(ij)*dyqv(ij-iip1)>0.) then  ! /!\ causes Warning: iteration 1056 invokes undefined behavior [-Waggressive-loop-optimizations] in 32x32x39
+     IF(dyqv(ij)*dyqv(ij-iip1)>0.) then  ! /!\ causes Warning: iteration 1056 invokes undefined behavior [-Waggressive-loop-optimizations] in 32x32x39
         dyq(ij)=sign(min(abs(dyq(ij)),dyqmax(ij)),dyq(ij))
      else
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90	(revision 5116)
@@ -22,7 +22,7 @@
   !   Arguments:
   !   ----------
-  real :: pente_max
+  REAL :: pente_max
   REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm)
-  real :: sz(ip1jmp1,llm)
+  REAL :: sz(ip1jmp1,llm)
   !
   !  Local
@@ -30,13 +30,13 @@
   !
   INTEGER :: ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
-  integer :: n0,iadvplus(ip1jmp1,llm),nl(llm)
+  INTEGER :: n0,iadvplus(ip1jmp1,llm),nl(llm)
   !
   REAL :: q(ip1jmp1,llm)
-  real :: dzq(ip1jmp1,llm)
+  REAL :: dzq(ip1jmp1,llm)
 
 
   REAL :: new_m,zm
-  real :: dzqw(ip1jmp1)
-  real :: adzqw(ip1jmp1),dzqmax(ip1jmp1)
+  REAL :: dzqw(ip1jmp1)
+  REAL :: adzqw(ip1jmp1),dzqmax(ip1jmp1)
 
   Logical :: extremum,first
@@ -44,5 +44,5 @@
 
   REAL :: SSUM
-  integer :: ismax,ismin
+  INTEGER :: ismax,ismin
   EXTERNAL  SSUM, ismin,ismax
 
@@ -77,6 +77,6 @@
 
      do l=2,llm-1
-        if(     dzqw(l-1)*dzqw(l)>0. &
-              .and. dzq(ij,l)*dzqw(l)>0.) then
+        IF(     dzqw(l-1)*dzqw(l)>0. &
+              .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/pentes_ini.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pentes_ini.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pentes_ini.f90	(revision 5116)
@@ -31,5 +31,5 @@
   !   Arguments:
   !   ----------
-  integer :: mode
+  INTEGER :: mode
   REAL :: pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm )
   REAL :: q( iip1,jjp1,llm,0:3)
@@ -42,19 +42,19 @@
   REAL :: s0( iip1,jjp1,llm ),  sx( iip1,jjp1,llm )
   REAL :: sy( iip1,jjp1,llm ),  sz( iip1,jjp1,llm )
-  real :: masn,mass,zz
+  REAL :: masn,mass,zz
   INTEGER :: i,j,l,iq
 
   !  modif Fred 24 03 96
 
-  real :: sinlon(iip1),sinlondlon(iip1)
-  real :: coslon(iip1),coslondlon(iip1)
+  REAL :: sinlon(iip1),sinlondlon(iip1)
+  REAL :: coslon(iip1),coslondlon(iip1)
   save sinlon,coslon,sinlondlon,coslondlon
-  real :: dyn1,dyn2,dys1,dys2
-  real :: qpn,qps,dqzpn,dqzps
-  real :: smn,sms,s0n,s0s,sxn(iip1),sxs(iip1)
-  real :: qmin,zq,pente_max
+  REAL :: dyn1,dyn2,dys1,dys2
+  REAL :: qpn,qps,dqzpn,dqzps
+  REAL :: smn,sms,s0n,s0s,sxn(iip1),sxs(iip1)
+  REAL :: qmin,zq,pente_max
   !
   REAL :: SSUM
-  integer :: ismax,ismin,lati,latf
+  INTEGER :: ismax,ismin,lati,latf
   EXTERNAL  SSUM, ismin,ismax
   logical :: first
@@ -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
@@ -84,5 +84,5 @@
   qmin=0.4995
   qmin=0.
-  if(first) then
+  IF(first) THEN
      PRINT*,'SCHEMA AMONT NOUVEAU'
      first=.FALSE.
@@ -181,5 +181,5 @@
    !     do i=1,iip1
    !        zq=s0(i,j,l)/sm(i,j,l)
-   !       if(zq.lt.qmin)
+   !       IF(zq.lt.qmin)
   !    ,       PRINT*,'avant advx1, s0(',i,',',j,',',l,')=',zq
    !     enddo
@@ -187,5 +187,5 @@
    ! enddo
   !CC
-   if(mode==2) then
+   IF(mode==2) THEN
       do l=1,llm
         s0s=0.
@@ -247,5 +247,5 @@
   endif
 
-  if (mode==4) then
+  if (mode==4) THEN
      do l=1,llm
         do i=1,iip1
@@ -261,5 +261,5 @@
    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
@@ -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
@@ -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
@@ -323,5 +323,5 @@
   !      do i=1,iip1
   !         zq=s0(i,j,l)/sm(i,j,l)
-  !        if(zq.lt.qmin)
+  !        IF(zq.lt.qmin)
   !    ,       PRINT*,'apres advx2, s0(',i,',',j,',',l,')=',zq
   !      enddo
@@ -346,5 +346,5 @@
   ! Traitements specifiques au pole
 
-  if(mode>=1) then
+  IF(mode>=1) THEN
   DO l=1,llm
   !   filtrages aux poles
@@ -361,5 +361,5 @@
         q( i,jjp1,llm+1-l,0)=qps
      enddo
-     if(mode==3) then
+     IF(mode==3) THEN
         dyn1=0.
         dys1=0.
@@ -382,5 +382,5 @@
         enddo
      endif
-     if(mode==1) then
+     IF(mode==1) THEN
   !   on filtre les valeurs au bord de la "grande maille pole"
         dyn1=0.
@@ -459,5 +459,5 @@
       do j=1,jjp1
        do i=1,iip1
-         if(q(i,j,l,0)<qmin) &
+         IF(q(i,j,l,0)<qmin) &
                PRINT*,'apres pentes, s0(',i,',',j,',',l,')=',q(i,j,l,0)
        enddo
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.f90	(revision 5116)
@@ -276,15 +276,15 @@
   !
 
-  real :: Q(IMR,JNP,NLAY,NC),PS1(IMR,JNP),PS2(IMR,JNP), &
+  REAL :: Q(IMR,JNP,NLAY,NC),PS1(IMR,JNP),PS2(IMR,JNP), &
         U(IMR,JNP,NLAY),V(IMR,JNP,NLAY),AP(NLAY+1), &
         BP(NLAY+1),W(IMR,JNP,NLAY),NDT,val(NLAY),Umax
-  integer :: IGD,IORD,JORD,KORD,NC,IMR,JNP,j1,NLAY,AE
-  integer :: IMRD2
-  real :: PT
+  INTEGER :: IGD,IORD,JORD,KORD,NC,IMR,JNP,j1,NLAY,AE
+  INTEGER :: IMRD2
+  REAL :: PT
   logical :: cross, fill, dum
   !
   ! Local dynamic arrays
   !
-  real :: CRX(IMR,JNP),CRY(IMR,JNP),xmass(IMR,JNP),ymass(IMR,JNP), &
+  REAL :: CRX(IMR,JNP),CRY(IMR,JNP),xmass(IMR,JNP),ymass(IMR,JNP), &
         fx1(IMR+1),DPI(IMR,JNP,NLAY),delp1(IMR,JNP,NLAY), &
         WK1(IMR,JNP,NLAY),PU(IMR,JNP),PV(IMR,JNP),DC2(IMR,JNP), &
@@ -294,5 +294,5 @@
   ! Local static  arrays
   !
-  real :: DTDX(Jmax), DTDX5(Jmax), acosp(Jmax), &
+  REAL :: DTDX(Jmax), DTDX5(Jmax), acosp(Jmax), &
         cosp(Jmax), cose(Jmax), DAP(kmax),DBK(Kmax)
   data NDT0, NSTEP /0, 0/
@@ -314,9 +314,9 @@
   !
   ! *********** Initialization **********************
-  if(NSTEP==1) then
-  !
-  write(6,*) '------------------------------------ '
-  write(6,*) 'NASA/GSFC Transport Core Version 4.5'
-  write(6,*) '------------------------------------ '
+  IF(NSTEP==1) THEN
+  !
+  WRITE(6,*) '------------------------------------ '
+  WRITE(6,*) 'NASA/GSFC Transport Core Version 4.5'
+  WRITE(6,*) '------------------------------------ '
   !
   WRITE(6,*) 'IMR=',IMR,' JNP=',JNP,' NLAY=',NLAY,' j1=',j1
@@ -324,21 +324,21 @@
   !
   ! controles sur les parametres
-  if(NLAY<6) then
-    write(6,*) 'NLAY must be >= 6'
+  IF(NLAY<6) THEN
+    WRITE(6,*) 'NLAY must be >= 6'
     stop
   endif
-  if (JNP<NLAY) then
-     write(6,*) 'JNP must be >= NLAY'
+  if (JNP<NLAY) THEN
+     WRITE(6,*) 'JNP must be >= NLAY'
     stop
   endif
   IMRD2=mod(IMR,2)
-  if (j1==2.and.IMRD2/=0) then
-     write(6,*) 'if j1=2 IMR must be an even integer'
+  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
-    write(6,*) 'Jmax or Kmax is too small'
+  IF(Jmax<JNP .or. Kmax<NLAY) THEN
+    WRITE(6,*) 'Jmax or Kmax is too small'
     stop
   endif
@@ -353,5 +353,5 @@
   DP =    PI / REAL(JMR)
   !
-  if(IGD==0) then
+  IF(IGD==0) THEN
   ! Compute analytic cosine at cell edges
         CALL cosa(cosp,cose,JNP,PI,DP)
@@ -372,19 +372,19 @@
   endif
   !
-  if(NDT0 /= NDT) then
+  IF(NDT0 /= NDT) THEN
   DT   = NDT
   NDT0 = NDT
 
-    if(Umax < 180.) then
-     write(6,*) 'Umax may be too small!'
+    IF(Umax < 180.) THEN
+     WRITE(6,*) 'Umax may be too small!'
     endif
   CR1  = abs(Umax*DT)/(DL*AE)
   MaxDT = DP*AE / abs(Umax) + 0.5
-  write(6,*)'Largest time step for max(V)=',Umax,' is ',MaxDT
-  if(MaxDT < abs(NDT)) then
-        write(6,*) 'Warning!!! NDT maybe too large!'
-  endif
-  !
-  if(CR1>=0.95) then
+  WRITE(6,*)'Largest time step for max(V)=',Umax,' is ',MaxDT
+  IF(MaxDT < abs(NDT)) THEN
+        WRITE(6,*) 'Warning!!! NDT maybe too large!'
+  endif
+  !
+  IF(CR1>=0.95) THEN
   JS0 = 0
   JN0 = 0
@@ -413,5 +413,5 @@
   DTDY5 = 0.5*DTDY
   !
-  !  write(6,*) 'J1=',J1,' J2=', J2
+  !  WRITE(6,*) 'J1=',J1,' J2=', J2
   endif
   !
@@ -429,5 +429,5 @@
 
   !
-  if(j1/=2) then
+  IF(j1/=2) THEN
   DO IC=1,NC
   DO L=1,NLAY
@@ -453,5 +453,5 @@
   do k=1,NLAY
   !
-  if(IGD==0) then
+  IF(IGD==0) THEN
   ! Convert winds on A-Grid to Courant # on C-Grid.
   CALL A2C(U(1,1,k),V(1,1,k),IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
@@ -480,5 +480,5 @@
   do j=JS0,j1+1,-1
   do i=1,IMR
-  if(abs(CRX(i,j))>1.) then
+  IF(abs(CRX(i,j))>1.) THEN
         JS = j
         go to 2222
@@ -490,5 +490,5 @@
   do j=JN0,j2-1
   do i=1,IMR
-  if(abs(CRX(i,j))>1.) then
+  IF(abs(CRX(i,j))>1.) THEN
         JN = j
         go to 2233
@@ -498,5 +498,5 @@
 2233   continue
   !
-  if(j1/=2) then           ! Enlarged polar cap.
+  IF(j1/=2) then           ! Enlarged polar cap.
   do i=1,IMR
   DPI(i,  2,k) = 0.
@@ -586,5 +586,5 @@
   enddo
   !
-  if(j1==2) then
+  IF(j1==2) THEN
     IMH = IMR/2
   do i=1,IMH
@@ -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
@@ -623,5 +623,5 @@
   ru = UA(i,j) - iu
   iiu = i-iu
-  if(UA(i,j)>=0.) then
+  IF(UA(i,j)>=0.) THEN
   wk1(i,j,1) = qtmp(iiu)+ru*(qtmp(iiu-1)-qtmp(iiu))
   else
@@ -633,5 +633,5 @@
   END DO
   !
-  if(JN/=0) then
+  IF(JN/=0) THEN
   do j=JS+1,JN-1
   !
@@ -661,7 +661,7 @@
   enddo
   !
-    if(cross) then
+    IF(cross) THEN
   ! Add cross terms in the vertical direction.
-    if(IORD >= 2) then
+    IF(IORD >= 2) THEN
             iad = 2
     else
@@ -669,5 +669,5 @@
     endif
   !
-    if(JORD >= 2) then
+    IF(JORD >= 2) THEN
             jad = 2
     else
@@ -750,5 +750,5 @@
   !
 
-  if(fill) CALL qckxyz(DQ(1,1,1,IC),DC2,IMR,JNP,NLAY,j1,j2, &
+  IF(fill) CALL qckxyz(DQ(1,1,1,IC),DC2,IMR,JNP,NLAY,j1,j2, &
         cosp,acosp,.FALSE.,IC,NSTEP)
   !
@@ -765,5 +765,5 @@
   enddo
   !
-  if(j1/=2) then
+  IF(j1/=2) THEN
   DO k=1,NLAY
   DO I=1,IMR
@@ -776,5 +776,5 @@
   END DO
   !
-  if(j1/=2) then
+  IF(j1/=2) THEN
   DO k=1,NLAY
   DO i=1,IMR
@@ -794,13 +794,13 @@
   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), &
+  INTEGER :: IMR,JNP,NLAY,J1,KORD
+  REAL :: WZ(IMR,JNP,NLAY),P(IMR,JNP,NLAY),DC(IMR,JNP,NLAY), &
         wk1(IMR,*),delp(IMR,JNP,NLAY),DQ(IMR,JNP,NLAY), &
         DQDT(IMR,JNP,NLAY)
   ! Assuming JNP >= NLAY
-  real :: AR(IMR,*),AL(IMR,*),A6(IMR,*),flux(IMR,*),wk2(IMR,*), &
+  REAL :: AR(IMR,*),AL(IMR,*),A6(IMR,*),flux(IMR,*),wk2(IMR,*), &
         wz2(IMR,*)
-  integer :: JMR,IMJM,NLAYM1,LMT,K,I,J
-  real :: c0,c1,c2,tmp,qmax,qmin,a,b,fct,a1,a2,cm,cp
+  INTEGER :: JMR,IMJM,NLAYM1,LMT,K,I,J
+  REAL :: c0,c1,c2,tmp,qmax,qmin,a,b,fct,a1,a2,cm,cp
   !
   JMR = JNP - 1
@@ -871,5 +871,5 @@
   !
   ! Check if change sign
-  if(wk1(i,1)*AL(i,1)<=0.) then
+  IF(wk1(i,1)*AL(i,1)<=0.) THEN
              AL(i,1) = 0.
          flux(i,1) = 0.
@@ -887,5 +887,5 @@
   AR(i,NLAY) = wk1(i,NLAY) + fct
   AL(i,NLAY) = wk1(i,NLAY) - (fct+fct)
-  if(wk1(i,NLAY)*AR(i,NLAY)<=0.) AR(i,NLAY) = 0.
+  IF(wk1(i,NLAY)*AR(i,NLAY)<=0.) AR(i,NLAY) = 0.
   flux(i,NLAY) = AR(i,NLAY) -  wk1(i,NLAY)
   END DO
@@ -926,5 +926,5 @@
   !
   ! Interior depending on KORD
-  if(LMT<=2) &
+  IF(LMT<=2) &
         CALL lmtppm(flux(1,2),A6(1,2),AR(1,2),AL(1,2),wk1(1,2), &
         IMR*(NLAY-2),LMT)
@@ -933,5 +933,5 @@
   !
   DO i=1,IMR*NLAYM1
-  IF(wz2(i,1)>0.) then
+  IF(wz2(i,1)>0.) THEN
     CM = wz2(i,1) / wk2(i,1)
     flux(i,2) = AR(i,1)+0.5*CM*(AL(i,1)-AR(i,1)+A6(i,1)*(1.-R23*CM))
@@ -961,19 +961,19 @@
 2000   continue
   END DO
-  return
-end subroutine fzppm
+  RETURN
+END SUBROUTINE fzppm
 !
 SUBROUTINE xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ,Q,UC, &
         fx1,xmass,IORD)
   IMPLICIT NONE
-  integer :: IMR,JNP,IML,j1,j2,JN,JS,IORD
-  real :: PU,DQ,Q,UC,fx1,xmass
-  real :: dc,qtmp
-  integer :: ISAVE(IMR)
+  INTEGER :: IMR,JNP,IML,j1,j2,JN,JS,IORD
+  REAL :: PU,DQ,Q,UC,fx1,xmass
+  REAL :: dc,qtmp
+  INTEGER :: ISAVE(IMR)
   dimension UC(IMR,*),DC(-IML:IMR+IML+1),xmass(IMR,JNP) &
         ,fx1(IMR+1),DQ(IMR,JNP),qtmp(-IML:IMR+1+IML)
   dimension PU(IMR,JNP),Q(IMR,JNP)
-  integer :: jvan,j1vl,j2vl,j,i,iu,itmp,ist,imp
-  real :: rut
+  INTEGER :: jvan,j1vl,j2vl,j,i,iu,itmp,ist,imp
+  REAL :: rut
   !
   IMP = IMR + 1
@@ -990,5 +990,5 @@
   enddo
   !
-  if(j>=JN .or. j<=JS) goto 2222
+  IF(j>=JN .or. j<=JS) goto 2222
   ! ************* Eulerian **********
   !
@@ -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)
@@ -1058,10 +1058,10 @@
   !
   do i=1,IMR
-  IF(uc(i,j)>1.) then
+  IF(uc(i,j)>1.) THEN
   !DIR$ NOVECTOR
     do ist = ISAVE(i),i-1
     fx1(i) = fx1(i) + qtmp(ist)
     enddo
-  elseIF(uc(i,j)<-1.) then
+  elseIF(uc(i,j)<-1.) THEN
     do ist = i,ISAVE(i)-1
     fx1(i) = fx1(i) - qtmp(ist)
@@ -1084,26 +1084,26 @@
   !
   END DO
-  return
-end subroutine xtp
+  RETURN
+END SUBROUTINE xtp
 !
 SUBROUTINE fxppm(IMR,IML,UT,P,DC,flux,IORD)
   IMPLICIT NONE
-  integer :: IMR,IML,IORD
-  real :: UT,P,DC,flux
+  INTEGER :: IMR,IML,IORD
+  REAL :: UT,P,DC,flux
   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
+  INTEGER :: LMT,IMP,JLVL,i
    ! logical first
    ! data first /.TRUE./
    ! SAVE LMT
-   ! if(first) then
+   ! IF(first) THEN
   !
   ! correction calcul de LMT a chaque passage pour pouvoir choisir
   ! plusieurs schemas PPM pour differents traceurs
-  !  IF (IORD.LE.0) then
-  !        if(IMR.GE.144) then
+  !  IF (IORD.LE.0) THEN
+  !        IF(IMR.GE.144) THEN
   !              LMT = 0
-  !        elseif(IMR.GE.72) then
+  !        elseif(IMR.GE.72) THEN
   !              LMT = 1
   !        else
@@ -1115,5 +1115,5 @@
   !
   LMT = IORD - 3
-   ! write(6,*) 'PPM option in E-W direction = ', LMT
+   ! WRITE(6,*) 'PPM option in E-W direction = ', LMT
    ! first = .FALSE.
    ! endif
@@ -1132,5 +1132,5 @@
   END DO
   !
-  if(LMT<=2) CALL lmtppm(DC(1),A6(1),AR(1),AL(1),P(1),IMR,LMT)
+  IF(LMT<=2) CALL lmtppm(DC(1),A6(1),AR(1),AL(1),P(1),IMR,LMT)
   !
   AL(0) = AL(IMR)
@@ -1139,5 +1139,5 @@
   !
   DO i=1,IMR
-  IF(UT(i)>0.) then
+  IF(UT(i)>0.) THEN
   flux(i) = AR(i-1) + 0.5*UT(i)*(AL(i-1) - AR(i-1) + &
         A6(i-1)*(1.-R23*UT(i)) )
@@ -1147,14 +1147,14 @@
   endif
   enddo
-  return
-end subroutine fxppm
+  RETURN
+END SUBROUTINE fxppm
 !
 SUBROUTINE xmist(IMR,IML,P,DC)
   IMPLICIT NONE
-  integer :: IMR,IML
+  INTEGER :: IMR,IML
   real,parameter :: R24 = 1./24.
-  real :: P(-IML:IMR+1+IML),DC(-IML:IMR+1+IML)
-  integer :: i
-  real :: tmp,pmax,pmin
+  REAL :: P(-IML:IMR+1+IML),DC(-IML:IMR+1+IML)
+  INTEGER :: i
+  REAL :: tmp,pmax,pmin
   !
   do i=1,IMR
@@ -1164,23 +1164,23 @@
   DC(i) = sign(min(abs(tmp),Pmax,Pmin), tmp)
   END DO
-  return
-end subroutine xmist
+  RETURN
+END SUBROUTINE xmist
 !
 SUBROUTINE ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ,P,VC,DC2 &
         ,ymass,fx,A6,AR,AL,JORD)
   IMPLICIT NONE
-  integer :: IMR,JNP,j1,j2,JORD
-  real :: acosp,RCAP,DQ,P,VC,DC2,ymass,fx,A6,AR,AL
+  INTEGER :: IMR,JNP,j1,j2,JORD
+  REAL :: acosp,RCAP,DQ,P,VC,DC2,ymass,fx,A6,AR,AL
   dimension P(IMR,JNP),VC(IMR,JNP),ymass(IMR,JNP) &
         ,DC2(IMR,JNP),DQ(IMR,JNP),acosp(JNP)
   ! Work array
   DIMENSION fx(IMR,JNP),AR(IMR,JNP),AL(IMR,JNP),A6(IMR,JNP)
-  integer :: JMR,len,i,jt,j
-  real :: sum1,sum2
+  INTEGER :: JMR,len,i,jt,j
+  REAL :: sum1,sum2
   !
   JMR = JNP - 1
   len = IMR*(J2-J1+2)
   !
-  if(JORD==1) then
+  IF(JORD==1) THEN
   DO i=1,len
   JT = REAL(J1) - VC(i,J1)
@@ -1191,6 +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)
 
@@ -1228,5 +1227,5 @@
   enddo
   !
-  if(j1/=2) then
+  IF(j1/=2) THEN
   do i=1,IMR
   DQ(i,  2) = sum1
@@ -1235,14 +1234,14 @@
   endif
   !
-  return
-end subroutine ytp
+  RETURN
+END SUBROUTINE ytp
 !
 subroutine  ymist(IMR,JNP,j1,P,DC,ID)
   IMPLICIT NONE
-  integer :: IMR,JNP,j1,ID
+  INTEGER :: IMR,JNP,j1,ID
   real,parameter :: R24 = 1./24.
-  real :: P(IMR,JNP),DC(IMR,JNP)
-  integer :: iimh,jmr,ijm3,imh,i
-  real :: pmax,pmin,tmp
+  REAL :: P(IMR,JNP),DC(IMR,JNP)
+  INTEGER :: iimh,jmr,ijm3,imh,i
+  REAL :: pmax,pmin,tmp
   !
   IMH = IMR / 2
@@ -1291,5 +1290,5 @@
   ENDIF
   !
-  if(j1/=2) then
+  IF(j1/=2) THEN
   do i=1,IMR
   DC(i,1) = 0.
@@ -1317,16 +1316,16 @@
   END DO
   endif
-  return
-end subroutine ymist
+  RETURN
+END SUBROUTINE ymist
 !
 SUBROUTINE fyppm(VC,P,DC,flux,IMR,JNP,j1,j2,A6,AR,AL,JORD)
   IMPLICIT NONE
-  integer :: IMR,JNP,j1,j2,JORD
+  INTEGER :: IMR,JNP,j1,j2,JORD
   real,parameter :: R3 = 1./3., R23 = 2./3.
-  real :: VC(IMR,*),flux(IMR,*),P(IMR,*),DC(IMR,*)
+  REAL :: VC(IMR,*),flux(IMR,*),P(IMR,*),DC(IMR,*)
   ! Local work arrays.
-  real :: AR(IMR,JNP),AL(IMR,JNP),A6(IMR,JNP)
-  integer :: LMT,i
-  integer :: IMH,JMR,j11,IMJM1,len
+  REAL :: AR(IMR,JNP),AL(IMR,JNP),A6(IMR,JNP)
+  INTEGER :: LMT,i
+  INTEGER :: IMH,JMR,j11,IMJM1,len
    ! logical first
    ! data first /.TRUE./
@@ -1338,9 +1337,9 @@
   IMJM1 = IMR*(J2-J1+2)
   len   = IMR*(J2-J1+3)
-   ! if(first) then
-   ! IF(JORD.LE.0) then
-   !       if(JMR.GE.90) then
+   ! IF(first) THEN
+   ! IF(JORD.LE.0) THEN
+   !       IF(JMR.GE.90) THEN
    !             LMT = 0
-   !       elseif(JMR.GE.45) then
+   !       elseif(JMR.GE.45) THEN
    !             LMT = 1
    !       else
@@ -1384,10 +1383,10 @@
   END DO
   !
-  if(LMT<=2) CALL lmtppm(DC(1,j11),A6(1,j11),AR(1,j11) &
+  IF(LMT<=2) CALL lmtppm(DC(1,j11),A6(1,j11),AR(1,j11) &
         ,AL(1,j11),P(1,j11),len,LMT)
   !
 
   DO i=1,IMJM1
-  IF(VC(i,j1)>0.) then
+  IF(VC(i,j1)>0.) THEN
   flux(i,j1) = AR(i,j11) + 0.5*VC(i,j1)*(AL(i,j11) - AR(i,j11) + &
         A6(i,j11)*(1.-R23*VC(i,j1)) )
@@ -1397,10 +1396,10 @@
   endif
   END DO
-  return
-end subroutine fyppm
+  RETURN
+END SUBROUTINE fyppm
 !
   SUBROUTINE yadv(IMR,JNP,j1,j2,p,VA,ady,wk,IAD)
     IMPLICIT NONE
-    integer :: IMR,JNP,j1,j2,IAD
+    INTEGER :: IMR,JNP,j1,j2,IAD
     REAL :: p(IMR,JNP),ady(IMR,JNP),VA(IMR,JNP)
     REAL :: WK(IMR,-1:JNP+2)
@@ -1426,24 +1425,24 @@
     wk(i+IMH,JNP+2) = p(i,JNP-2)
     enddo
-     ! write(*,*) 'toto 1'
+     ! WRITE(*,*) 'toto 1'
   ! --------------------------------
-  IF(IAD==2) then
+  IF(IAD==2) THEN
   do j=j1-1,j2+1
   do i=1,IMR
-   ! write(*,*) 'avt NINT','i=',i,'j=',j
+   ! WRITE(*,*) 'avt NINT','i=',i,'j=',j
   JP = NINT(VA(i,j))
   rv = JP - VA(i,j)
-   ! write(*,*) 'VA=',VA(i,j), 'JP1=',JP,'rv=',rv
+   ! WRITE(*,*) 'VA=',VA(i,j), 'JP1=',JP,'rv=',rv
   JP = j - JP
-   ! write(*,*) 'JP2=',JP
+   ! WRITE(*,*) 'JP2=',JP
   a1 = 0.5*(wk(i,jp+1)+wk(i,jp-1)) - wk(i,jp)
   b1 = 0.5*(wk(i,jp+1)-wk(i,jp-1))
-   ! write(*,*) 'a1=',a1,'b1=',b1
+   ! WRITE(*,*) 'a1=',a1,'b1=',b1
   ady(i,j) = wk(i,jp) + rv*(a1*rv + b1) - wk(i,j)
   enddo
   enddo
-   ! write(*,*) 'toto 2'
-  !
-  ELSEIF(IAD==1) then
+   ! WRITE(*,*) 'toto 2'
+  !
+  ELSEIF(IAD==1) THEN
     do j=j1-1,j2+1
   do i=1,imr
@@ -1454,5 +1453,5 @@
   ENDIF
   !
-    if(j1/=2) then
+    IF(j1/=2) THEN
     sum1 = 0.
     sum2 = 0.
@@ -1487,6 +1486,6 @@
     endif
   !
-    return
-end subroutine yadv
+    RETURN
+END SUBROUTINE yadv
 !
   SUBROUTINE xadv(IMR,JNP,j1,j2,p,UA,JS,JN,IML,adx,IAD)
@@ -1499,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
@@ -1519,10 +1518,10 @@
   adx(i,j) = qtmp(ip) + ru*(a1*ru + b1)
   enddo
-  ELSEIF(IAD==1) then
+  ELSEIF(IAD==1) THEN
   DO i=1,IMR
   iu = UA(i,j)
   ru = UA(i,j) - iu
   iiu = i-iu
-  if(UA(i,j)>=0.) then
+  IF(UA(i,j)>=0.) THEN
   adx(i,j) = qtmp(iiu)+ru*(qtmp(iiu-1)-qtmp(iiu))
   else
@@ -1560,5 +1559,5 @@
   adx(i,j) = qtmp(ip)- p(i,j) + ru*(a1*ru + b1)
   enddo
-  ELSEIF(IAD==1) then
+  ELSEIF(IAD==1) THEN
   ! 1st order
   DO i=1,IMR
@@ -1569,5 +1568,5 @@
   enddo
   !
-    if(j1/=2) then
+    IF(j1/=2) THEN
   do i=1,IMR
   adx(i,  2) = 0.
@@ -1580,6 +1579,6 @@
   adx(i,JNP) = 0.
   enddo
-    return
-end subroutine xadv
+    RETURN
+END SUBROUTINE xadv
 !
 SUBROUTINE lmtppm(DC,A6,AR,AL,P,IM,LMT)
@@ -1600,13 +1599,13 @@
   !
   real,parameter :: R12 = 1./12.
-  real :: A6(IM),AR(IM),AL(IM),P(IM),DC(IM)
-  integer :: IM,LMT
+  REAL :: A6(IM),AR(IM),AL(IM),P(IM),DC(IM)
+  INTEGER :: IM,LMT
   INTEGER :: i
   REAL :: da1,da2,a6da,fmin
   !
-  if(LMT==0) then
+  IF(LMT==0) THEN
   ! Full constraint
   do i=1,IM
-  if(DC(i)==0.) then
+  IF(DC(i)==0.) THEN
         AR(i) = p(i)
         AL(i) = p(i)
@@ -1616,8 +1615,8 @@
   da2  = da1**2
   A6DA = A6(i)*da1
-  if(A6DA < -da2) then
+  IF(A6DA < -da2) THEN
         A6(i) = 3.*(AL(i)-p(i))
         AR(i) = AL(i) - A6(i)
-  elseif(A6DA > da2) then
+  elseif(A6DA > da2) THEN
         A6(i) = 3.*(AR(i)-p(i))
         AL(i) = AR(i) - A6(i)
@@ -1625,13 +1624,13 @@
   endif
   END DO
-  elseif(LMT==1) then
+  elseif(LMT==1) THEN
   ! Semi-monotonic constraint
   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(abs(AR(i)-AL(i)) >= -A6(i)) go to 150
+  IF(p(i)<AR(i) .and. p(i)<AL(i)) THEN
         AR(i) = p(i)
         AL(i) = p(i)
         A6(i) = 0.
-  elseif(AR(i) > AL(i)) then
+  elseif(AR(i) > AL(i)) THEN
         A6(i) = 3.*(AL(i)-p(i))
         AR(i) = AL(i) - A6(i)
@@ -1642,14 +1641,14 @@
 150   continue
   END DO
-  elseif(LMT==2) then
+  elseif(LMT==2) THEN
   do i=1,IM
-  if(abs(AR(i)-AL(i)) >= -A6(i)) go to 250
+  IF(abs(AR(i)-AL(i)) >= -A6(i)) go to 250
   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(fmin>=0.) go to 250
+  IF(p(i)<AR(i) .and. p(i)<AL(i)) THEN
         AR(i) = p(i)
         AL(i) = p(i)
         A6(i) = 0.
-  elseif(AR(i) > AL(i)) then
+  elseif(AR(i) > AL(i)) THEN
         A6(i) = 3.*(AL(i)-p(i))
         AR(i) = AL(i) - A6(i)
@@ -1661,12 +1660,12 @@
   END DO
   endif
-  return
-end subroutine lmtppm
+  RETURN
+END SUBROUTINE lmtppm
 !
 SUBROUTINE A2C(U,V,IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
   IMPLICIT NONE
-  integer :: IMR,JMR,j1,j2
-  real :: U(IMR,*),V(IMR,*),CRX(IMR,*),CRY(IMR,*),DTDX5(*),DTDY5
-  integer :: i,j
+  INTEGER :: IMR,JMR,j1,j2
+  REAL :: U(IMR,*),V(IMR,*),CRX(IMR,*),CRY(IMR,*),DTDX5(*),DTDY5
+  INTEGER :: i,j
   !
   do j=j1,j2
@@ -1683,13 +1682,13 @@
   CRY(i,2) = DTDY5*(V(i,2)+V(i,1))
   END DO
-  return
-end subroutine a2c
+  RETURN
+END SUBROUTINE a2c
 !
 SUBROUTINE cosa(cosp,cose,JNP,PI,DP)
   IMPLICIT NONE
-  integer :: JNP
-  real :: cosp(*),cose(*),PI,DP
-  integer :: JMR,j,jeq
-  real :: ph5
+  INTEGER :: JNP
+  REAL :: cosp(*),cose(*),PI,DP
+  INTEGER :: JMR,j,jeq
+  REAL :: ph5
   JMR = JNP-1
   do j=2,JNP
@@ -1699,5 +1698,5 @@
   !
   JEQ = (JNP+1) / 2
-  if(JMR == 2*(JMR/2) ) then
+  IF(JMR == 2*(JMR/2) ) THEN
   do j=JNP, JEQ+1, -1
    cose(j) =  cose(JNP+2-j)
@@ -1716,13 +1715,13 @@
   cosp(1) = 0.
   cosp(JNP) = 0.
-  return
-end subroutine cosa
+  RETURN
+END SUBROUTINE cosa
 !
 SUBROUTINE cosc(cosp,cose,JNP,PI,DP)
   IMPLICIT NONE
-  integer :: JNP
-  real :: cosp(*),cose(*),PI,DP
-  real :: phi
-  integer :: j
+  INTEGER :: JNP
+  REAL :: cosp(*),cose(*),PI,DP
+  REAL :: phi
+  INTEGER :: j
   !
   phi = -0.5*PI
@@ -1741,6 +1740,6 @@
    cosp(j) = 0.5*(cose(j)+cose(j+1))
   END DO
-  return
-end subroutine cosc
+  RETURN
+END SUBROUTINE cosc
 !
 SUBROUTINE qckxyz(Q,qtmp,IMR,JNP,NLAY,j1,j2,cosp,acosp, &
@@ -1752,5 +1751,5 @@
   logical :: cross
   INTEGER :: NLAYM1,len,ip,L,icr,ipy,ipx,i
-  real :: qup,qly,dup,sum
+  REAL :: qup,qly,dup,sum
   !
   NLAYM1 = NLAY-1
@@ -1762,12 +1761,12 @@
     icr = 1
   CALL filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
-  if(ipy==0) goto 50
+  IF(ipy==0) goto 50
   CALL filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
-  if(ipx==0) goto 50
-  !
-  if(cross) then
+  IF(ipx==0) goto 50
+  !
+  IF(cross) THEN
   CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
   endif
-  if(icr==0) goto 50
+  IF(icr==0) goto 50
   !
   ! Vertical filling...
@@ -1785,11 +1784,11 @@
   !
   CALL filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
-  if(ipy==0) goto 225
+  IF(ipy==0) goto 225
   CALL filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
-  if(ipx==0) go to 225
-  if(cross) then
+  IF(ipx==0) go to 225
+  IF(cross) THEN
   CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
   endif
-  if(icr==0) goto 225
+  IF(icr==0) goto 225
   !
   do i=1,len
@@ -1816,10 +1815,10 @@
   !
   CALL filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
-  if(ipy==0) goto 911
+  IF(ipy==0) goto 911
   CALL filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
-  if(ipx==0) goto 911
+  IF(ipx==0) goto 911
   !
   CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
-  if(icr==0) goto 911
+  IF(icr==0) goto 911
   !
   DO  I=1,len
@@ -1841,11 +1840,11 @@
 911   continue
   !
-  if(ip>IMR) then
-  write(6,*) 'IC=',IC,' STEP=',NSTEP, &
+  IF(ip>IMR) THEN
+  WRITE(6,*) 'IC=',IC,' STEP=',NSTEP, &
         ' Vertical filling pts=',ip
   endif
   !
-  if(sum>1.e-25) then
-  write(6,*) IC,NSTEP,' Mass source from the ground=',sum
+  IF(sum>1.e-25) THEN
+  WRITE(6,*) IC,NSTEP,' Mass source from the ground=',sum
   endif
   RETURN
@@ -1854,8 +1853,8 @@
 SUBROUTINE filcr(q,IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
   IMPLICIT NONE
-  integer :: IMR,JNP,j1,j2,icr
-  real :: q(IMR,*),cosp(*),acosp(*),tiny
-  integer :: i,j
-  real :: dq,dn,d0,d1,ds,d2
+  INTEGER :: IMR,JNP,j1,j2,icr
+  REAL :: q(IMR,*),cosp(*),acosp(*),tiny
+  INTEGER :: i,j
+  REAL :: dq,dn,d0,d1,ds,d2
   icr = 0
   do j=j1+1,j2-1
@@ -1878,5 +1877,5 @@
   endif
   END DO
-  if(icr==0 .and. q(IMR,j)>=0.) goto 65
+  IF(icr==0 .and. q(IMR,j)>=0.) goto 65
   DO i=2,IMR
   IF(q(i,j)<0.) THEN
@@ -1940,5 +1939,5 @@
   !
   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
@@ -1948,16 +1947,16 @@
 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
   !
-  return
-end subroutine filcr
+  RETURN
+END SUBROUTINE filcr
 !
 SUBROUTINE filns(q,IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
   IMPLICIT NONE
-  integer :: IMR,JNP,j1,j2,ipy
-  real :: q(IMR,*),cosp(*),acosp(*),tiny
-  real :: DP,CAP1,dq,dn,d0,d1,ds,d2
+  INTEGER :: IMR,JNP,j1,j2,ipy
+  REAL :: q(IMR,*),cosp(*),acosp(*),tiny
+  REAL :: DP,CAP1,dq,dn,d0,d1,ds,d2
   INTEGER :: i,j
    ! logical first
@@ -1965,5 +1964,5 @@
    ! save cap1
   !
-  !  if(first) then
+  !  IF(first) THEN
   DP = 4.*ATAN(1.)/REAL(JNP-1)
   CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP
@@ -2021,31 +2020,31 @@
   !
   ! Check Poles.
-  if(q(1,1)<0.) then
+  IF(q(1,1)<0.) THEN
   dq = q(1,1)*cap1/REAL(IMR)*acosp(j1)
   do i=1,imr
   q(i,1) = 0.
   q(i,j1) = q(i,j1) + dq
-  if(q(i,j1)<0.) ipy = 1
-  enddo
-  endif
-  !
-  if(q(1,JNP)<0.) then
+  IF(q(i,j1)<0.) ipy = 1
+  enddo
+  endif
+  !
+  IF(q(1,JNP)<0.) THEN
   dq = q(1,JNP)*cap1/REAL(IMR)*acosp(j2)
   do i=1,imr
   q(i,JNP) = 0.
   q(i,j2) = q(i,j2) + dq
-  if(q(i,j2)<0.) ipy = 1
-  enddo
-  endif
-  !
-  return
-end subroutine filns
+  IF(q(i,j2)<0.) ipy = 1
+  enddo
+  endif
+  !
+  RETURN
+END SUBROUTINE filns
 !
 SUBROUTINE filew(q,qtmp,IMR,JNP,j1,j2,ipx,tiny)
   IMPLICIT NONE
-  integer :: IMR,JNP,j1,j2,ipx
-  real :: q(IMR,*),qtmp(JNP,IMR),tiny
-  integer :: i,j
-  real :: d0,d1,d2
+  INTEGER :: IMR,JNP,j1,j2,ipx
+  REAL :: q(IMR,*),qtmp(JNP,IMR),tiny
+  INTEGER :: i,j
+  REAL :: d0,d1,d2
   !
   ipx = 0
@@ -2059,5 +2058,5 @@
   do i=2,imr-1
   do j=j1,j2
-  if(qtmp(j,i)<0.) then
+  IF(qtmp(j,i)<0.) THEN
   ipx =  1
   ! west
@@ -2077,5 +2076,5 @@
   i=1
   do j=j1,j2
-  if(qtmp(j,i)<0.) then
+  IF(qtmp(j,i)<0.) THEN
   ipx =  1
   ! west
@@ -2094,5 +2093,5 @@
   i=IMR
   do j=j1,j2
-  if(qtmp(j,i)<0.) then
+  IF(qtmp(j,i)<0.) THEN
   ipx =  1
   ! west
@@ -2110,5 +2109,5 @@
   END DO
   !
-  if(ipx/=0) then
+  IF(ipx/=0) THEN
   do j=j1,j2
   do i=1,imr
@@ -2119,17 +2118,17 @@
   !
   ! Poles.
-  if(q(1,1)<0 .or. q(1,JNP)<0.) ipx = 1
-  endif
-  return
-end subroutine filew
+  IF(q(1,1)<0 .or. q(1,JNP)<0.) ipx = 1
+  endif
+  RETURN
+END SUBROUTINE filew
 !
 SUBROUTINE zflip(q,im,km,nc)
   IMPLICIT NONE
   ! This routine flip the array q (in the vertical).
-  integer :: im,km,nc
-  real :: q(im,km,nc)
+  INTEGER :: im,km,nc
+  REAL :: q(im,km,nc)
   ! local dynamic array
-  real :: qtmp(im,km)
-  integer :: IC,k,i
+  REAL :: qtmp(im,km)
+  INTEGER :: IC,k,i
   !
   do IC = 1, nc
@@ -2145,4 +2144,4 @@
   END DO
   END DO
-  return
-end subroutine zflip
+  RETURN
+END SUBROUTINE zflip
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.f90	(revision 5116)
@@ -33,10 +33,10 @@
   REAL :: q( iip1,jjp1,llm,0:9)
   REAL :: w( ip1jmp1,llm )
-  integer :: ordre,ilim
+  INTEGER :: ordre,ilim
 
   !   Local:
   !   ------
   LOGICAL :: limit
-  real :: zq(iip1,jjp1,llm)
+  REAL :: zq(iip1,jjp1,llm)
   REAL :: sm ( iip1,jjp1, llm )
   REAL :: s0( iip1,jjp1,llm ),  sx( iip1,jjp1,llm )
@@ -49,16 +49,16 @@
   REAL :: szz( iip1,jjp1,llm ),zz
   INTEGER :: i,j,l,indice
-  real :: sxn(iip1),sxs(iip1)
-
-  real :: sinlon(iip1),sinlondlon(iip1)
-  real :: coslon(iip1),coslondlon(iip1)
-  real :: qmin,qmax
+  REAL :: sxn(iip1),sxs(iip1)
+
+  REAL :: sinlon(iip1),sinlondlon(iip1)
+  REAL :: coslon(iip1),coslondlon(iip1)
+  REAL :: qmin,qmax
   save qmin,qmax
   save sinlon,coslon,sinlondlon,coslondlon
-  real :: dyn1,dyn2,dys1,dys2,qpn,qps,dqzpn,dqzps
-  real :: masn,mass
+  REAL :: dyn1,dyn2,dys1,dys2,qpn,qps,dqzpn,dqzps
+  REAL :: masn,mass
   !
   REAL :: SSUM
-  integer :: ismax,ismin
+  INTEGER :: ismax,ismin
   EXTERNAL  SSUM, ismin,ismax
   logical :: first
@@ -80,5 +80,5 @@
   limit = .TRUE.
 
-  if(first) then
+  IF(first) THEN
      PRINT*,'SCHEMA PRATHER'
      first=.FALSE.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/principal_cshift_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/principal_cshift_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/principal_cshift_m.F90	(revision 5116)
@@ -11,6 +11,6 @@
     ! xprimm.
 
-    use nrtype, only: twopi
-    use serre_mod, only: clon
+    use nrtype, ONLY: twopi
+    use serre_mod, ONLY: clon
 
     include "dimensions.h"
@@ -22,5 +22,5 @@
     !-----------------------------------------------------
 
-    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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/sortvarc.f90	(revision 5116)
@@ -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,5 +162,5 @@
   ! 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
@@ -168,20 +168,20 @@
   endif
   rmsv= SQRT(rmsv/ptot)
-  if (ptot0/=0) then
+  if (ptot0/=0) THEN
     ptot= ptot/ptot0
   else
     ptot=1.
   endif
-  if (ztot0/=0) then
+  if (ztot0/=0) THEN
     ztot= ztot/ztot0
   else
     ztot=1.
   endif
-  if (stot0/=0) then
+  if (stot0/=0) THEN
     stot= stot/stot0
   else
     stot=1.
   endif
-  if (ang0/=0) then
+  if (ang0/=0) THEN
     ang = ang /ang0
   else
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.f90	(revision 5116)
@@ -44,5 +44,5 @@
      do ij=1,iim
       if (teta(ij,l)/=teta(1,l) &
-            .or.teta(ip1jm+ij,l)/=teta(ip1jm+1,l) ) then
+            .or.teta(ip1jm+ij,l)/=teta(ip1jm+1,l) ) THEN
       PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', &
             ' constant aux poles ! '
@@ -100,5 +100,5 @@
      do ij=1,iim
       if (p(ij,l)/=p(1,l) &
-            .or.p(ip1jm+ij,l)/=p(ip1jm+1,l) ) then
+            .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/traceurpole.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/traceurpole.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/traceurpole.f90	(revision 5116)
@@ -12,16 +12,16 @@
 
   !   Arguments
-  integer :: iq
-  real :: masse(iip1, jjp1, llm)
-  real :: q(iip1, jjp1, llm)
+  INTEGER :: iq
+  REAL :: masse(iip1, jjp1, llm)
+  REAL :: q(iip1, jjp1, llm)
 
 
   !   Locals
-  integer :: i, j, l
-  real :: sommemassen(llm)
-  real :: sommemqn(llm)
-  real :: sommemasses(llm)
-  real :: sommemqs(llm)
-  real :: qpolen(llm), qpoles(llm)
+  INTEGER :: i, j, l
+  REAL :: sommemassen(llm)
+  REAL :: sommemqn(llm)
+  REAL :: sommemasses(llm)
+  REAL :: sommemqs(llm)
+  REAL :: qpolen(llm), qpoles(llm)
 
 
@@ -56,4 +56,4 @@
   enddo
 
-  return
-end subroutine traceurpole
+  RETURN
+END SUBROUTINE traceurpole
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90	(revision 5116)
@@ -11,5 +11,5 @@
   ! levels are pressure levels.
 
-  use comconst_mod, only: omeg, rad
+  use comconst_mod, ONLY: omeg, rad
   
   IMPLICIT NONE
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/write_grads_dyn.h	(revision 5116)
@@ -2,6 +2,5 @@
 ! $Header$
 
-if (callinigrads) then
-
+if (callinigrads) THEN
    string10='dyn'
    CALL inigrads(1,iip1 &
@@ -26,5 +25,5 @@
 do iq=1,nqtot
    string10='q'
-   write(string10(2:2),'(i1)') iq
+   WRITE(string10(2:2),'(i1)') iq
    CALL wrgrads(1,llm,q(:,:,iq),string10,string10)
 enddo
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90	(revision 5116)
@@ -47,5 +47,5 @@
   REAL :: phis(ip1jmp1)
   REAL :: q(ip1jmp1, llm, nqtot)
-  integer :: time
+  INTEGER :: time
 
 
@@ -53,8 +53,8 @@
   !   Variables locales
   !
-  integer :: iq, ii, ll
-  integer :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
+  INTEGER :: iq, ii, ll
+  INTEGER :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
   logical :: ok_sync
-  integer :: itau_w
+  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
-  return
-end subroutine writehist
+  RETURN
+END SUBROUTINE writehist
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90	(revision 5116)
@@ -18,13 +18,13 @@
   !     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_gcm'
+  WRITE(lunout,*) 'in abort_gcm'
 !$OMP MASTER
   CALL histclo
   CALL restclo
-  if (MPI_rank == 0) then
+  if (MPI_rank == 0) THEN
      CALL getin_dump
   endif
@@ -34,10 +34,10 @@
   ! CALL histclo(4)
   ! CALL histclo(5)
-  write(lunout,*) 'Stopping in ', modname
-  write(lunout,*) 'Reason = ',message
-  if (ierr == 0) then
-    write(lunout,*) 'Everything is cool'
+  WRITE(lunout,*) 'Stopping in ', modname
+  WRITE(lunout,*) 'Reason = ',message
+  if (ierr == 0) THEN
+    WRITE(lunout,*) 'Everything is cool'
   else
-    write(lunout,*) 'Houston, we have a problem, ierr = ', ierr
+    WRITE(lunout,*) 'Houston, we have a problem, ierr = ', ierr
 
     if (using_mpi) THEN
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90	(revision 5116)
@@ -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
@@ -111,5 +111,5 @@
   endif
 
-  if (pole_sud) then
+  if (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  k    = 1, llm
@@ -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
@@ -196,6 +196,5 @@
 
 !$OMP MASTER
-  if (pole_nord) then
-
+  if (pole_nord) THEN
     DO  ij   = 1, iim
       xpn(ij) = aire(   ij   ) * pps(  ij     )
@@ -210,6 +209,5 @@
   endif
 
-  if (pole_sud) then
-
+  if (pole_sud) THEN
     DO  ij   = 1, iim
       xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
@@ -225,5 +223,5 @@
 !$OMP END MASTER
 
-  if (pole_nord) then
+  if (pole_nord) THEN
     DO iq = 1, nqtot
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -242,5 +240,5 @@
   endif
 
-  if (pole_sud) then
+  if (pole_sud) THEN
     DO iq = 1, nqtot
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90	(revision 5116)
@@ -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.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90	(revision 5116)
@@ -20,4 +20,5 @@
   USE strings_mod, ONLY: int2str
   USE lmdz_description, ONLY: descript
+  USE lmdz_libmath, ONLY: minmax
 
   IMPLICIT NONE
@@ -51,5 +52,4 @@
   INTEGER, SAVE :: iadvtr = 0
   !$OMP THREADPRIVATE(iadvtr)
-  EXTERNAL  minmax
 
   !---------------------------------------------------------------------------
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90	(revision 5116)
@@ -45,15 +45,15 @@
 
     include "dimensions.h"
-      integer :: i,j
+      INTEGER :: i,j
       character (len=4) :: siim,sjjm,sllm,sproc
       character (len=255) :: filename
-      integer :: unit_number=10
-      integer :: ierr
+      INTEGER :: unit_number=10
+      INTEGER :: ierr
     
       CALL AllocateBands
-      write(siim,'(i3)') iim
-      write(sjjm,'(i3)') jjm
-      write(sllm,'(i3)') llm
-      write(sproc,'(i3)') mpi_size
+      WRITE(siim,'(i3)') iim
+      WRITE(sjjm,'(i3)') jjm
+      WRITE(sllm,'(i3)') llm
+      WRITE(sproc,'(i3)') mpi_size
       filename='Bands_'//TRIM(ADJUSTL(siim))//'x'//TRIM(ADJUSTL(sjjm))//'x'//TRIM(ADJUSTL(sllm))//'_'  &
                         //TRIM(ADJUSTL(sproc))//'prc.dat'    
@@ -61,6 +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)
@@ -129,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
@@ -138,6 +137,6 @@
       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
@@ -180,11 +179,11 @@
       TYPE(distrib),INTENT(INOUT) :: new_dist
 
-      real :: minvalue,maxvalue
-      integer :: min_proc,max_proc
-      integer :: i,j
+      REAL :: minvalue,maxvalue
+      INTEGER :: min_proc,max_proc
+      INTEGER :: i,j
       real,allocatable,dimension(:) :: value
       integer,allocatable,dimension(:) :: index
-      real :: tmpvalue
-      integer :: tmpindex
+      REAL :: tmpvalue
+      INTEGER :: tmpindex
       
       allocate(value(0:mpi_size-1))
@@ -201,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)
@@ -219,6 +218,6 @@
         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
@@ -226,5 +225,5 @@
            else
              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
+	        -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
                jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
@@ -247,11 +246,11 @@
       TYPE(distrib),INTENT(INOUT) :: new_dist
 
-      real :: minvalue,maxvalue
-      integer :: min_proc,max_proc
-      integer :: i,j
+      REAL :: minvalue,maxvalue
+      INTEGER :: min_proc,max_proc
+      INTEGER :: i,j
       real,allocatable,dimension(:) :: value
       integer,allocatable,dimension(:) :: index
-      real :: tmpvalue
-      integer :: tmpindex
+      REAL :: tmpvalue
+      INTEGER :: tmpindex
       
       allocate(value(0:mpi_size-1))
@@ -268,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)
@@ -287,12 +286,12 @@
         min_proc=index(i)
 
-        if (jj_nb_vanleer(max_proc)>2) then
+        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
+             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
              jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
 	     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
@@ -316,11 +315,11 @@
       TYPE(distrib),INTENT(INOUT) :: new_dist
       
-      real :: minvalue,maxvalue
-      integer :: min_proc,max_proc
-      integer :: i,j
+      REAL :: minvalue,maxvalue
+      INTEGER :: min_proc,max_proc
+      INTEGER :: i,j
       real,allocatable,dimension(:) :: value
       integer,allocatable,dimension(:) :: index
-      real :: tmpvalue
-      integer :: tmpindex
+      REAL :: tmpvalue
+      INTEGER :: tmpindex
       
       allocate(value(0:mpi_size-1))
@@ -337,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)
@@ -356,6 +355,6 @@
         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
@@ -363,5 +362,5 @@
            else
              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
+	        - 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
                jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
@@ -389,9 +388,9 @@
       IMPLICIT NONE
 
-      integer :: i,Index
+      INTEGER :: i,Index
       real,allocatable,dimension(:) :: value
       integer,allocatable,dimension(:) :: Inc
-      real :: medium
-      integer :: NbTot,sgn
+      REAL :: medium
+      INTEGER :: NbTot,sgn
       
       allocate(value(0:mpi_size-1))
@@ -415,5 +414,5 @@
       enddo
       
-      if (NbTot>=0) then
+      if (NbTot>=0) THEN
         Sgn=1
       else
@@ -441,14 +440,14 @@
     include "dimensions.h"
 
-      integer :: i,j
+      INTEGER :: i,j
       character (len=4) :: siim,sjjm,sllm,sproc
       character (len=255) :: filename
-      integer :: unit_number=10
-      integer :: ierr
-  
-      write(siim,'(i3)') iim
-      write(sjjm,'(i3)') jjm
-      write(sllm,'(i3)') llm
-      write(sproc,'(i3)') mpi_size
+      INTEGER :: unit_number=10
+      INTEGER :: ierr
+  
+      WRITE(siim,'(i3)') iim
+      WRITE(sjjm,'(i3)') jjm
+      WRITE(sllm,'(i3)') llm
+      WRITE(sproc,'(i3)') mpi_size
 
       filename='Bands_'//TRIM(ADJUSTL(siim))//'x'//TRIM(ADJUSTL(sjjm))//'x'//TRIM(ADJUSTL(sllm))//'_'  &
@@ -457,6 +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/bilan_dyn_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90	(revision 5116)
@@ -41,15 +41,15 @@
   !   ===========
 
-  integer :: ntrac
-  real :: dt_app,dt_cum
-  real :: ps(iip1,jjb_u:jje_u)
-  real :: masse(iip1,jjb_u:jje_u,llm),pk(iip1,jjb_u:jje_u,llm)
-  real :: flux_u(iip1,jjb_u:jje_u,llm)
-  real :: flux_v(iip1,jjb_v:jje_v,llm)
-  real :: teta(iip1,jjb_u:jje_u,llm)
-  real :: phi(iip1,jjb_u:jje_u,llm)
-  real :: ucov(iip1,jjb_u:jje_u,llm)
-  real :: vcov(iip1,jjb_v:jje_v,llm)
-  real :: trac(iip1,jjb_u:jje_u,llm,ntrac)
+  INTEGER :: ntrac
+  REAL :: dt_app,dt_cum
+  REAL :: ps(iip1,jjb_u:jje_u)
+  REAL :: masse(iip1,jjb_u:jje_u,llm),pk(iip1,jjb_u:jje_u,llm)
+  REAL :: flux_u(iip1,jjb_u:jje_u,llm)
+  REAL :: flux_v(iip1,jjb_v:jje_v,llm)
+  REAL :: teta(iip1,jjb_u:jje_u,llm)
+  REAL :: phi(iip1,jjb_u:jje_u,llm)
+  REAL :: ucov(iip1,jjb_u:jje_u,llm)
+  REAL :: vcov(iip1,jjb_v:jje_v,llm)
+  REAL :: trac(iip1,jjb_u:jje_u,llm,ntrac)
 
   !   Local :
@@ -61,5 +61,5 @@
 !$OMP THREADPRIVATE(first)
 
-  real :: zz,zqy
+  REAL :: zz,zqy
   REAl,SAVE,ALLOCATABLE :: zfactv(:,:)
 
@@ -69,9 +69,9 @@
   !ym      character*6 nom(nQ)
   !ym      character*6 unites(nQ)
-  character(len=6),save :: nom(nQ)
-  character(len=6),save :: unites(nQ)
-
-  character(len=10) file
-  integer :: ifile
+  CHARACTER(LEN=6),save :: nom(nQ)
+  CHARACTER(LEN=6),save :: unites(nQ)
+
+  CHARACTER(LEN=10) file
+  INTEGER :: ifile
   parameter (ifile=4)
 
@@ -84,5 +84,5 @@
 !$OMP THREADPRIVATE(time,itau)
 
-  real :: ww
+  REAL :: ww
 
   !   variables dynamiques intermédiaires
@@ -110,5 +110,5 @@
 
   !   champs de tansport en moyenne zonale
-  integer :: ntr,itr
+  INTEGER :: ntr,itr
   parameter (ntr=5)
 
@@ -122,5 +122,5 @@
   INTEGER,PARAMETER :: iave=1,itot=2,immc=3,itrs=4,istn=5
 
-  character(len=3) :: ctrs(ntr)
+  CHARACTER(LEN=3) :: ctrs(ntr)
   data ctrs/'  ','TOT','MMC','TRS','STN'/
 
@@ -131,5 +131,5 @@
   real,SAVE,ALLOCATABLE ::  zv(:,:),psi(:,:)
 
-  integer :: i,j,l,iQ
+  INTEGER :: i,j,l,iQ
 
 
@@ -137,8 +137,8 @@
   !   ---------------------------------------------------------
 
-  character(len=10) :: infile
+  CHARACTER(LEN=10) :: infile
 
   integer, save :: fileid
-  integer :: thoriid, zvertiid
+  INTEGER :: thoriid, zvertiid
 
   INTEGER,SAVE,ALLOCATABLE :: ndex3d(:)
@@ -146,13 +146,13 @@
   !   Variables locales
   !
-  integer :: tau0
-  real :: zjulian
-  character(len=3) :: str
-  character(len=10) :: ctrac
-  integer :: ii,jj
-  integer :: zan, dayref
+  INTEGER :: tau0
+  REAL :: zjulian
+  CHARACTER(LEN=3) :: str
+  CHARACTER(LEN=10) :: ctrac
+  INTEGER :: ii,jj
+  INTEGER :: zan, dayref
   !
   real,SAVE,ALLOCATABLE :: rlong(:),rlatg(:)
-  integer :: jjb,jje,jjn,ijb,ije
+  INTEGER :: jjb,jje,jjn,ijb,ije
   type(Request),SAVE :: Req
 !$OMP THREADPRIVATE(Req)
@@ -178,5 +178,5 @@
   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'
@@ -296,5 +296,5 @@
   do iQ=1,nQ
      do itr=1,ntr
-        if(itr==1) then
+        IF(itr==1) THEN
            znom(itr,iQ)=nom(iQ)
            znoml(itr,iQ)=nom(iQ)
@@ -404,5 +404,5 @@
   !=====================================================================
   !
-  if(icum==0) then
+  IF(icum==0) THEN
      jjb=jj_begin
      jje=jj_end
@@ -582,5 +582,5 @@
   !   PAS DE TEMPS D'ECRITURE
   !=====================================================================
-  if (icum==ncum) then
+  if (icum==ncum) THEN
   !=====================================================================
 
@@ -776,5 +776,5 @@
   !   sorties proprement dites
 !$OMP MASTER
-  if (i_sortie==1) then
+  if (i_sortie==1) THEN
   jjb=jj_begin
   jje=jj_end
@@ -841,3 +841,3 @@
 
 
-end subroutine bilan_dyn_loc
+END SUBROUTINE bilan_dyn_loc
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90	(revision 5116)
@@ -54,5 +54,5 @@
   !$OMP THREADPRIVATE(Request_vanleer)
 
-  !write(*,*) 'caladvtrac 58: entree'
+  !WRITE(*,*) 'caladvtrac 58: entree'
   ijbu = ij_begin
   ijeu = ij_end
@@ -107,5 +107,5 @@
 
   IF (iadvtr==iapp_tracvl) THEN
-    !write(*,*) 'caladvtrac 133'
+    !WRITE(*,*) 'caladvtrac 133'
     !$OMP MASTER
     CALL suspend_timer(timer_caldyn)
@@ -181,9 +181,9 @@
       CALL WriteField_u('wg1', wg_adv)
     END IF
-    !write(*,*) 'caladvtrac 185'
+    !WRITE(*,*) 'caladvtrac 185'
     CALL advtrac_loc(pbarug_adv, pbarvg_adv, wg_adv, &
             p_adv, massem_adv, q_adv, teta_adv, &
             pk_adv)
-    !write(*,*) 'caladvtrac 189'
+    !WRITE(*,*) 'caladvtrac 189'
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90	(revision 5116)
@@ -102,6 +102,6 @@
   ! adjust=y not implemented in case of OpenMP threads...
   !$OMP PARALLEL
-  IF ((OMP_GET_NUM_THREADS()>1).and.adjust) then
-     write(lunout,*)'conf_gcm: Error, adjust should be set to n' &
+  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'
      abort_message = 'Wrong value for adjust'
@@ -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
@@ -454,5 +454,5 @@
 
      IF( ABS(clat - clatt)>= 0.001 )  THEN
-        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def', &
+        WRITE(lunout,*)'conf_gcm: La valeur de clat passee par run.def', &
              ' est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm","stopped",1)
@@ -468,5 +468,5 @@
 
      IF( ABS(grossismx - grossismxx)>= 0.001 )  THEN
-        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ', &
+        WRITE(lunout,*)'conf_gcm: La valeur de grossismx passee par ', &
              'run.def est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm","stopped",1)
@@ -482,5 +482,5 @@
 
      IF( ABS(grossismy - grossismyy)>= 0.001 )  THEN
-        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ', &
+        WRITE(lunout,*)'conf_gcm: La valeur de grossismy passee par ', &
              'run.def est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm","stopped",1)
@@ -488,5 +488,5 @@
 
      IF( grossismx<1. )  THEN
-        write(lunout,*) &
+        WRITE(lunout,*) &
              'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
         CALL abort_gcm("conf_gcm","stopped",1)
@@ -496,5 +496,5 @@
 
      IF( grossismy<1. )  THEN
-        write(lunout,*) &
+        WRITE(lunout,*) &
              'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
         CALL abort_gcm("conf_gcm","stopped",1)
@@ -503,5 +503,5 @@
      ENDIF
 
-     write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
+     WRITE(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
 
      !    alphax et alphay sont les anciennes formulat. des grossissements
@@ -517,6 +517,6 @@
      IF( .NOT.fxyhypb )  THEN
         IF( fxyhypbb )     THEN
-           write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
-           write(lunout,*)' *** fxyhypb lu sur le fichier start est ', &
+           WRITE(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+           WRITE(lunout,*)' *** fxyhypb lu sur le fichier start est ', &
                 'F alors  qu il est  T  sur  run.def  ***'
            CALL abort_gcm("conf_gcm","stopped",1)
@@ -524,6 +524,6 @@
      ELSE
         IF( .NOT.fxyhypbb )   THEN
-           write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
-           write(lunout,*)' ***  fxyhypb lu sur le fichier start est ', &
+           WRITE(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+           WRITE(lunout,*)' ***  fxyhypb lu sur le fichier start est ', &
                 'T alors  qu il est  F  sur  run.def  ****  '
            CALL abort_gcm("conf_gcm","stopped",1)
@@ -541,5 +541,5 @@
      IF( fxyhypb )  THEN
         IF( ABS(dzoomx - dzoomxx)>= 0.001 )  THEN
-           write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ', &
+           WRITE(lunout,*)'conf_gcm: La valeur de dzoomx passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
            CALL abort_gcm("conf_gcm","stopped",1)
@@ -557,5 +557,5 @@
      IF( fxyhypb )  THEN
         IF( ABS(dzoomy - dzoomyy)>= 0.001 )  THEN
-           write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ', &
+           WRITE(lunout,*)'conf_gcm: La valeur de dzoomy passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
            CALL abort_gcm("conf_gcm","stopped",1)
@@ -572,5 +572,5 @@
      IF( fxyhypb )  THEN
         IF( ABS(taux - tauxx)>= 0.001 )  THEN
-           write(lunout,*)'conf_gcm: La valeur de taux passee par ', &
+           WRITE(lunout,*)'conf_gcm: La valeur de taux passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
            CALL abort_gcm("conf_gcm","stopped",1)
@@ -587,5 +587,5 @@
      IF( fxyhypb )  THEN
         IF( ABS(tauy - tauyy)>= 0.001 )  THEN
-           write(lunout,*)'conf_gcm: La valeur de tauy passee par ', &
+           WRITE(lunout,*)'conf_gcm: La valeur de tauy passee par ', &
                 'run.def est differente de celle lue sur le fichier  start '
         CALL abort_gcm("conf_gcm","stopped",1)
@@ -607,6 +607,6 @@
         IF( .NOT.ysinus )  THEN
            IF( ysinuss )     THEN
-              write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
-              write(lunout,*)' *** ysinus lu sur le fichier start est F', &
+              WRITE(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+              WRITE(lunout,*)' *** ysinus lu sur le fichier start est F', &
                    ' alors  qu il est  T  sur  run.def  ***'
               CALL abort_gcm("conf_gcm","stopped",1)
@@ -614,6 +614,6 @@
         ELSE
            IF( .NOT.ysinuss )   THEN
-              write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
-              write(lunout,*)' *** ysinus lu sur le fichier start est T', &
+              WRITE(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+              WRITE(lunout,*)' *** ysinus lu sur le fichier start est T', &
                    ' alors  qu il est  F  sur  run.def  ****  '
               CALL abort_gcm("conf_gcm","stopped",1)
@@ -697,48 +697,48 @@
      CALL getin('ok_dyn_xios',ok_dyn_xios) 
 
-     write(lunout,*)' #########################################'
-     write(lunout,*)' Configuration des parametres du gcm: '
-     write(lunout,*)' planet_type = ', planet_type
-     write(lunout,*)' calend = ', calend
-     write(lunout,*)' dayref = ', dayref
-     write(lunout,*)' anneeref = ', anneeref
-     write(lunout,*)' nday = ', nday
-     write(lunout,*)' day_step = ', day_step
-     write(lunout,*)' iperiod = ', iperiod
-     write(lunout,*)' nsplit_phys = ', nsplit_phys
-     write(lunout,*)' iconser = ', iconser
-     write(lunout,*)' iecri = ', iecri
-     write(lunout,*)' periodav = ', periodav 
-     write(lunout,*)' output_grads_dyn = ', output_grads_dyn
-     write(lunout,*)' dissip_period = ', dissip_period
-     write(lunout,*)' lstardis = ', lstardis
-     write(lunout,*)' nitergdiv = ', nitergdiv
-     write(lunout,*)' nitergrot = ', nitergrot
-     write(lunout,*)' niterh = ', niterh
-     write(lunout,*)' tetagdiv = ', tetagdiv
-     write(lunout,*)' tetagrot = ', tetagrot
-     write(lunout,*)' tetatemp = ', tetatemp
-     write(lunout,*)' coefdis = ', coefdis
-     write(lunout,*)' purmats = ', purmats
-     write(lunout,*)' read_start = ', read_start
-     write(lunout,*)' iflag_phys = ', iflag_phys
-     write(lunout,*)' iphysiq = ', iphysiq
-     write(lunout,*)' clonn = ', clonn 
-     write(lunout,*)' clatt = ', clatt
-     write(lunout,*)' grossismx = ', grossismx
-     write(lunout,*)' grossismy = ', grossismy
-     write(lunout,*)' fxyhypbb = ', fxyhypbb
-     write(lunout,*)' dzoomxx = ', dzoomxx
-     write(lunout,*)' dzoomy = ', dzoomyy
-     write(lunout,*)' tauxx = ', tauxx
-     write(lunout,*)' tauyy = ', tauyy
-     write(lunout,*)' offline = ', offline
-     write(lunout,*)' offline_time = ', offline_time
-     write(lunout,*)' type_trac = ', type_trac
-     write(lunout,*)' ok_dynzon = ', ok_dynzon 
-     write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 
-     write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
-     write(lunout,*)' ok_dyn_xios = ', ok_dyn_xios 
-     write(lunout,*)' adv_qsat_liq = ', adv_qsat_liq
+     WRITE(lunout,*)' #########################################'
+     WRITE(lunout,*)' Configuration des parametres du gcm: '
+     WRITE(lunout,*)' planet_type = ', planet_type
+     WRITE(lunout,*)' calend = ', calend
+     WRITE(lunout,*)' dayref = ', dayref
+     WRITE(lunout,*)' anneeref = ', anneeref
+     WRITE(lunout,*)' nday = ', nday
+     WRITE(lunout,*)' day_step = ', day_step
+     WRITE(lunout,*)' iperiod = ', iperiod
+     WRITE(lunout,*)' nsplit_phys = ', nsplit_phys
+     WRITE(lunout,*)' iconser = ', iconser
+     WRITE(lunout,*)' iecri = ', iecri
+     WRITE(lunout,*)' periodav = ', periodav
+     WRITE(lunout,*)' output_grads_dyn = ', output_grads_dyn
+     WRITE(lunout,*)' dissip_period = ', dissip_period
+     WRITE(lunout,*)' lstardis = ', lstardis
+     WRITE(lunout,*)' nitergdiv = ', nitergdiv
+     WRITE(lunout,*)' nitergrot = ', nitergrot
+     WRITE(lunout,*)' niterh = ', niterh
+     WRITE(lunout,*)' tetagdiv = ', tetagdiv
+     WRITE(lunout,*)' tetagrot = ', tetagrot
+     WRITE(lunout,*)' tetatemp = ', tetatemp
+     WRITE(lunout,*)' coefdis = ', coefdis
+     WRITE(lunout,*)' purmats = ', purmats
+     WRITE(lunout,*)' read_start = ', read_start
+     WRITE(lunout,*)' iflag_phys = ', iflag_phys
+     WRITE(lunout,*)' iphysiq = ', iphysiq
+     WRITE(lunout,*)' clonn = ', clonn
+     WRITE(lunout,*)' clatt = ', clatt
+     WRITE(lunout,*)' grossismx = ', grossismx
+     WRITE(lunout,*)' grossismy = ', grossismy
+     WRITE(lunout,*)' fxyhypbb = ', fxyhypbb
+     WRITE(lunout,*)' dzoomxx = ', dzoomxx
+     WRITE(lunout,*)' dzoomy = ', dzoomyy
+     WRITE(lunout,*)' tauxx = ', tauxx
+     WRITE(lunout,*)' tauyy = ', tauyy
+     WRITE(lunout,*)' offline = ', offline
+     WRITE(lunout,*)' offline_time = ', offline_time
+     WRITE(lunout,*)' type_trac = ', type_trac
+     WRITE(lunout,*)' ok_dynzon = ', ok_dynzon
+     WRITE(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
+     WRITE(lunout,*)' ok_dyn_ave = ', ok_dyn_ave
+     WRITE(lunout,*)' ok_dyn_xios = ', ok_dyn_xios
+     WRITE(lunout,*)' adv_qsat_liq = ', adv_qsat_liq
   else
      !Config  Key  = clon
@@ -775,5 +775,5 @@
 
      IF( grossismx<1. )  THEN
-        write(lunout,*) 'conf_gcm: ***ATTENTION !! grossismx < 1 . *** '
+        WRITE(lunout,*) 'conf_gcm: ***ATTENTION !! grossismx < 1 . *** '
         CALL abort_gcm("conf_gcm","stopped",1)
      ELSE
@@ -782,5 +782,5 @@
 
      IF( grossismy<1. )  THEN
-        write(lunout,*) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
+        WRITE(lunout,*) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
         CALL abort_gcm("conf_gcm","stopped",1)
      ELSE
@@ -788,5 +788,5 @@
      ENDIF
 
-     write(lunout,*) 'conf_gcm: alphax alphay ',alphax,alphay
+     WRITE(lunout,*) 'conf_gcm: alphax alphay ',alphax,alphay
 
      !    alphax et alphay sont les anciennes formulat. des grossissements
@@ -907,6 +907,6 @@
      CALL getin('use_filtre_fft',use_filtre_fft)
      IF (use_filtre_fft .AND. grossismx /= 1.0) THEN
-        write(lunout,*)'WARNING !!! '
-        write(lunout,*)"A zoom in longitude is not compatible", &
+        WRITE(lunout,*)'WARNING !!! '
+        WRITE(lunout,*)"A zoom in longitude is not compatible", &
              " with the FFT filter ", &
              "---> FFT filter deactivated"
@@ -970,53 +970,53 @@
      CALL getin('read_orop',read_orop)
 
-     write(lunout,*)' #########################################'
-     write(lunout,*)' Configuration des parametres de cel0_limit: '
-     write(lunout,*)' planet_type = ', planet_type
-     write(lunout,*)' calend = ', calend
-     write(lunout,*)' dayref = ', dayref
-     write(lunout,*)' anneeref = ', anneeref
-     write(lunout,*)' nday = ', nday
-     write(lunout,*)' day_step = ', day_step
-     write(lunout,*)' iperiod = ', iperiod
-     write(lunout,*)' iconser = ', iconser
-     write(lunout,*)' iecri = ', iecri
-     write(lunout,*)' periodav = ', periodav 
-     write(lunout,*)' output_grads_dyn = ', output_grads_dyn
-     write(lunout,*)' dissip_period = ', dissip_period
-     write(lunout,*)' lstardis = ', lstardis
-     write(lunout,*)' nitergdiv = ', nitergdiv
-     write(lunout,*)' nitergrot = ', nitergrot
-     write(lunout,*)' niterh = ', niterh
-     write(lunout,*)' tetagdiv = ', tetagdiv
-     write(lunout,*)' tetagrot = ', tetagrot
-     write(lunout,*)' tetatemp = ', tetatemp
-     write(lunout,*)' coefdis = ', coefdis
-     write(lunout,*)' purmats = ', purmats
-     write(lunout,*)' read_start = ', read_start
-     write(lunout,*)' iflag_phys = ', iflag_phys
-     write(lunout,*)' iphysiq = ', iphysiq
-     write(lunout,*)' clon = ', clon
-     write(lunout,*)' clat = ', clat
-     write(lunout,*)' grossismx = ', grossismx
-     write(lunout,*)' grossismy = ', grossismy
-     write(lunout,*)' fxyhypb = ', fxyhypb
-     write(lunout,*)' dzoomx = ', dzoomx
-     write(lunout,*)' dzoomy = ', dzoomy
-     write(lunout,*)' taux = ', taux
-     write(lunout,*)' tauy = ', tauy
-     write(lunout,*)' offline = ', offline
-     write(lunout,*)' type_trac = ', type_trac
-     write(lunout,*)' ok_dynzon = ', ok_dynzon
-     write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 
-     write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
-     write(lunout,*)' ok_dyn_xios = ', ok_dyn_xios 
-     write(lunout,*)' use_filtre_fft = ', use_filtre_fft
-     write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc
-     write(lunout,*)' ok_strato = ', ok_strato
-     write(lunout,*)' ok_gradsfile = ', ok_gradsfile
-     write(lunout,*)' ok_limit = ', ok_limit
-     write(lunout,*)' ok_etat0 = ', ok_etat0
-     write(lunout,*)' ok_guide = ', ok_guide
-     write(lunout,*)' read_orop = ', read_orop
+     WRITE(lunout,*)' #########################################'
+     WRITE(lunout,*)' Configuration des parametres de cel0_limit: '
+     WRITE(lunout,*)' planet_type = ', planet_type
+     WRITE(lunout,*)' calend = ', calend
+     WRITE(lunout,*)' dayref = ', dayref
+     WRITE(lunout,*)' anneeref = ', anneeref
+     WRITE(lunout,*)' nday = ', nday
+     WRITE(lunout,*)' day_step = ', day_step
+     WRITE(lunout,*)' iperiod = ', iperiod
+     WRITE(lunout,*)' iconser = ', iconser
+     WRITE(lunout,*)' iecri = ', iecri
+     WRITE(lunout,*)' periodav = ', periodav
+     WRITE(lunout,*)' output_grads_dyn = ', output_grads_dyn
+     WRITE(lunout,*)' dissip_period = ', dissip_period
+     WRITE(lunout,*)' lstardis = ', lstardis
+     WRITE(lunout,*)' nitergdiv = ', nitergdiv
+     WRITE(lunout,*)' nitergrot = ', nitergrot
+     WRITE(lunout,*)' niterh = ', niterh
+     WRITE(lunout,*)' tetagdiv = ', tetagdiv
+     WRITE(lunout,*)' tetagrot = ', tetagrot
+     WRITE(lunout,*)' tetatemp = ', tetatemp
+     WRITE(lunout,*)' coefdis = ', coefdis
+     WRITE(lunout,*)' purmats = ', purmats
+     WRITE(lunout,*)' read_start = ', read_start
+     WRITE(lunout,*)' iflag_phys = ', iflag_phys
+     WRITE(lunout,*)' iphysiq = ', iphysiq
+     WRITE(lunout,*)' clon = ', clon
+     WRITE(lunout,*)' clat = ', clat
+     WRITE(lunout,*)' grossismx = ', grossismx
+     WRITE(lunout,*)' grossismy = ', grossismy
+     WRITE(lunout,*)' fxyhypb = ', fxyhypb
+     WRITE(lunout,*)' dzoomx = ', dzoomx
+     WRITE(lunout,*)' dzoomy = ', dzoomy
+     WRITE(lunout,*)' taux = ', taux
+     WRITE(lunout,*)' tauy = ', tauy
+     WRITE(lunout,*)' offline = ', offline
+     WRITE(lunout,*)' type_trac = ', type_trac
+     WRITE(lunout,*)' ok_dynzon = ', ok_dynzon
+     WRITE(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
+     WRITE(lunout,*)' ok_dyn_ave = ', ok_dyn_ave
+     WRITE(lunout,*)' ok_dyn_xios = ', ok_dyn_xios
+     WRITE(lunout,*)' use_filtre_fft = ', use_filtre_fft
+     WRITE(lunout,*)' use_mpi_alloc = ', use_mpi_alloc
+     WRITE(lunout,*)' ok_strato = ', ok_strato
+     WRITE(lunout,*)' ok_gradsfile = ', ok_gradsfile
+     WRITE(lunout,*)' ok_limit = ', ok_limit
+     WRITE(lunout,*)' ok_etat0 = ', ok_etat0
+     WRITE(lunout,*)' ok_guide = ', ok_guide
+     WRITE(lunout,*)' read_orop = ', read_orop
   ENDIF test_etatinit
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90	(revision 5116)
@@ -33,10 +33,10 @@
   ijev=ij_end+iip1
 
-  if (pole_nord) then
+  if (pole_nord) THEN
     ijbu=ij_begin+iip1
     ijbv=ij_begin
   endif
 
-  if (pole_sud) then
+  if (pole_sud) THEN
     ijeu=ij_end-iip1
     ijev=ij_end-iip1
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90	(revision 5116)
@@ -34,6 +34,5 @@
   ije=ij_end
 
-  if (pole_nord) then
-
+  if (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l = 1,klevel
@@ -45,5 +44,5 @@
   endif
 
-  if (pole_sud) then
+  if (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l = 1,klevel
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90	(revision 5116)
@@ -58,5 +58,5 @@
 
   REAL :: SSUM
-  integer :: ijb, ije
+  INTEGER :: ijb, ije
 
   LOGICAl, SAVE :: first = .TRUE.
@@ -125,5 +125,5 @@
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
   DO l = 1, llm
-    if (pole_nord) then
+    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.
@@ -171,5 +171,5 @@
   DO l = 1, llm
 
-    if (pole_nord) then
+    if (pole_nord) THEN
       DO ij = 1, iip1
         grx(ij, l) = 0.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90	(revision 5116)
@@ -48,5 +48,5 @@
   ije=ij_end
   if (pole_nord) ijb=ij_begin+iip1
-  if(pole_sud)  ije=ij_end-iip1
+  IF(pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90	(revision 5116)
@@ -44,5 +44,5 @@
   ije=ij_end
   if (pole_nord) ijb=ij_begin+iip1
-  if(pole_sud)  ije=ij_end-iip1
+  IF(pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90	(revision 5116)
@@ -46,5 +46,5 @@
   ije=ij_end
   if (pole_nord) ijb=ij_begin+iip1
-  if(pole_sud)  ije=ij_end-iip1
+  IF(pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -68,6 +68,5 @@
   ! ....  calcul  aux poles  .....
   !
-    if (pole_nord) then
-
+    if (pole_nord) THEN
       DO  ij  = 1,iim
        aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
@@ -82,6 +81,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/dteta1_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90	(revision 5116)
@@ -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/dynetat0_loc.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90	(revision 5116)
@@ -182,8 +182,8 @@
       iqParent = tracers(iq)%iqParent
       IF(tracers(iq)%iso_iZone == 0) THEN
-         if (tnat1) then
+         if (tnat1) THEN
                  tnat=1.0
                  alpha_ideal=1.0
-                 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
+                 WRITE(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
          else
           IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90	(revision 5116)
@@ -58,17 +58,17 @@
     logical, save :: firstcall = .TRUE.
     !$OMP THREADPRIVATE(firstcall)
-    character(len = *), parameter :: modname = "exner_hyb_loc"
+    CHARACTER(LEN = *), parameter :: modname = "exner_hyb_loc"
 
     !$OMP BARRIER
 
     ! 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)
@@ -82,6 +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
@@ -96,5 +95,5 @@
 
       !$OMP BARRIER
-      if (present(pkf)) then
+      if (present(pkf)) THEN
         jjb = jj_begin
         jje = jj_end
@@ -104,5 +103,5 @@
 
       ! our work is done, exit routine
-      return
+      RETURN
     endif ! of if (llm.eq.1)
 
@@ -170,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90	(revision 5116)
@@ -53,15 +53,15 @@
     logical,save :: firstcall=.TRUE.
     !$OMP THREADPRIVATE(firstcall) 
-    character(len=*),parameter :: modname="exner_milieu_loc"
+    CHARACTER(LEN=*),parameter :: modname="exner_milieu_loc"
 
     ! 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)
@@ -75,6 +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
@@ -89,5 +88,5 @@
 
        !$OMP BARRIER
-       if (present(pkf)) then
+       if (present(pkf)) THEN
           jjb=jj_begin
           jje=jj_end
@@ -97,5 +96,5 @@
 
        ! our work is done, exit routine
-       return
+       RETURN
     endif ! of if (llm.eq.1)
 
@@ -141,5 +140,5 @@
     !$OMP ENDDO NOWAIT        
 
-    if (present(pkf)) then
+    if (present(pkf)) THEN
        !    calcul de pkf
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90	(revision 5116)
@@ -44,5 +44,5 @@
 
 
-  !write(*,*) 'caladvtrac 58: entree'
+  !WRITE(*,*) 'caladvtrac 58: entree'
   ijbu = ij_begin
   ijeu = ij_end
@@ -99,5 +99,5 @@
 
   IF (pasflx==(iphysiq * istphy)) THEN
-    !write(*,*) 'caladvtrac 133'
+    !WRITE(*,*) 'caladvtrac 133'
     !$OMP MASTER
     CALL suspend_timer(timer_caldyn)
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90	(revision 5116)
@@ -45,5 +45,5 @@
   CHARACTER(len=80) :: abort_message
 !$OMP THREADPRIVATE(firstcall,friction_type)
-  integer :: jjb,jje
+  INTEGER :: jjb,jje
 
 !$OMP SINGLE
@@ -51,7 +51,7 @@
     ! 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
+      WRITE(lunout,*)'Friction: wrong friction type',friction_type
       CALL abort_gcm(modname,abort_message,42)
     endif
@@ -99,6 +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.
@@ -119,6 +118,5 @@
   endif
 
-  if (pole_sud) then
-
+  if (pole_sud) THEN
     upols=0.
     vpols=0.
@@ -167,5 +165,5 @@
   endif ! of if (friction_type.eq.0)
 
-  if (friction_type==1) then
+  if (friction_type==1) THEN
    ! for ucov()
     jjb=jj_begin
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90	(revision 5116)
@@ -173,15 +173,15 @@
   !      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'
+     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'
+     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'
+     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
      xios_cal_type='gregorian'
   else
@@ -212,12 +212,12 @@
 
   !  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, &
@@ -225,9 +225,9 @@
      !        endif ! of if (planet_type.eq."earth")
 
-     !       write(73,*) 'ucov',ucov
-     !       write(74,*) 'vcov',vcov
-     !       write(75,*) 'teta',teta
-     !       write(76,*) 'ps',ps
-     !       write(77,*) 'q',q
+     !       WRITE(73,*) 'ucov',ucov
+     !       WRITE(74,*) 'vcov',vcov
+     !       WRITE(75,*) 'teta',teta
+     !       WRITE(76,*) 'ps',ps
+     !       WRITE(77,*) 'q',q
 
   endif ! of if (read_start)
@@ -236,5 +236,5 @@
   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
@@ -267,8 +267,8 @@
   ! on remet le calendrier \`a zero si demande
 
-  IF (start_time /= starttime) then
+  IF (start_time /= starttime) THEN
      WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
           ,' fichier restart ne correspond pas a celle lue dans le run.def'
-     IF (raz_date == 1) then
+     IF (raz_date == 1) THEN
         WRITE(lunout,*)'Je prends l''heure lue dans run.def'
         start_time = starttime
@@ -285,26 +285,26 @@
      itau_phy = 0
      time_0 = 0.
-     write(lunout,*) &
+     WRITE(lunout,*) &
           'GCM: On reinitialise a la date lue dans gcm.def'
   ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN
-     write(lunout,*) &
+     WRITE(lunout,*) &
           'GCM: Attention les dates initiales lues dans le fichier'
-     write(lunout,*) &
+     WRITE(lunout,*) &
           ' restart ne correspondent pas a celles lues dans '
-     write(lunout,*)' gcm.def'
-     write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
-     write(lunout,*)' day_ref=',day_ref," dayref=",dayref
-     write(lunout,*)' Pas de remise a zero'
+     WRITE(lunout,*)' gcm.def'
+     WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+     WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
+     WRITE(lunout,*)' Pas de remise a zero'
   ENDIF
-  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
-  !        write(lunout,*)
+  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
+  !        WRITE(lunout,*)
   !     .  'GCM: Attention les dates initiales lues dans le fichier'
-  !        write(lunout,*)
+  !        WRITE(lunout,*)
   !     .  ' restart ne correspondent pas a celles lues dans '
-  !        write(lunout,*)' gcm.def'
-  !        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
-  !        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
-  !        if (raz_date .ne. 1) then
-  !          write(lunout,*)
+  !        WRITE(lunout,*)' gcm.def'
+  !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+  !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
+  !        if (raz_date .ne. 1) THEN
+  !          WRITE(lunout,*)
   !     .    'GCM: On garde les dates du fichier restart'
   !        else
@@ -315,5 +315,5 @@
   !          itau_phy = 0
   !          time_0 = 0.
-  !          write(lunout,*)
+  !          WRITE(lunout,*)
   !     .   'GCM: On reinitialise a la date lue dans gcm.def'
   !        endif
@@ -330,12 +330,12 @@
   CALL ioconf_startdate(INT(jD_ref), jH_ref)
 
-  write(lunout,*)'DEBUG'
-  write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
-  write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
+  WRITE(lunout,*)'DEBUG'
+  WRITE(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
+  WRITE(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
   CALL ju2ymds(jD_ref+jH_ref,anref, moisref, jourref, heureref)
-  write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
-  write(lunout,*)jD_ref+jH_ref,anref, moisref, jourref, heureref
-
-  if (iflag_phys==1) then
+  WRITE(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
+  WRITE(lunout,*)jD_ref+jH_ref,anref, moisref, jourref, heureref
+
+  if (iflag_phys==1) THEN
      ! these initialisations have already been done (via iniacademic)
      ! if running in SW or Newtonian mode
@@ -369,5 +369,5 @@
 
 
-  if (nday>=0) then
+  if (nday>=0) THEN
      day_end = day_ini + nday
   else
@@ -407,5 +407,5 @@
 
 
-  !      if (planet_type.eq."earth") then
+  !      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,5 +433,5 @@
 
 ! 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)
@@ -442,9 +442,9 @@
   !   ----------------------------------
 
-  !       write(78,*) 'ucov',ucov
-  !       write(78,*) 'vcov',vcov
-  !       write(78,*) 'teta',teta
-  !       write(78,*) 'ps',ps
-  !       write(78,*) 'q',q
+  !       WRITE(78,*) 'ucov',ucov
+  !       WRITE(78,*) 'vcov',vcov
+  !       WRITE(78,*) 'teta',teta
+  !       WRITE(78,*) 'ps',ps
+  !       WRITE(78,*) 'q',q
 
   !!$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logici/,/logicl/)
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/getparam.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/getparam.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/getparam.F90	(revision 5116)
@@ -51,7 +51,7 @@
 
     IF (mpi_rank==0) THEN
-      write(out_eff,*) '######################################'
-      write(out_eff,*) '#### ',comment,' #####'
-      write(out_eff,*) TARGET,'=',ret_val
+      WRITE(out_eff,*) '######################################'
+      WRITE(out_eff,*) '#### ',comment,' #####'
+      WRITE(out_eff,*) TARGET,'=',ret_val
     ENDIF
     
@@ -77,8 +77,8 @@
 
     IF (mpi_rank==0) THEN
-      write(out_eff,*) '######################################'
-      write(out_eff,*) '#### ',comment,' #####'
-      write(out_eff,*) comment
-      write(out_eff,*) TARGET,'=',ret_val
+      WRITE(out_eff,*) '######################################'
+      WRITE(out_eff,*) '#### ',comment,' #####'
+      WRITE(out_eff,*) comment
+      WRITE(out_eff,*) TARGET,'=',ret_val
     ENDIF
     
@@ -104,7 +104,7 @@
 
     IF (mpi_rank==0) THEN
-      write(out_eff,*) '######################################'
-      write(out_eff,*) '#### ',comment,' #####'
-      write(out_eff,*) TARGET,'=',ret_val
+      WRITE(out_eff,*) '######################################'
+      WRITE(out_eff,*) '#### ',comment,' #####'
+      WRITE(out_eff,*) TARGET,'=',ret_val
     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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.f90	(revision 5116)
@@ -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
@@ -72,5 +72,5 @@
   endif
 
-  if (pole_sud) then
+  if (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,nx
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90	(revision 5116)
@@ -57,5 +57,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/groupe_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90	(revision 5116)
@@ -25,13 +25,13 @@
   ! parameter (ngroup=3)
 
-  real :: pbaru(iip1, jjb_u:jje_u, llm), pbarv(iip1, jjb_v:jje_v, llm)
-  real :: pext(iip1, jjb_u:jje_u, llm)
+  REAL :: pbaru(iip1, jjb_u:jje_u, llm), pbarv(iip1, jjb_v:jje_v, llm)
+  REAL :: pext(iip1, jjb_u:jje_u, llm)
 
-  real :: pbarum(iip1, jjb_u:jje_u, llm), pbarvm(iip1, jjb_v:jje_v, llm)
-  real :: wm(iip1, jjb_u:jje_u, llm)
+  REAL :: pbarum(iip1, jjb_u:jje_u, llm), pbarvm(iip1, jjb_v:jje_v, llm)
+  REAL :: wm(iip1, jjb_u:jje_u, llm)
 
-  real :: uu
+  REAL :: uu
 
-  integer :: i, j, l
+  INTEGER :: i, j, l
 
   logical :: firstcall
@@ -39,5 +39,5 @@
   !$OMP THREADPRIVATE(firstcall)
 
-  integer :: ijb, ije, jjb, jje
+  INTEGER :: ijb, ije, jjb, jje
 
   !   Champs 1D
@@ -113,5 +113,5 @@
   enddo
 
-  if (.not. pole_sud) then
+  if (.not. pole_sud) THEN
     zconvmm(:, jj_end + 1, :) = 0
     !ym	wm(:,jj_end+1,:)=0
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90	(revision 5116)
@@ -6,7 +6,7 @@
 !=======================================================================
 
-  USE getparam, only: ini_getparam, fin_getparam, getpar
+  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,5 +14,5 @@
           nf90_create, nf90_def_var, nf90_open
   USE parallel_lmdz
-  USE pres2lev_mod, only: pres2lev
+  USE pres2lev_mod, ONLY: pres2lev
 
   IMPLICIT NONE
@@ -127,5 +127,5 @@
     IF (iguide_sav>0) THEN
        iguide_sav=day_step/iguide_sav
-    ELSE if (iguide_sav == 0) then
+    ELSE if (iguide_sav == 0) THEN
        iguide_sav = huge(0)
     ELSE
@@ -173,6 +173,6 @@
 ! ---------------------------------------------
     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
@@ -181,6 +181,6 @@
           endif
        endif
-    elseif (guide_plevs==2) then
-       if (ncidpl==-99) then
+    elseif (guide_plevs==2) THEN
+       if (ncidpl==-99) THEN
           rcod=nf90_open('P.nc',nf90_nowrite,ncidpl)
           if (rcod/=nf90_noerr) THEN
@@ -190,6 +190,6 @@
        endif
 
-    elseif (guide_u) then
-       if (ncidpl==-99) then
+    elseif (guide_u) THEN
+       if (ncidpl==-99) THEN
           rcod=nf90_open('u.nc',nf90_nowrite,ncidpl)
           if (rcod/=nf90_noerr) THEN
@@ -201,6 +201,6 @@
 
 
-    elseif (guide_v) then
-       if (ncidpl==-99) then
+    elseif (guide_v) THEN
+       if (ncidpl==-99) THEN
           rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
           if (rcod/=nf90_noerr) THEN
@@ -211,6 +211,6 @@
 
     
-    elseif (guide_T) then
-       if (ncidpl==-99) then
+    elseif (guide_T) THEN
+       if (ncidpl==-99) THEN
           rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
           if (rcod/=nf90_noerr) THEN
@@ -222,6 +222,6 @@
 
 
-    elseif (guide_Q) then
-       if (ncidpl==-99) then
+    elseif (guide_Q) THEN
+       if (ncidpl==-99) THEN
           rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
           if (rcod/=nf90_noerr) THEN
@@ -240,5 +240,5 @@
     ENDIF
     error=nf90_inquire_dimension(ncidpl,rid,len=nlevnc)
-    write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
+    WRITE(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
     rcod = nf90_close(ncidpl)
 
@@ -358,6 +358,6 @@
 !=======================================================================
   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 exner_hyb_loc_m, ONLY: exner_hyb_loc
+    use exner_milieu_loc_m, ONLY: exner_milieu_loc
     USE parallel_lmdz
     USE control_mod
@@ -451,5 +451,5 @@
         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
+        if (guide_BL) THEN
              alpha_pcor(:)=1.
         else
@@ -499,5 +499,5 @@
       IF (reste==0.) THEN
           IF (itau_test==itau) THEN
-            write(*,*)trim(modname)//' second pass in advreel at itau=',&
+            WRITE(*,*)trim(modname)//' second pass in advreel at itau=',&
             itau
             CALL abort_gcm("guide_loc_lod","stopped",1)
@@ -514,6 +514,6 @@
               step_rea=step_rea+1
               itau_test=itau
-              if (is_master) then
-                write(*,*)trim(modname)//' Reading nudging files, step ',&
+              if (is_master) THEN
+                WRITE(*,*)trim(modname)//' Reading nudging files, step ',&
                     step_rea,'after ',count_no_rea,' skips'
               endif
@@ -567,5 +567,5 @@
 
 !$OMP BARRIER
-      if (pressure_exner) then
+      if (pressure_exner) THEN
       CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk)
       else
@@ -588,6 +588,6 @@
     ENDIF
     
-    if (guide_u) then
-        if (guide_add) then
+    if (guide_u) THEN
+        if (guide_add) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
@@ -620,6 +620,6 @@
     endif
 
-    if (guide_T) then
-        if (guide_add) then
+    if (guide_T) THEN
+        if (guide_add) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
@@ -641,6 +641,6 @@
     endif
 
-    if (guide_P) then
-        if (guide_add) then
+    if (guide_P) THEN
+        if (guide_add) THEN
 !$OMP MASTER
             f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)
@@ -665,6 +665,6 @@
     endif
 
-    if (guide_Q) then
-        if (guide_add) then
+    if (guide_Q) THEN
+        if (guide_add) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
@@ -687,6 +687,6 @@
     endif
 
-    if (guide_v) then
-        if (guide_add) then
+    if (guide_v) THEN
+        if (guide_add) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
           DO l=1,llm
@@ -911,6 +911,6 @@
 !=======================================================================
   SUBROUTINE guide_interp(psi,teta)
-    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 mod_hallo
@@ -952,5 +952,5 @@
 !$OMP THREADPRIVATE(Req)
     
-    if (is_master) write(*,*)trim(modname)//': interpolate nudging variables'
+    if (is_master) WRITE(*,*)trim(modname)//': interpolate nudging variables'
 ! -----------------------------------------------------------------
 ! Calcul des niveaux de pression champs guidage (pour T et Q)
@@ -994,38 +994,38 @@
     ENDIF   
 
-    if (first) then
+    if (first) THEN
         first=.FALSE.
 !$OMP MASTER
-        write(*,*)trim(modname)//' : check vertical level order'
-        write(*,*)trim(modname)//' LMDZ :'
+        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. &
+          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 :'
+        WRITE(*,*)trim(modname)//' nudging file :'
         SELECT CASE (guide_plevs)
         CASE (0) 
             do l=1,nlevnc
-              write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)
+              WRITE(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)
             enddo
         CASE (1)
             DO l=1,nlevnc
-              write(*,*)trim(modname)//' PL(',l,')=',&
+              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)
+              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
+        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)
+              WRITE(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l)
             enddo
         endif
-        if (guide_T) then
+        if (guide_T) THEN
             do l=1,nlevnc
-              write(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)
+              WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)
             enddo
         endif
@@ -1034,7 +1034,7 @@
 
     if (guide_plevs /= 1 .or. guide_t .and. .not. guide_teta &
-         .or. guide_q .and. guide_hr) then
+         .or. guide_q .and. guide_hr) THEN
        CALL pression_loc( ijnb_u, ap, bp, psi, p )
-       if (disvert_type==1) then
+       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
@@ -1110,5 +1110,5 @@
 ! Conversion en variables gcm (ucov, vcov...)
 ! -----------------------------------------------------------------
-    if (guide_P) then
+    if (guide_P) THEN
 !$OMP MASTER
         do j=jjbu,jjeu
@@ -1177,5 +1177,5 @@
                 tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l)    
             enddo
-            if (pole_nord) then
+            if (pole_nord) THEN
               do i=1,iip1
                 tgui1(i,l)=tgui1(1,l)
@@ -1183,5 +1183,5 @@
               enddo
             endif
-            if (pole_sud) then
+            if (pole_sud) THEN
               do i=1,iip1
                 tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l) 
@@ -1239,5 +1239,5 @@
                 qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l)    
             enddo
-            if (pole_nord) then
+            if (pole_nord) THEN
               do i=1,iip1
                 qgui1(i,l)=qgui1(1,l)
@@ -1245,5 +1245,5 @@
               enddo
             endif
-            if (pole_sud) then
+            if (pole_sud) THEN
               do i=1,iip1
                 qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l) 
@@ -1317,5 +1317,5 @@
                 ugui2(j*iip1,l)=ugui2((j-1)*iip1+1,l)    
             enddo
-            if (pole_nord) then
+            if (pole_nord) THEN
               do i=1,iip1
                 ugui1(i,l)=0.
@@ -1323,5 +1323,5 @@
               enddo
             endif
-            if (pole_sud) then
+            if (pole_sud) THEN
               do i=1,iip1
                 ugui1(ip1jm+i,l)=0.
@@ -1403,6 +1403,6 @@
 ! Calcul des constantes de rappel alpha (=1/tau)
 
-    use comconst_mod, only: pi
-    use serre_mod, only: clat, clon, grossismx, grossismy
+    use comconst_mod, ONLY: pi
+    use serre_mod, ONLY: clat, clon, grossismx, grossismy
     
     IMPLICIT NONE
@@ -1431,5 +1431,5 @@
     real alphamin,alphamax,xi
     integer i,j,ilon,ilat
-    character(len=20),parameter :: modname="tau2alpha"
+    CHARACTER(LEN=20),parameter :: modname="tau2alpha"
 
 
@@ -1444,11 +1444,11 @@
             do j=jjb,jje
                 do i=1,pim
-                    if (typ==2) then
+                    if (typ==2) THEN
                        zlat=rlatu(j)*180./pi
                        zlon=rlonu(i)*180./pi
-                    elseif (typ==1) then
+                    elseif (typ==1) THEN
                        zlat=rlatu(j)*180./pi
                        zlon=rlonv(i)*180./pi
-                    elseif (typ==3) then
+                    elseif (typ==3) THEN
                        zlat=rlatv(j)*180./pi
                        zlon=rlonv(i)*180./pi
@@ -1519,20 +1519,20 @@
             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'
+            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'
+              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 
+              if (gamma4) THEN
                 gamma=min(gamma,4.)
               endif
-              write(*,*)trim(modname)//' gamma=',gamma
+              WRITE(*,*)trim(modname)//' gamma=',gamma
             endif
         ENDIF !first
@@ -1540,15 +1540,15 @@
         do j=jjb,jje
             do i=1,pim
-                if (typ==1) then
+                if (typ==1) THEN
                    dxdy_=dxdys(i,j)
                    zlat=rlatu(j)*180./pi
-                elseif (typ==2) then
+                elseif (typ==2) THEN
                    dxdy_=dxdyu(i,j)
                    zlat=rlatu(j)*180./pi
-                elseif (typ==3) then
+                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
+                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
@@ -1556,5 +1556,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
@@ -1596,10 +1596,10 @@
 ! Premier appel: initialisation de la lecture des fichiers
 ! -----------------------------------------------------------------
-    if (first) then
+    if (first) THEN
          ncidpl=-99
-         write(*,*) trim(modname)//': opening nudging files '
+         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'
+         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
@@ -1617,9 +1617,9 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
+             WRITE(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
          endif
          
 ! 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
@@ -1632,10 +1632,10 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
+             WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
              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
@@ -1648,5 +1648,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
+             WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
              if (ncidpl==-99) ncidpl=ncidu
 
@@ -1669,5 +1669,5 @@
 
 ! Vent meridien
-         if (guide_v) then
+         if (guide_v) THEN
              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
              IF (rcode/=nf90_noerr) THEN
@@ -1680,5 +1680,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
+             WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
              if (ncidpl==-99) ncidpl=ncidv
              
@@ -1702,5 +1702,5 @@
 
 ! Temperature
-         if (guide_T) then
+         if (guide_T) THEN
              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
              IF (rcode/=nf90_noerr) THEN
@@ -1713,5 +1713,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
+             WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
              if (ncidpl==-99) ncidpl=ncidt
 
@@ -1733,5 +1733,5 @@
 
 ! Humidite
-         if (guide_Q) then
+         if (guide_Q) THEN
              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
              IF (rcode/=nf90_noerr) THEN
@@ -1744,5 +1744,5 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
+             WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
              if (ncidpl==-99) ncidpl=ncidQ
 
@@ -1765,5 +1765,5 @@
          endif
 ! Pression de surface
-         if ((guide_P).OR.(guide_plevs==1)) then
+         if ((guide_P).OR.(guide_plevs==1)) THEN
              rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
              IF (rcode/=nf90_noerr) THEN
@@ -1776,11 +1776,11 @@
               CALL abort_gcm(modname,abort_message,1)
              ENDIF
-             write(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
+             WRITE(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
          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)
-              write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
+              WRITE(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
          endif
 ! Coefs ap, bp pour calcul de la pression aux differents niveaux
@@ -1814,5 +1814,5 @@
      IF (invert_y) start(2)=jjp1-jje_u+1
 ! Pression 
-     if (guide_plevs==2) then
+     if (guide_plevs==2) THEN
          status=nf90_put_var(ncidp,varidp,pnat2,start,count)
          IF (invert_y) THEN
@@ -1824,5 +1824,5 @@
 
 !  Vent zonal
-     if (guide_u) then
+     if (guide_u) THEN
          status=nf90_put_var(ncidu,varidu,unat2,start,count)
          IF (invert_y) THEN
@@ -1836,5 +1836,5 @@
 
 !  Temperature
-     if (guide_T) then
+     if (guide_T) THEN
          status=nf90_put_var(ncidt,varidt,tnat2,start,count)
          IF (invert_y) THEN
@@ -1846,5 +1846,5 @@
 
 !  Humidite
-     if (guide_Q) then
+     if (guide_Q) THEN
          status=nf90_put_var(ncidQ,varidQ,qnat2,start,count)
          IF (invert_y) THEN
@@ -1857,5 +1857,5 @@
 
 !  Vent meridien
-     if (guide_v) then
+     if (guide_v) THEN
          start(2)=jjb_v
          count(2)=jjnb_v
@@ -1871,5 +1871,5 @@
 
 !  Pression de surface
-     if ((guide_P).OR.(guide_plevs==1))  then
+     if ((guide_P).OR.(guide_plevs==1))  THEN
          start(2)=jjb_u
          start(3)=timestep
@@ -1918,10 +1918,10 @@
 ! Premier appel: initialisation de la lecture des fichiers
 ! -----------------------------------------------------------------
-    if (first) then
+    if (first) THEN
          ncidpl=-99
-         write(*,*)trim(modname)//' : opening nudging files '
+         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'
+         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
@@ -1939,8 +1939,8 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
+           WRITE(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
          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
@@ -1953,9 +1953,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
+           WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
            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
@@ -1968,10 +1968,10 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
+           WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
            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
@@ -1984,9 +1984,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
+           WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
            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
@@ -1999,9 +1999,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
+           WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
            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
@@ -2014,9 +2014,9 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
+           WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
            if (ncidpl==-99) ncidpl=ncidQ
          endif
 ! Pression de surface
-         if ((guide_P).OR.(guide_plevs==1)) then
+         if ((guide_P).OR.(guide_plevs==1)) THEN
            rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
            IF (rcode/=nf90_noerr) THEN
@@ -2029,14 +2029,14 @@
              CALL abort_gcm(modname,abort_message,1)
            ENDIF
-           write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
+           WRITE(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
          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)
-           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,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
+         if (guide_plevs==1) THEN
              status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc])
              status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
@@ -2066,5 +2066,5 @@
      IF (invert_y) start(2)=jjp1-jje_u+1
 !  Pression
-     if (guide_plevs==2) then
+     if (guide_plevs==2) THEN
          status=nf90_put_var(ncidp,varidp,zu,start,count)
          DO i=1,iip1
@@ -2079,5 +2079,5 @@
      endif
 !  Vent zonal
-     if (guide_u) then
+     if (guide_u) THEN
          status=nf90_put_var(ncidu,varidu,zu,start,count)
          DO i=1,iip1
@@ -2094,5 +2094,5 @@
 
 !  Temperature
-     if (guide_T) then
+     if (guide_T) THEN
          status=nf90_put_var(ncidt,varidt,zu,start,count)
          DO i=1,iip1
@@ -2108,5 +2108,5 @@
 
 !  Humidite
-     if (guide_Q) then
+     if (guide_Q) THEN
          status=nf90_put_var(ncidQ,varidQ,zu,start,count)
          DO i=1,iip1
@@ -2122,5 +2122,5 @@
 
 !  Vent meridien
-     if (guide_v) then
+     if (guide_v) THEN
          start(2)=jjb_v
          count(2)=jjnb_v
@@ -2140,5 +2140,5 @@
 
 !  Pression de surface
-     if ((guide_P).OR.(guide_plevs==1))  then
+     if ((guide_P).OR.(guide_plevs==1))  THEN
          start(2)=jjb_u
          start(3)=timestep
@@ -2168,5 +2168,5 @@
     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
@@ -2201,5 +2201,5 @@
 !$OMP BARRIER
 
-!    write(*,*)trim(modname)//' after allocation ',hsize,vsize
+!    WRITE(*,*)trim(modname)//' after allocation ',hsize,vsize
 
     IF (hsize==jjp1) THEN
@@ -2209,5 +2209,5 @@
     ENDIF
 
-!    write(*,*)trim(modname)//' after gather '
+!    WRITE(*,*)trim(modname)//' after gather '
     CALL Gather_field_u(alpha_u,zu,1)
     CALL Gather_field_u(alpha_t,zt,1)
@@ -2348,5 +2348,5 @@
     END SELECT
 
-!    if (varname=="ua") then
+!    if (varname=="ua") THEN
 !    CALL dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
 !    CALL dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
@@ -2374,5 +2374,5 @@
     do l=1,nl
         do i=2,iim-1
-            if(abs(x(i,l))>1.e10) then
+            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
@@ -2409,5 +2409,5 @@
     CALL barrier
 
-    if (mpi_rank==0) then
+    if (mpi_rank==0) THEN
        CALL dump2d(iip1,jjp1,var_glob,varname)
     endif
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90	(revision 5116)
@@ -7,6 +7,6 @@
   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
@@ -64,5 +64,5 @@
   INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
 
-  integer :: nid_relief,varid,ierr
+  INTEGER :: nid_relief,varid,ierr
   real, dimension(iip1,jjp1) :: relief
 
@@ -80,12 +80,12 @@
   LOGICAL,PARAMETER :: tnat1=.TRUE.
   
-  character(len=*),parameter :: modname="iniacademic"
-  character(len=80) :: abort_message
+  CHARACTER(LEN=*),parameter :: modname="iniacademic"
+  CHARACTER(LEN=80) :: abort_message
 
   ! Sanity check: verify that options selected by user are not incompatible
-  if ((iflag_phys==1).and. .not. read_start) then
-    write(lunout,*) trim(modname)," error: if read_start is set to ", &
+  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"
-    write(lunout,*) "You most likely want an aquaplanet initialisation", &
+    WRITE(lunout,*) "You most likely want an aquaplanet initialisation", &
     " (iflag_phys >= 100)"
     CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1)
@@ -114,5 +114,5 @@
   ang0       = 0.
 
-  if (llm == 1) then
+  if (llm == 1) THEN
      ! specific initializations for the shallow water case
      kappa=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,7 +181,7 @@
   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
@@ -190,5 +190,5 @@
   endif
 
-  academic_case: if (iflag_phys >= 2) then
+  academic_case: if (iflag_phys >= 2) THEN
      ! initializations
 
@@ -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
@@ -317,8 +317,8 @@
               iqParent = tracers(iq)%iqParent
               IF(tracers(iq)%iso_iZone == 0) THEN
-                 if (tnat1) then
+                 if (tnat1) THEN
                          tnat=1.0
                          alpha_ideal=1.0
-                         write(*,*) 'Attention dans iniacademic: alpha_ideal=1'
+                         WRITE(*,*) 'Attention dans iniacademic: alpha_ideal=1'
                  else
                     IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90	(revision 5116)
@@ -52,18 +52,18 @@
   !
   integer(kind=4) day0, anne0
-  real :: tstep, t_ops, t_wrt
+  REAL :: tstep, t_ops, t_wrt
 
   ! This routine needs IOIPSL
   !   Variables locales
   !
-  integer :: tau0
-  real :: zjulian
-  integer :: iq
-  real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
-  integer :: uhoriid, vhoriid, thoriid
-  integer :: zvertiid,zvertiidv,zvertiidu
-  integer :: ii,jj
-  integer :: zan, dayref
-  integer :: jjb,jje,jjn
+  INTEGER :: tau0
+  REAL :: zjulian
+  INTEGER :: iq
+  REAL :: rlong(iip1,jjp1), rlat(iip1,jjp1)
+  INTEGER :: uhoriid, vhoriid, thoriid
+  INTEGER :: zvertiid,zvertiidv,zvertiidu
+  INTEGER :: ii,jj
+  INTEGER :: zan, dayref
+  INTEGER :: jjb,jje,jjn
 
   ! definition du domaine d'ecriture pour le rebuild
@@ -278,3 +278,3 @@
   CALL histend(histuaveid)
   CALL histend(histvaveid)
-end subroutine initdynav_loc
+END SUBROUTINE initdynav_loc
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90	(revision 5116)
@@ -47,23 +47,23 @@
   !   Arguments
   !
-  character(len = *) :: infile
-  real :: tstep, t_ops, t_wrt
-  integer :: fileid, filevid, filedid
+  CHARACTER(LEN = *) :: infile
+  REAL :: tstep, t_ops, t_wrt
+  INTEGER :: fileid, filevid, filedid
 
   ! This routine needs IOIPSL
   !   Variables locales
   !
-  real :: nivd(1)
-  integer :: tau0
-  real :: zjulian
-  character(len = 3) :: str
-  character(len = 10) :: ctrac
-  integer :: iq
-  real :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1)
-  integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
-  integer :: ii, jj
-  integer :: zan, idayref
+  REAL :: nivd(1)
+  INTEGER :: tau0
+  REAL :: zjulian
+  CHARACTER(LEN = 3) :: str
+  CHARACTER(LEN = 10) :: ctrac
+  INTEGER :: iq
+  REAL :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1)
+  INTEGER :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
+  INTEGER :: ii, jj
+  INTEGER :: zan, idayref
   logical :: ok_sync
-  integer :: jjb, jje, jjn
+  INTEGER :: jjb, jje, jjn
 
   ! definition du domaine d'ecriture pour le rebuild
@@ -156,6 +156,5 @@
   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, &
@@ -191,5 +190,5 @@
           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', &
@@ -208,6 +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, &
@@ -272,5 +270,5 @@
   CALL histend(filevid)
   if (mpi_rank==0) CALL histend(filedid)
-  if (ok_sync) then
+  if (ok_sync) THEN
     CALL histsync(fileid)
     CALL histsync(filevid)
@@ -278,3 +276,3 @@
   endif
 
-end subroutine initfluxsto_p
+END SUBROUTINE initfluxsto_p
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90	(revision 5116)
@@ -48,19 +48,19 @@
   !   Arguments
   !
-  integer :: day0, anne0
-  real :: tstep, t_ops, t_wrt
+  INTEGER :: day0, anne0
+  REAL :: tstep, t_ops, t_wrt
 
   ! This routine needs IOIPSL
   !   Variables locales
   !
-  integer :: tau0
-  real :: zjulian
-  integer :: iq
-  real :: rlong(iip1, jjp1), rlat(iip1, jjp1)
-  integer :: uhoriid, vhoriid, thoriid
-  integer :: zvertiid, zvertiidv, zvertiidu
-  integer :: ii, jj
-  integer :: zan, dayref
-  integer :: jjb, jje, jjn
+  INTEGER :: tau0
+  REAL :: zjulian
+  INTEGER :: iq
+  REAL :: rlong(iip1, jjp1), rlat(iip1, jjp1)
+  INTEGER :: uhoriid, vhoriid, thoriid
+  INTEGER :: zvertiid, zvertiidv, zvertiidu
+  INTEGER :: ii, jj
+  INTEGER :: zan, dayref
+  INTEGER :: jjb, jje, jjn
 
   ! definition du domaine d'ecriture pour le rebuild
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90	(revision 5116)
@@ -86,5 +86,5 @@
   INTEGER :: ierr
 
-  !write(*,*) 'integrd 88: entree, nq=',nq
+  !WRITE(*,*) 'integrd 88: entree, nq=',nq
   !-----------------------------------------------------------------------
 
@@ -151,10 +151,10 @@
   ! &                   MPI_LOGICAL,MPI_LOR,COMM_LMDZ,ierr)
   IF( .NOT. checksum ) THEN
-     write(lunout,*) "integrd: ps = ", ps(stop_it)
-     write(lunout,*) " at node ij =", stop_it
+     WRITE(lunout,*) "integrd: ps = ", ps(stop_it)
+     WRITE(lunout,*) " at node ij =", stop_it
      ! since ij=j+(i-1)*jjp1 , we have
       j=modulo(stop_it,jjp1)
       i=1+(stop_it-j)/jjp1
-      write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg", &
+      WRITE(lunout,*) " lon = ",rlonv(i)*180./pi, " deg", &
             " lat = ",rlatu(j)*180./pi, " deg"
      CALL abort_gcm("integrd_loc", "negative surface pressure", 1)
@@ -163,5 +163,5 @@
 !$OMP END MASTER
 !$OMP BARRIER
-    !write(*,*) 'integrd 170'
+    !WRITE(*,*) 'integrd 170'
   IF (.NOT. Checksum_all) THEN
     CALL WriteField_v('int_vcov',vcov)
@@ -193,5 +193,5 @@
 
   !
-  !   !write(*,*) 'integrd 200'
+  !   !WRITE(*,*) 'integrd 200'
 !$OMP MASTER
   if (pole_nord) THEN
@@ -220,5 +220,5 @@
 !$OMP END MASTER
 !$OMP BARRIER
-  !write(*,*) 'integrd 217'
+  !WRITE(*,*) 'integrd 217'
   !
   !  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
@@ -284,5 +284,5 @@
   !
   !
-  !   !write(*,*) 'integrd 291'
+  !   !WRITE(*,*) 'integrd 291'
   IF (pole_nord) THEN
 
@@ -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
@@ -349,7 +349,7 @@
     CALL check_isotopes(q,ijb,ije,'integrd 342')
 
-    !write(*,*) 'integrd 341'
+    !WRITE(*,*) 'integrd 341'
     CALL qminimum_loc( q, nq, deltap )
-    !write(*,*) 'integrd 343'
+    !WRITE(*,*) 'integrd 343'
 
     CALL check_isotopes(q,ijb,ije,'integrd 346')
@@ -421,5 +421,5 @@
   ! .....   FIN  de l'integration  de   q    .......
 
-      !write(*,*) 'integrd 410'
+      !WRITE(*,*) 'integrd 410'
 
 !$OMP DO SCHEDULE(STATIC)
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rotgam_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rotgam_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rotgam_loc.f90	(revision 5116)
@@ -37,5 +37,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)
   DO l = 1, klevel
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90	(revision 5116)
@@ -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
@@ -93,5 +93,5 @@
   REAL, INTENT(IN) :: phis0(ijb_u:ije_u)        ! geopotentiat at the surface
 
-  real :: zqmin, zqmax
+  REAL :: zqmin, zqmax
 
   ! REAL,SAVE,ALLOCATABLE :: p (:,:  )               ! pression aux interfac.des couches
@@ -142,5 +142,5 @@
   INTEGER :: ik
 
-  real :: time_step, t_wrt, t_ops
+  REAL :: time_step, t_wrt, t_ops
 
   ! jD_cur: jour julien courant
@@ -154,5 +154,5 @@
 
   data callinigrads/.TRUE./
-  character(len = 10) :: string10
+  CHARACTER(LEN = 10) :: string10
 
   ! REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale
@@ -173,7 +173,7 @@
   !-jld
 
-  character(len = 80) :: dynhist_file, dynhistave_file
-  character(len = *), parameter :: modname = "leapfrog_loc"
-  character(len = 80) :: abort_message
+  CHARACTER(LEN = 80) :: dynhist_file, dynhistave_file
+  CHARACTER(LEN = *), parameter :: modname = "leapfrog_loc"
+  CHARACTER(LEN = 80) :: abort_message
 
   logical, PARAMETER :: dissip_conservative = .TRUE.
@@ -213,5 +213,5 @@
   lafin = .FALSE.
 
-  if (nday>=0) then
+  if (nday>=0) THEN
     itaufin = nday * day_step
   else
@@ -247,6 +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))
@@ -291,5 +290,5 @@
   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
@@ -310,5 +309,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.
@@ -317,5 +316,5 @@
   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
@@ -335,5 +334,5 @@
   !ym      CALL SCOPY( ip1jmp1, ps  , 1,   psm1 , 1 )
 
-  if (FirstCaldyn) then
+  if (FirstCaldyn) THEN
     !$OMP MASTER
     ucovm1 = ucov
@@ -399,5 +398,5 @@
   !$OMP MASTER
   ItCount = ItCount + 1
-  if (MOD(ItCount, 1)==1) then
+  if (MOD(ItCount, 1)==1) THEN
     debug = .TRUE.
   else
@@ -415,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.
@@ -448,5 +447,5 @@
   ! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
   ! supress dissipation step
-  if (llm==1) then
+  if (llm==1) THEN
     apdiss = .FALSE.
   endif
@@ -457,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)
@@ -479,15 +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
+    ! &         .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     ******'
@@ -627,5 +625,5 @@
   !$OMP BARRIER
 
-  if (debug) then
+  if (debug) THEN
     CALL WriteField_u('ucov', ucov)
     CALL WriteField_v('vcov', vcov)
@@ -699,5 +697,5 @@
   IF(forward .OR.  leapf)  THEN
     ! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
-    !write(*,*) 'leapfrog 679: avant CALL caladvtrac_loc'
+    !WRITE(*,*) 'leapfrog 679: avant CALL caladvtrac_loc'
     CALL caladvtrac_loc(q, pbaru, pbarv, &
             p, masse, dq, teta, &
@@ -709,5 +707,5 @@
     ENDIF
 
-    !write(*,*) 'leapfrog 719'
+    !WRITE(*,*) 'leapfrog 719'
     CALL check_isotopes(q, ijb_u, ije_u, &
             'leapfrog 698: apres caladvtrac')
@@ -730,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)
@@ -744,5 +742,5 @@
   ! CALL FTRACE_REGION_BEGIN("integrd")
 
-  !write(*,*) 'leapfrog 720'
+  !WRITE(*,*) 'leapfrog 720'
   CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 756')
 
@@ -752,5 +750,5 @@
   ! $              finvmaold                                    )
 
-  !  !write(*,*) 'leapfrog 724'
+  !  !WRITE(*,*) 'leapfrog 724'
   CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 762')
 
@@ -804,5 +802,5 @@
     ! c-jld
     !$OMP MASTER
-    if (FirstPhysic) then
+    if (FirstPhysic) THEN
       ok_start_timer = .TRUE.
       FirstPhysic = .FALSE.
@@ -812,9 +810,9 @@
 
   CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1132')
-  !write(*,*) 'leapfrog 1134: iflag_phys=',iflag_phys
+  !WRITE(*,*) 'leapfrog 1134: iflag_phys=',iflag_phys
 
   IF(iflag_phys==2) THEN ! "Newtonian" case
     !$OMP MASTER
-    if (FirstPhysic) then
+    if (FirstPhysic) THEN
       ok_start_timer = .TRUE.
       FirstPhysic = .FALSE.
@@ -840,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) &
@@ -866,5 +864,5 @@
   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
@@ -895,10 +893,9 @@
   CALL stop_timer(timer_caldyn)
   !$OMP END MASTER
-  IF (itau==itaumax) then
+  IF (itau==itaumax) THEN
     !$OMP MASTER
     CALL allgather_timer_average
     CALL barrier
-    if (mpi_rank==0) then
-
+    if (mpi_rank==0) THEN
       print *, '*********************************'
       print *, '******    TIMER CALDYN     ******'
@@ -947,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
@@ -990,12 +987,11 @@
     ENDIF
 
-    IF(itau == itaufinp1) then
-
-      if (flag_verif) then
-        write(79, *) 'ucov', ucov
-        write(80, *) 'vcov', vcov
-        write(81, *) 'teta', teta
-        write(82, *) 'ps', ps
-        write(83, *) 'q', q
+    IF(itau == itaufinp1) THEN
+      if (flag_verif) THEN
+        WRITE(79, *) 'ucov', ucov
+        WRITE(80, *) 'vcov', vcov
+        WRITE(81, *) 'teta', teta
+        WRITE(82, *) 'ps', ps
+        WRITE(83, *) 'q', q
         WRITE(85, *) 'q1 = ', q(:, :, 1)
         WRITE(86, *) 'q3 = ', q(:, :, 3)
@@ -1068,6 +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
@@ -1076,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)
@@ -1098,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
+      if (ok_guide) THEN
         ! set ok_guide to false to avoid extra output
         ! in following forward step
@@ -1165,5 +1160,5 @@
 
       forward = .FALSE.
-      IF(itau == itaufinp1) then
+      IF(itau == itaufinp1) THEN
         !$OMP MASTER
         CALL fin_getparam
@@ -1231,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)
@@ -1248,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
+        if (ok_guide) THEN
           ! set ok_guide to false to avoid extra output
           ! in following forward step
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90	(revision 5116)
@@ -71,6 +71,6 @@
           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
@@ -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.
@@ -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
@@ -384,5 +384,5 @@
       ztit = 'bil phys'
       !      CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
-      write(lunout, *)"call_calfis: diagedyn disabled in dyn3dmem !!"
+      WRITE(lunout, *)"call_calfis: diagedyn disabled in dyn3dmem !!"
     ENDIF
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90	(revision 5116)
@@ -18,5 +18,5 @@
     USE mod_prism
 #endif
-    USE wxios, only: wxios_init, using_xios
+    USE 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 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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90	(revision 5116)
@@ -20,18 +20,18 @@
   type Hallo
     real, dimension(:,:),pointer :: Field
-    integer :: offset
-    integer :: size
-    integer :: NbLevel
-    integer :: Stride
+    INTEGER :: offset
+    INTEGER :: size
+    INTEGER :: NbLevel
+    INTEGER :: Stride
   end type Hallo
   
   type request_SR
-    integer :: NbRequest=0
-    integer :: NbRequestMax=0
-    integer :: BufferSize
-    integer :: Pos
-    integer :: Index 
+    INTEGER :: NbRequest=0
+    INTEGER :: NbRequestMax=0
+    INTEGER :: BufferSize
+    INTEGER :: Pos
+    INTEGER :: Index
     type(Hallo), POINTER :: Hallo(:)
-    integer :: MSG_Request
+    INTEGER :: MSG_Request
   end type request_SR
 
@@ -39,5 +39,5 @@
     type(request_SR),dimension(0:MaxProc-1) :: RequestSend
     type(request_SR),dimension(0:MaxProc-1) :: RequestRecv
-    integer :: tag=1
+    INTEGER :: tag=1
   end type request
   
@@ -71,5 +71,5 @@
   USE IOIPSL
     IMPLICIT NONE
-    integer :: jj_nb_gather(0:mpi_size-1)
+    INTEGER :: jj_nb_gather(0:mpi_size-1)
     
     Index_Pos=1
@@ -139,15 +139,15 @@
   SUBROUTINE allocate_buffer(Size,Index,Pos)
   IMPLICIT NONE
-    integer :: Size
-    integer :: Index
-    integer :: Pos
+    INTEGER :: Size
+    INTEGER :: Index
+    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) 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)
@@ -163,5 +163,5 @@
   SUBROUTINE deallocate_buffer(Index)
   IMPLICIT NONE
-    integer :: Index
+    INTEGER :: Index
     
     Buffer_Pos(Index)=-1
@@ -176,5 +176,5 @@
   IMPLICIT NONE
     type(request):: a_request
-    integer :: tag
+    INTEGER :: tag
     
     a_request%tag=tag
@@ -183,8 +183,8 @@
   
   SUBROUTINE New_Hallo(Field,Stride,NbLevel,offset,size,Ptr_request)
-    integer :: Stride
-    integer :: NbLevel
-    integer :: size
-    integer :: offset
+    INTEGER :: Stride
+    INTEGER :: NbLevel
+    INTEGER :: size
+    INTEGER :: offset
     real, dimension(Stride,NbLevel),target :: Field
     type(request_SR),pointer :: Ptr_request
@@ -259,5 +259,5 @@
     integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
-    integer ::i,jje,jjb
+    INTEGER ::i,jje,jjb
     
     jj_begin_New(0)=1
@@ -269,5 +269,5 @@
     
     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)
@@ -275,5 +275,5 @@
         if (ij==ip1jm .and. jje==jjp1) jje=jjm
         
-        if (jje >= jjb) then
+        if (jje >= jjb) THEN
           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -284,5 +284,5 @@
         if (ij==ip1jm .and. jje==jjp1) jje=jjm
         
-        if (jje >= jjb) then
+        if (jje >= jjb) THEN
           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -307,5 +307,5 @@
     integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
-    integer ::i,jje,jjb
+    INTEGER ::i,jje,jjb
     
     jj_begin_New(0)=1
@@ -322,5 +322,5 @@
    
     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)
@@ -328,5 +328,5 @@
         if (ij==ip1jm .and. jje==jjp1) jje=jjm
         
-        if (jje >= jjb) then
+        if (jje >= jjb) THEN
           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -337,5 +337,5 @@
         if (ij==ip1jm .and. jje==jjp1) jje=jjm
         
-        if (jje >= jjb) then
+        if (jje >= jjb) THEN
           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -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
@@ -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
@@ -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
@@ -1346,9 +1346,9 @@
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
-      integer :: SizeBuffer
-      integer :: i,rank,l,ij,Pos,ierr
-      integer :: offset
+      INTEGER :: SizeBuffer
+      INTEGER :: i,rank,l,ij,Pos,ierr
+      INTEGER :: offset
       real,dimension(:,:),pointer :: Field
-      integer :: Nb
+      INTEGER :: Nb
        
       do rank=0,MPI_SIZE-1
@@ -1367,6 +1367,5 @@
       
          Req%BufferSize=SizeBuffer
-         if (Req%NbRequest>0) then
-       
+         if (Req%NbRequest>0) THEN
           CALL allocate_buffer(SizeBuffer,Req%Index,Req%pos)
 
@@ -1390,5 +1389,5 @@
           enddo
     
-         if (SizeBuffer>0) then
+         if (SizeBuffer>0) THEN
 !$OMP CRITICAL (MPI)
          
@@ -1427,9 +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)
 
@@ -1466,8 +1464,8 @@
       integer, dimension(2*mpi_size) :: TabRequest
       integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
-      integer :: NbRequest
-      integer :: i,rank,pos,ij,l,ierr
-      integer :: offset
-      integer :: Nb
+      INTEGER :: NbRequest
+      INTEGER :: i,rank,pos,ij,l,ierr
+      INTEGER :: offset
+      INTEGER :: Nb
       
       
@@ -1475,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
@@ -1483,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
@@ -1489,5 +1487,5 @@
       enddo
      
-      if (NbRequest>0) then
+      if (NbRequest>0) THEN
 !$OMP CRITICAL (MPI)
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1501,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
@@ -1524,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 
@@ -1532,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 
@@ -1551,7 +1549,7 @@
       integer, dimension(mpi_size) :: TabRequest
       integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
-      integer :: NbRequest
-      integer :: i,rank,pos,ij,l,ierr
-      integer :: offset
+      INTEGER :: NbRequest
+      INTEGER :: i,rank,pos,ij,l,ierr
+      INTEGER :: offset
       
       
@@ -1559,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
@@ -1580,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 
@@ -1598,7 +1596,7 @@
       integer, dimension(mpi_size) :: TabRequest
       integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
-      integer :: NbRequest
-      integer :: i,rank,pos,ij,l,ierr
-      integer :: offset,Nb
+      INTEGER :: NbRequest
+      INTEGER :: i,rank,pos,ij,l,ierr
+      INTEGER :: offset,Nb
       
       
@@ -1607,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
@@ -1614,5 +1612,5 @@
      
       
-      if (NbRequest>0) then
+      if (NbRequest>0) THEN
 !$OMP CRITICAL (MPI)     
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1627,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
@@ -1649,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 
@@ -1671,5 +1669,5 @@
     integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
-    integer ::i,jje,jjb,ijb,ije
+    INTEGER ::i,jje,jjb,ijb,ije
     
     jj_begin_New(0)=1
@@ -1684,5 +1682,5 @@
     if (ij==ip1jm) jje=min(jje,jjm)
 
-    if (jje >= jjb) then
+    if (jje >= jjb) THEN
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
@@ -1709,5 +1707,5 @@
     integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
 
-    integer ::i,jje,jjb,ijb,ije,l
+    INTEGER ::i,jje,jjb,ijb,ije,l
 
      
@@ -1725,5 +1723,5 @@
     
     
-    if (jje >= jjb) then
+    if (jje >= jjb) THEN
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
@@ -1741,7 +1739,7 @@
    USE dimensions_mod
    IMPLICIT NONE
-     integer :: ll
-     real :: field_loc(ijb_u:ije_u,ll)
-     real :: field_glo(ip1jmp1,ll)
+     INTEGER :: ll
+     REAL :: field_loc(ijb_u:ije_u,ll)
+     REAL :: field_glo(ip1jmp1,ll)
      type(request) :: request_gather
      integer       :: l
@@ -1764,9 +1762,9 @@
    USE dimensions_mod
    IMPLICIT NONE
-     integer :: ll
-     real :: field_loc(ijb_v:ije_v,ll)
-     real :: field_glo(ip1jm,ll)
+     INTEGER :: ll
+     REAL :: field_loc(ijb_v:ije_v,ll)
+     REAL :: field_glo(ip1jm,ll)
      type(request) :: request_gather
-     integer :: ijb,ije
+     INTEGER :: ijb,ije
      integer       :: l
      
@@ -1792,7 +1790,7 @@
    USE dimensions_mod
    IMPLICIT NONE
-     integer :: ll
-     real :: field_glo(ip1jmp1,ll)
-     real :: field_loc(ijb_u:ije_u,ll)
+     INTEGER :: ll
+     REAL :: field_glo(ip1jmp1,ll)
+     REAL :: field_loc(ijb_u:ije_u,ll)
      type(request) :: request_gather
      TYPE(distrib) :: distrib_swap
@@ -1826,7 +1824,7 @@
    USE dimensions_mod
    IMPLICIT NONE
-     integer :: ll
-     real :: field_glo(ip1jmp1,ll)
-     real :: field_loc(ijb_v:ije_v,ll)
+     INTEGER :: ll
+     REAL :: field_glo(ip1jmp1,ll)
+     REAL :: field_loc(ijb_v:ije_v,ll)
      type(request) :: request_gather
      TYPE(distrib) :: distrib_swap
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90	(revision 5116)
@@ -20,5 +20,5 @@
   REAL :: x( ijb_u:ije_u,klevel ),y(ijb_v:ije_v,klevel )
   INTEGER :: l,ij
-  integer :: ismin,ismax
+  INTEGER :: ismin,ismax
   external ismin,ismax
   INTEGER :: ijb,ije
@@ -29,5 +29,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
@@ -45,6 +45,6 @@
   ijb=ij_begin
   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
@@ -52,5 +52,5 @@
   END DO
 
-  if (pole_nord) then
+  if (pole_nord) THEN
     DO  ij = 1,iip1
      x(    ij    ,l ) = 0.
@@ -58,5 +58,5 @@
   endif
 
-  if (pole_sud) then
+  if (pole_sud) THEN
     DO  ij = 1,iip1
      x( ij +ip1jm,l ) = 0.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90	(revision 5116)
@@ -51,5 +51,5 @@
   END DO
 
-  if (pole_nord) then
+  if (pole_nord) THEN
     DO ij = 1,iip1
       x(    ij    ,l ) = 0.
@@ -57,5 +57,5 @@
   endif
 
-  if (pole_sud) then
+  if (pole_sud) THEN
     DO ij = 1,iip1
       x( ij +ip1jm,l ) = 0.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90	(revision 5116)
@@ -66,5 +66,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)
@@ -127,10 +127,10 @@
   DO    l = 1, klevel
 
-     if(pole_sud) ije=ij_end-iip1
+     IF(pole_sud) ije=ij_end-iip1
      DO  ij = ijb, ije
       gry_out( ij,l ) = gry( ij,l ) * nugradrs
      ENDDO
 
-     if(pole_sud) ije=ij_end
+     IF(pole_sud) ije=ij_end
      DO  ij = ijb, ije
       grx_out( ij,l ) = grx( ij,l ) * nugradrs
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90	(revision 5116)
@@ -47,9 +47,9 @@
 
     TYPE distrib
-      integer :: jj_begin
-      integer :: jj_end
-      integer :: jj_nb
-      integer :: ij_begin
-      integer :: ij_end
+      INTEGER :: jj_begin
+      INTEGER :: jj_end
+      INTEGER :: jj_nb
+      INTEGER :: ij_begin
+      INTEGER :: ij_end
 
       integer  :: jjb_u
@@ -89,11 +89,11 @@
       INCLUDE "iniprint.h"
 
-      integer :: ierr
-      integer :: i,j
-      integer :: type_size
+      INTEGER :: ierr
+      INTEGER :: i,j
+      INTEGER :: type_size
       integer, dimension(3) :: blocklen,type
-      integer :: comp_id
-      character(len=4)  :: num
-      character(len=20) :: filename
+      INTEGER :: comp_id
+      CHARACTER(LEN=4)  :: num
+      CHARACTER(LEN=20) :: filename
  
 #ifdef CPP_OMP    
@@ -140,8 +140,7 @@
         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"
+        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"
           
           IF (using_mpi) CALL MPI_ABORT(COMM_LMDZ,-1, ierr)
@@ -173,5 +172,5 @@
       ij_end=jj_end*iip1
       
-      if (mpi_rank==0) then
+      if (mpi_rank==0) THEN
         pole_nord=.TRUE.
       else 
@@ -179,5 +178,5 @@
       endif
       
-      if (mpi_rank==mpi_size-1) then
+      if (mpi_rank==mpi_size-1) THEN
         pole_sud=.TRUE.
       else 
@@ -185,8 +184,8 @@
       endif
         
-      write(lunout,*)"init_parallel: jj_begin",jj_begin
-      write(lunout,*)"init_parallel: jj_end",jj_end
-      write(lunout,*)"init_parallel: ij_begin",ij_begin
-      write(lunout,*)"init_parallel: ij_end",ij_end
+      WRITE(lunout,*)"init_parallel: jj_begin",jj_begin
+      WRITE(lunout,*)"init_parallel: jj_end",jj_end
+      WRITE(lunout,*)"init_parallel: ij_begin",ij_begin
+      WRITE(lunout,*)"init_parallel: ij_end",ij_end
       jjb_u=MAX(jj_begin-halo_max,1)
       jje_u=MIN(jj_end+halo_max,jjp1)
@@ -395,5 +394,5 @@
       IMPLICIT NONE
 ! without the surface_data module, we declare (and set) a dummy 'type_ocean'
-      character(len=6),parameter :: type_ocean="dummy"
+      CHARACTER(LEN=6),parameter :: type_ocean="dummy"
 #endif
 
@@ -401,6 +400,6 @@
       include "paramet.h"
 
-      integer :: ierr
-      integer :: i
+      INTEGER :: ierr
+      INTEGER :: i
 
       if (allocated(jj_begin_para)) deallocate(jj_begin_para)
@@ -408,5 +407,5 @@
       if (allocated(jj_nb_para))    deallocate(jj_nb_para)
 
-      if (type_ocean == 'couple') then
+      if (type_ocean == 'couple') THEN
 #ifdef CPP_COUPLE
         IF (using_xios) THEN
@@ -446,6 +445,6 @@
       real,dimension(ll*iip1*row), intent(out) :: Buffer 
             
-      integer :: Pos
-      integer :: i,l
+      INTEGER :: Pos
+      INTEGER :: i,l
       
       Pos=0
@@ -469,6 +468,6 @@
       real,dimension(ll*iip1*row), intent(in) :: Buffer 
             
-      integer :: Pos
-      integer :: i,l
+      INTEGER :: Pos
+      INTEGER :: i,l
       
       Pos=0
@@ -538,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.
@@ -630,16 +629,16 @@
       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)
         else
-           write(lunout,*)ij  
+           WRITE(lunout,*)ij
         CALL abort_gcm("parallel_lmdz","erreur dans Gather_Field",1)
         endif
         
-        if (MPI_Rank==rank) then
+        if (MPI_Rank==rank) THEN
           allocate(Buffer_Recv(ij*ll))
 
@@ -647,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
@@ -655,5 +654,5 @@
             endif
                    
-            if (i==0) then 
+            if (i==0) THEN
               displ(i)=0 
             else
@@ -675,12 +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,                       &
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90	(revision 5116)
@@ -37,6 +37,6 @@
   REAL :: zx_defau, zx_abc, zx_pump(ijb_u:ije_u), pompe
 
-  real :: zx_defau_diag(ijb_u:ije_u,llm,2)
-  real :: q_follow(ijb_u:ije_u,llm,2)
+  REAL :: zx_defau_diag(ijb_u:ije_u,llm,2)
+  REAL :: q_follow(ijb_u:ije_u,llm,2)
   !
   REAL :: SSUM
@@ -55,5 +55,5 @@
 !$OMP BARRIER
 
-  !write(lunout,*) 'qminimum 52: entree'
+  !WRITE(lunout,*) 'qminimum 52: entree'
   IF(first) THEN
      iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
@@ -83,10 +83,9 @@
   ENDDO
 
-  !write(lunout,*) 'qminimum 57'
+  !WRITE(lunout,*) 'qminimum 57'
   DO k = 1, llm
 !$OMP DO SCHEDULE(STATIC)
     DO i = ijb, ije
-      if (seuil_liq - q(i,k,iq_liq) > 0.d0 ) then
-
+      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 )
@@ -103,5 +102,5 @@
   ! le defaut en prennant de l'eau vapeur de la couche au-dessous.
   !
-  !write(lunout,*) 'qminimum 81'
+  !WRITE(lunout,*) 'qminimum 81'
   DO k = llm, 2, -1
   !cc      zx_abc = dpres(k) / dpres(k-1)
@@ -109,6 +108,5 @@
     DO i = ijb, ije
 
-      if ( seuil_vap - q(i,k,iq_vap) > 0.d0 ) then
-
+      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 )
@@ -127,5 +125,5 @@
   ! doit imprimer un message d'avertissement (saturation possible).
   !
-  !write(lunout,*) 'qminimum 106'
+  !WRITE(lunout,*) 'qminimum 106'
   nb_pump=0
 !$OMP DO SCHEDULE(STATIC)
@@ -149,7 +147,7 @@
   ENDIF
 
-  !write(lunout,*) 'qminimum 128'
-  if (niso > 0) then
-          !write(lunout,*) 'qminimum 140'
+  !WRITE(lunout,*) 'qminimum 128'
+  if (niso > 0) THEN
+          !WRITE(lunout,*) 'qminimum 140'
   ! CRisi: traiter de même les traceurs d'eau
   ! Mais il faut les prendre à l'envers pour essayer de conserver la
@@ -166,34 +164,34 @@
 !$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
+    endif !if (zx_pump(i).gt.0.0) THEN
   enddo !DO i = ijb, ije
 !$OMP END DO NOWAIT
 
   ! 2) transfert de vap vers les couches plus hautes
-  !write(lunout,*) 'qminimum 158'
+  !WRITE(lunout,*) 'qminimum 158'
   do k=2,llm
 !$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)=',
+          !  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
-            write(lunout,*) 'tmp qmin: on stoppe'
-            write(lunout,*) 'zx_pump(i)=',zx_pump(i)
-            write(lunout,*) 'q_follow(i,:,ivap)=', &
+          if (q_follow(i,k-1,1)<min_qParent) THEN
+            WRITE(lunout,*) 'tmp qmin: on stoppe'
+            WRITE(lunout,*) 'zx_pump(i)=',zx_pump(i)
+            WRITE(lunout,*) 'q_follow(i,:,ivap)=', &
                   q_follow(i,:,1)
-            write(lunout,*) 'k=',k
+            WRITE(lunout,*) 'k=',k
             CALL abort_gcm("qminimum","not enough vapor",1)
           endif
         do ixt=1,ntiso
-             ! write(lunout,*) 'qmin 168: ixt=',ixt
-             ! write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
+             ! WRITE(lunout,*) 'qmin 168: ixt=',ixt
+             ! WRITE(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
   ! :             q(i,k,iqIsoPha(ixt,iq_vap))
-  !            write(lunout,*) 'zx_defau_diag(i,k,ivap)=',
+  !            WRITE(lunout,*) 'zx_defau_diag(i,k,ivap)=',
   ! :                  zx_defau_diag(i,k,1)
-  !            write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
+  !            WRITE(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
   ! :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
 
@@ -202,15 +200,15 @@
                  *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
 
-          if (isoCheck) then
-            if(iso_verif_noNaN_nostop(q(i,k,iqIsoPha(ixt,iq_vap)), &
-                  'qminimum 155')==1) then
-               write(*,*) 'i,k,ixt=',i,k,ixt
-               write(*,*) 'q_follow(i,k-1,ivap)=', &
+          if (isoCheck) THEN
+            IF(iso_verif_noNaN_nostop(q(i,k,iqIsoPha(ixt,iq_vap)), &
+                  'qminimum 155')==1) THEN
+               WRITE(*,*) 'i,k,ixt=',i,k,ixt
+               WRITE(*,*) 'q_follow(i,k-1,ivap)=', &
                      q_follow(i,k-1,1)
-               write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=', &
+               WRITE(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=', &
                      q(i,k,iqIsoPha(ixt,iq_vap))
-               write(*,*) 'zx_defau_diag(i,k,ivap)=', &
+               WRITE(*,*) 'zx_defau_diag(i,k,ivap)=', &
                      zx_defau_diag(i,k,1)
-               write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=', &
+               WRITE(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=', &
                      q(i,k-1,iqIsoPha(ixt,iq_vap))
             CALL abort_gcm("qminimum_loc","stopped",1)
@@ -226,16 +224,16 @@
                  /q_follow(i,k-1,1)
 
-           if (isoCheck) then
+           if (isoCheck) THEN
             if (iso_verif_noNaN_nostop( &
                   q(i,k-1,iqIsoPha(ixt,iq_vap)), &
-                  'qminimum 175')==1) then
-               write(*,*) 'k,i,ixt=',k,i,ixt
-               write(*,*) 'q_follow(i,k-1,ivap)=', &
+                  'qminimum 175')==1) THEN
+               WRITE(*,*) 'k,i,ixt=',k,i,ixt
+               WRITE(*,*) 'q_follow(i,k-1,ivap)=', &
                      q_follow(i,k-1,1)
-               write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=', &
+               WRITE(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=', &
                      q(i,k,iqIsoPha(ixt,iq_vap))
-               write(*,*) 'zx_defau_diag(i,k,ivap)=', &
+               WRITE(*,*) 'zx_defau_diag(i,k,ivap)=', &
                      zx_defau_diag(i,k,1)
-               write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=', &
+               WRITE(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=', &
                      q(i,k-1,iqIsoPha(ixt,iq_vap))
                CALL abort_gcm("qminimum_loc","stopped",1)
@@ -249,5 +247,5 @@
                 -zx_defau_diag(i,k,1) &
                 *deltap(i,k)/deltap(i,k-1)
-      endif !if (zx_defau_diag(i,k,1).gt.0.0) then
+      endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
     enddo !DO i = 1, ip1jmp1
 !$OMP END DO NOWAIT
@@ -258,10 +256,9 @@
 
     ! 3) transfert d'eau de la vapeur au liquide
-    !write(*,*) 'qminimum 164'
+    !WRITE(*,*) 'qminimum 164'
     do k=1,llm
 !$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
@@ -278,5 +275,5 @@
           q_follow(i,k,1)=   q_follow(i,k,1) &
                 -zx_defau_diag(i,k,2)
-      endif !if (zx_defau_diag(i,k,1).gt.0.0) then
+      endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
     enddo !DO i = ijb, ije
 !$OMP END DO NOWAIT
@@ -285,6 +282,6 @@
    CALL check_isotopes(q,ijb,ije,'qminimum 197')
 
-  endif !if (niso > 0) then
-  !write(*,*) 'qminimum 188'
+  endif !if (niso > 0) THEN
+  !WRITE(*,*) 'qminimum 188'
 !$OMP BARRIER
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_nfil_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_nfil_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_nfil_loc.f90	(revision 5116)
@@ -31,5 +31,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)
   DO  l = 1,klevel
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_p.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_p.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_p.f90	(revision 5116)
@@ -31,5 +31,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/rotatf_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90	(revision 5116)
@@ -32,5 +32,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/sw_case_williamson91_6_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90	(revision 5116)
@@ -116,5 +116,5 @@
         enddo
      enddo
-      ! write(lunout,*) 'W91 ps', MAXVAL(ps), MINVAL(ps)
+      ! WRITE(lunout,*) 'W91 ps', MAXVAL(ps), MINVAL(ps)
   ! vitesse zonale ucov
      do j=1,jjp1
@@ -130,5 +130,5 @@
         enddo
      enddo
-      ! write(lunout,*) 'W91 u', MAXVAL(ucov(:,1)), MINVAL(ucov(:,1))
+      ! WRITE(lunout,*) 'W91 u', MAXVAL(ucov(:,1)), MINVAL(ucov(:,1))
      ucov_glo(:,1)=ucov_glo(:,1)*cu
   ! vitesse meridienne vcov
@@ -143,5 +143,5 @@
         enddo
      enddo
-     write(lunout,*) 'W91 v', MAXVAL(vcov(:,1)), MINVAL(vcov(:,1))
+     WRITE(lunout,*) 'W91 v', MAXVAL(vcov(:,1)), MINVAL(vcov(:,1))
      vcov_glo(:,1)=vcov_glo(:,1)*cv
 
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90	(revision 5116)
@@ -13,5 +13,5 @@
   integer, parameter :: suspended = 3 
   
-  integer :: max_size
+  INTEGER :: max_size
   real,    allocatable, dimension(:,:,:) :: timer_table
   real,    allocatable, dimension(:,:,:) :: timer_table_sqr 
@@ -50,9 +50,8 @@
   SUBROUTINE start_timer(no_timer)
     IMPLICIT NONE
-    integer :: no_timer
-    
-    if (AllTimer_IsActive) then
-    
-      if (timer_state(no_timer)/=stopped) then
+    INTEGER :: no_timer
+    
+    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
@@ -69,8 +68,8 @@
   SUBROUTINE suspend_timer(no_timer)
     IMPLICIT NONE
-    integer :: no_timer
+    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
@@ -86,8 +85,8 @@
   SUBROUTINE resume_timer(no_timer)
     IMPLICIT NONE
-    integer :: no_timer
+    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
@@ -103,11 +102,10 @@
     USE parallel_lmdz
     IMPLICIT NONE
-    integer :: no_timer
-    integer :: N
-    real :: V,V2
-    
-    if (AllTimer_IsActive) then
-       
-      if (timer_state(no_timer)/=running) then
+    INTEGER :: no_timer
+    INTEGER :: N
+    REAL :: V,V2
+    
+    if (AllTimer_IsActive) THEN
+      if (timer_state(no_timer)/=running) THEN
         CALL abort_gcm("times","stop_timer :: timer is not running",1)
       else
@@ -123,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,13 +138,11 @@
     IMPLICIT NONE
 
-    integer :: ierr
-    integer :: data_size
+    INTEGER :: ierr
+    INTEGER :: data_size
     real, allocatable,dimension(:,:) :: tmp_table
 
     IF (using_mpi) THEN    
    
-      if (AllTimer_IsActive) then
-    
-    
+      if (AllTimer_IsActive) THEN
       allocate(tmp_table(max_size,nb_timer))
     
@@ -169,14 +165,13 @@
     USE lmdz_mpi
     IMPLICIT NONE
-    integer :: ierr
-    integer :: data_size
+    INTEGER :: ierr
+    INTEGER :: data_size
     real, allocatable,dimension(:,:),target :: tmp_table
     integer, allocatable,dimension(:,:),target :: tmp_iter
-    integer :: istats
+    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))
@@ -199,8 +194,8 @@
   SUBROUTINE InitTime
   IMPLICIT NONE
-    integer :: count,count_rate,count_max
+    INTEGER :: count,count_rate,count_max
     
     AllTimer_IsActive=.TRUE.
-    if (AllTimer_IsActive) then
+    if (AllTimer_IsActive) THEN
       CALL system_clock(count,count_rate,count_max)
       CALL cpu_time(Last_cpuCount)
@@ -212,8 +207,8 @@
   IMPLICIT NONE
     double precision :: DiffTime
-    integer :: count,count_rate,count_max
+    INTEGER :: count,count_rate,count_max
   
     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
@@ -221,15 +216,15 @@
     endif
     Last_Count=Count 
-  end function DiffTime
+  END FUNCTION DiffTime
   
   function DiffCpuTime()
   IMPLICIT NONE
-    real :: DiffCpuTime
-    real :: Count
+    REAL :: DiffCpuTime
+    REAL :: Count
     
     CALL cpu_time(Count)
     DiffCpuTime=Count-Last_cpuCount
     Last_cpuCount=Count 
-  end function DiffCpuTime
+  END FUNCTION DiffCpuTime
 
 end module times
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90	(revision 5116)
@@ -76,5 +76,5 @@
   REAL :: tzon(jjb_u:jje_u,llm)
 
-  integer :: i
+  INTEGER :: i
   REAL,SAVE :: rdamp(llm)
   real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
@@ -85,8 +85,8 @@
   if (iflag_top_bound == 0) return
 
-  if (first) then
+  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
@@ -106,10 +106,10 @@
      rdamp(:)=1.-exp(-lambda(:)*dt)
 
-     write(lunout,*)'TOP_BOUND mode',mode_top_bound
-     write(lunout,*)'Sponge layer coefficients'
-     write(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
+     WRITE(lunout,*)'TOP_BOUND mode',mode_top_bound
+     WRITE(lunout,*)'Sponge layer coefficients'
+     WRITE(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
      do l=1,llm
-       if (rdamp(l)/=0.) then
-         write(lunout,'(6(1pe12.4,1x))') &
+       if (rdamp(l)/=0.) THEN
+         WRITE(lunout,'(6(1pe12.4,1x))') &
                presnivs(l),log(preff/presnivs(l))*scaleheight, &
                1./lambda(l),lambda(l)
@@ -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
@@ -153,5 +153,5 @@
 
   ! 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
@@ -180,5 +180,5 @@
 
   ! 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
@@ -200,5 +200,5 @@
   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:
    jjb=jj_begin
@@ -235,5 +235,5 @@
   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:
    jjb=jj_begin
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90	(revision 5116)
@@ -53,5 +53,5 @@
   INTEGER :: ijb, ije, ijb_x, ije_x
 
-  !write(*,*) 'vlsplt 58: entree dans vlx_loc, iq,ijb_x=',
+  !WRITE(*,*) 'vlsplt 58: entree dans vlx_loc, iq,ijb_x=',
   ! &   iq,ijb_x
   !   calcul de la pente a droite et a gauche de la maille
@@ -145,5 +145,5 @@
   ENDIF ! (pente_max.lt.-1.e-5)
 
-  !write(*,*) 'vlx 156: iq,ijb_x=',iq,ijb_x
+  !WRITE(*,*) 'vlx 156: iq,ijb_x=',iq,ijb_x
 
   !   bouclage de la pente en iip1:
@@ -418,5 +418,5 @@
 
   REAL :: convpn, convps, convmpn, convmps
-  real :: massepn, masseps, qpn, qps
+  REAL :: massepn, masseps, qpn, qps
   REAL :: sinlon(iip1), sinlondlon(iip1)
   REAL :: coslon(iip1), coslondlon(iip1)
@@ -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)
@@ -691,5 +691,5 @@
   ! CRisi: appel récursif de l'advection sur les fils.
   ! Il faut faire ça avant d'avoir mis à jour q et masse
-  ! write(*,*)'vly 689: iq,nqChildren(iq)=',iq,tracers(iq)%nqChildren
+  ! WRITE(*,*)'vly 689: iq,nqChildren(iq)=',iq,tracers(iq)%nqChildren
 
   ijb = ij_begin - 2 * iip1
@@ -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,6 +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)
@@ -870,5 +869,5 @@
   !    sens de W
 
-  !write(*,*) 'vlsplt 926: entree dans vlz_loc, iq=',iq
+  !WRITE(*,*) 'vlsplt 926: entree dans vlz_loc, iq=',iq
 
   ijb = ijb_x
@@ -938,5 +937,5 @@
     ! calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
 
-    !  !write(*,*) 'vlz 982,ijb,ije=',ijb,ije
+    !  !WRITE(*,*) 'vlz 982,ijb,ije=',ijb,ije
     !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l = 1, llm - 1
@@ -954,5 +953,5 @@
     ENDDO
     !$OMP END DO NOWAIT
-    !write(*,*) 'vlz 1001'
+    !WRITE(*,*) 'vlz 1001'
 
   ELSE ! countcfl>=1
@@ -1015,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)
@@ -1058,5 +1057,5 @@
   ! CRisi: appel récursif de l'advection sur les fils.
   ! Il faut faire ça avant d'avoir mis à jour q et masse
-  ! write(*,*)'vlsplt 942: iq,nqChildren(iq)=',iq,tracers(iq)%nqChildren
+  ! WRITE(*,*)'vlsplt 942: iq,nqChildren(iq)=',iq,tracers(iq)%nqChildren
   do ifils = 1, tracers(iq)%nqDescen
     iq2 = tracers(iq)%iqDescen(ifils)
@@ -1066,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90	(revision 5116)
@@ -190,5 +190,5 @@
     ! CRisi: on ne boucle que sur les pères= ceux qui sont transportés directement par l'air
     IF(tracers(iq)%parent /= 'air') CYCLE
-    !write(*,*) 'vlspltgen 192: iq,iadv=',iq,tracers(iq)%iadv
+    !WRITE(*,*) 'vlspltgen 192: iq,iadv=',iq,tracers(iq)%iadv
     SELECT CASE(tracers(iq)%iadv)
     CASE(0); CYCLE
@@ -259,5 +259,5 @@
   do iq = 1, nqtot
     IF(tracers(iq)%parent /= 'air') CYCLE
-    !write(*,*) 'vlspltgen 279: iq=',iq
+    !WRITE(*,*) 'vlspltgen 279: iq=',iq
 
     SELECT CASE(tracers(iq)%iadv)
@@ -359,5 +359,5 @@
   do iq = 1, nqtot
     IF(tracers(iq)%parent /= 'air') CYCLE
-    !write(*,*) 'vlspltgen 409: iq=',iq
+    !WRITE(*,*) 'vlspltgen 409: iq=',iq
 
     SELECT CASE(tracers(iq)%iadv)
@@ -370,8 +370,8 @@
 
   enddo
-  !write(*,*) 'vlspltgen_loc 476'
-
-  !$OMP BARRIER
-  !write(*,*) 'vlspltgen_loc 477'
+  !WRITE(*,*) 'vlspltgen_loc 476'
+
+  !$OMP BARRIER
+  !WRITE(*,*) 'vlspltgen_loc 477'
   !$OMP MASTER
   CALL VTb(VTHallo)
@@ -389,5 +389,5 @@
 
 
-  !write(*,*) 'vlspltgen_loc 494'
+  !WRITE(*,*) 'vlspltgen_loc 494'
   CALL check_isotopes(zq, ij_begin, ij_end, 'vlspltgen_loc 461')
 
@@ -420,5 +420,5 @@
   enddo !do iq=1,nqtot
 
-  !write(*,*) 'vlspltgen 550: apres derniere serie de CALL vlx'
+  !WRITE(*,*) 'vlspltgen 550: apres derniere serie de CALL vlx'
   CALL check_isotopes(zq, ij_begin, ij_end, 'vlspltgen_loc 521')
 
@@ -457,5 +457,5 @@
   !c$OMP BARRIER
 
-  !write(*,*) 'vlspltgen 597: sortie'
+  !WRITE(*,*) 'vlspltgen 597: sortie'
 
 END SUBROUTINE vlspltgen_loc
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90	(revision 5116)
@@ -48,5 +48,5 @@
   INTEGER :: ijb,ije,ijb_x,ije_x
 
-  !write(*,*) 'vlspltqs 58: entree vlxqs_loc, iq,ijb_x=',
+  !WRITE(*,*) 'vlspltqs 58: entree vlxqs_loc, iq,ijb_x=',
   ! &   iq,ijb_x
 
@@ -309,5 +309,5 @@
   ! CRisi: appel recursif de l'advection sur les fils.
   ! Il faut faire ca avant d'avoir mis a jour q et masse
-  !write(*,*) 'vlspltqs 336: iq,ijb_x,nqChildren(iq)=',
+  !WRITE(*,*) 'vlspltqs 336: iq,ijb_x,nqChildren(iq)=',
   ! &     iq,ijb_x,tracers(iq)%nqChildren
 
@@ -330,10 +330,10 @@
   do ifils=1,tracers(iq)%nqChildren
     iq2=tracers(iq)%iqDescen(ifils)
-    !write(*,*) 'vlxqs 349: on appelle vlx pour iq2=',iq2
+    !WRITE(*,*) 'vlxqs 349: on appelle vlx pour iq2=',iq2
     CALL vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2)
   enddo
   ! end CRisi
 
-  !write(*,*) 'vlspltqs 360: iq,ijb_x=',iq,ijb_x
+  !WRITE(*,*) 'vlspltqs 360: iq,ijb_x=',iq,ijb_x
 
   !   calcul des tendances
@@ -356,5 +356,5 @@
 !$OMP END DO NOWAIT
 
-  !write(*,*) 'vlspltqs 380: iq,ijb_x=',iq,ijb_x
+  !WRITE(*,*) 'vlspltqs 380: iq,ijb_x=',iq,ijb_x
 
   ! retablir les fils en rapport de melange par rapport a l'air:
@@ -373,5 +373,5 @@
   enddo
 
-  !write(*,*) 'vlspltqs 399: iq,ijb_x=',iq,ijb_x
+  !WRITE(*,*) 'vlspltqs 399: iq,ijb_x=',iq,ijb_x
 
   ! CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
@@ -452,6 +452,6 @@
   ij=3525
   l=3
-  if ((ij>=ijb).and.(ij<=ije)) then
-    !write(*,*) 'vlyqs 480: ij,l,iq,ijb,q(ij,l,:)=',
+  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
@@ -488,5 +488,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)
@@ -495,5 +495,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)
@@ -701,5 +701,5 @@
   ! CRisi: appel recursif de l'advection sur les fils.
   ! Il faut faire ca avant d'avoir mis a jour q et masse
-  ! write(*,*)'vlyqs 689: iq,nqChildren(iq)=',iq,
+  ! WRITE(*,*)'vlyqs 689: iq,nqChildren(iq)=',iq,
   !    &             tracers(iq)%nqChildren
 
@@ -713,7 +713,7 @@
   if (pole_sud)  ijem=ij_end
 
-  !write(lunout,*) 'vlspltqs 737: iq,ijb,ije=',iq,ijb,ije
-  !write(lunout,*) 'ij_begin,ij_end=',ij_begin,ij_end
-  !write(lunout,*) 'pole_nord,pole_sud=',pole_nord,pole_sud
+  !WRITE(lunout,*) 'vlspltqs 737: iq,ijb,ije=',iq,ijb,ije
+  !WRITE(lunout,*) 'ij_begin,ij_end=',ij_begin,ij_end
+  !WRITE(lunout,*) 'pole_nord,pole_sud=',pole_nord,pole_sud
   do ifils=1,tracers(iq)%nqDescen
     iq2=tracers(iq)%iqDescen(ifils)
@@ -730,5 +730,5 @@
       DO ij=ijb,ije
         !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)
+        !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
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
@@ -742,5 +742,5 @@
   do ifils=1,tracers(iq)%nqChildren
     iq2=tracers(iq)%iqDescen(ifils)
-    !write(lunout,*) 'vly: appel recursiv vly iq2=',iq2
+    !WRITE(lunout,*) 'vly: appel recursiv vly iq2=',iq2
     CALL vly_loc(Ratio,pente_max,masse,qbyv,iq2)
   enddo
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90	(revision 5116)
@@ -2,4 +2,5 @@
 
 SUBROUTINE wrgrads(if, nl, field, name, titlevar)
+  USE lmdz_formcoord, ONLY: formcoord
   IMPLICIT NONE
 
@@ -14,12 +15,12 @@
 
   !   arguments
-  integer :: if, nl
-  real :: field(imx * jmx * lmx)
-  character(len = 10) :: name, file
-  character(len = 10) :: titlevar
+  INTEGER :: if, nl
+  REAL :: field(imx * jmx * lmx)
+  CHARACTER(LEN = 10) :: name, file
+  CHARACTER(LEN = 10) :: titlevar
 
   !   local
 
-  integer :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
+  INTEGER :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
 
   logical :: writectl
@@ -39,6 +40,6 @@
   PRINT*, im, jm, lm, name, firsttime(if)
 
-  if(firsttime(if)) then
-    if(name==var(1, if)) then
+  IF(firsttime(if)) THEN
+    IF(name==var(1, if)) THEN
       firsttime(if) = .FALSE.
       ivar(if) = 1
@@ -62,10 +63,10 @@
   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
     endif
 
-    if(var(ivar(if), if)/=name) then
+    IF(var(ivar(if), if)/=name) THEN
       PRINT*, 'Il faut stoker la meme succession de champs a chaque'
       PRINT*, 'pas de temps'
@@ -85,32 +86,31 @@
     !    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
     !    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
-    write(unit(if) + 1, rec = irec(if)) &
+    WRITE(unit(if) + 1, rec = irec(if)) &
             ((field((l - 1) * imd(if) * jmd(if) + (j - 1) * imd(if) + i) &
                     , 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
     open(unit(if), file = trim(file) // '.ctl' &
             , form = 'formatted', status = 'unknown')
-    write(unit(if), '(a5,1x,a40)') &
+    WRITE(unit(if), '(a5,1x,a40)') &
             'DSET ', '^' // trim(file) // '.dat'
 
-    write(unit(if), '(a12)') 'UNDEF 1.0E30'
-    write(unit(if), '(a5,1x,a40)') 'TITLE ', title(if)
+    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')
-    write(unit(if), '(a4,i10,a30)') &
+    WRITE(unit(if), '(a4,i10,a30)') &
             'TDEF ', itime(if), ' LINEAR 02JAN1987 1MO '
-    write(unit(if), '(a4,2x,i5)') 'VARS', nvar(if)
+    WRITE(unit(if), '(a4,2x,i5)') 'VARS', nvar(if)
     do iv = 1, nvar(if)
       ! PRINT*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
       ! PRINT*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
-      write(unit(if), 1000) var(iv, if), nld(iv, if) - 1 / nld(iv, if) &
+      WRITE(unit(if), 1000) var(iv, if), nld(iv, if) - 1 / nld(iv, if) &
               , 99, tvar(iv, if)
     enddo
-    write(unit(if), '(a7)') 'ENDVARS'
+    WRITE(unit(if), '(a7)') 'ENDVARS'
     !
     1000   format(a5, 3x, i4, i3, 1x, a39)
@@ -120,6 +120,4 @@
   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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90	(revision 5116)
@@ -13,5 +13,5 @@
   
   SUBROUTINE write_field1D_u(name,Field)
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(:) :: Field
 
@@ -23,7 +23,7 @@
     IMPLICIT NONE
       
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(:,:) :: Field
-    integer :: ll
+    INTEGER :: ll
     
     ll=size(field,2)    
@@ -41,5 +41,5 @@
     include 'paramet.h'
       
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(ijb_u:ije_u,ll) :: Field
     real, allocatable,SAVE :: New_Field(:,:,:)
@@ -47,5 +47,5 @@
     type(Request),SAVE :: Request_write
 !$OMP THREADPRIVATE(Request_write)
-    integer :: ll,i
+    INTEGER :: ll,i
     
     
@@ -78,5 +78,5 @@
 
   SUBROUTINE write_field1D_v(name,Field)
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(:) :: Field
 
@@ -88,7 +88,7 @@
     IMPLICIT NONE
       
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(:,:) :: Field
-    integer :: ll
+    INTEGER :: ll
     
     ll=size(field,2)    
@@ -106,5 +106,5 @@
     include 'paramet.h'
       
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(ijb_v:ije_v,ll) :: Field
     real, allocatable,SAVE :: New_Field(:,:,:)
@@ -112,5 +112,5 @@
     type(Request),SAVE :: Request_write
 !$OMP THREADPRIVATE(Request_write)    
-    integer :: ll,i,jje,ije,jjn
+    INTEGER :: ll,i,jje,ije,jjn
     
     
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90	(revision 5116)
@@ -14,5 +14,5 @@
   
     integer, parameter :: MaxDim=1
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(:) :: Field
     real, dimension(:),allocatable :: New_Field
@@ -35,5 +35,5 @@
   
     integer, parameter :: MaxDim=2
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(:,:) :: Field
     real, dimension(:,:),allocatable :: New_Field
@@ -56,5 +56,5 @@
   
     integer, parameter :: MaxDim=3
-    character(len=*)   :: name
+    CHARACTER(LEN=*)   :: name
     real, dimension(:,:,:) :: Field
     real, dimension(:,:,:),allocatable :: New_Field
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90	(revision 5116)
@@ -59,5 +59,5 @@
   logical ok_sync
   integer itau_w
-  integer :: ijb, ije, jjn
+  INTEGER :: ijb, ije, jjn
   LOGICAL, SAVE :: first = .TRUE.
   LOGICAL, SAVE :: debuglf = .TRUE.
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90	(revision 5116)
@@ -57,5 +57,5 @@
   REAL :: phis(ijb_u:ije_u)
   REAL :: q(ijb_u:ije_u, llm, nqtot)
-  integer :: time
+  INTEGER :: time
 
 
@@ -68,6 +68,6 @@
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
   logical :: ok_sync
-  integer :: itau_w
-  integer :: ijb, ije, jjn
+  INTEGER :: itau_w
+  INTEGER :: ijb, ije, jjn
   LOGICAL, SAVE :: first = .TRUE.
   !$OMP THREADPRIVATE(first)
@@ -209,5 +209,5 @@
   !
   !$OMP MASTER
-  if (ok_sync) then
+  if (ok_sync) THEN
     CALL histsync(histaveid)
     CALL histsync(histvaveid)
@@ -215,3 +215,3 @@
   ENDIF
   !$OMP END MASTER
-end subroutine writedynav_loc
+END SUBROUTINE writedynav_loc
Index: /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90	(revision 5116)
@@ -54,5 +54,5 @@
   REAL :: phis(ijb_u:ije_u)
   REAL :: q(ijb_u:ije_u, llm, nqtot)
-  integer :: time
+  INTEGER :: time
 
 
@@ -65,6 +65,6 @@
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
   logical :: ok_sync
-  integer :: itau_w
-  integer :: ijb, ije, jjn
+  INTEGER :: itau_w
+  INTEGER :: ijb, ije, jjn
   LOGICAL, SAVE :: first = .TRUE.
   !$OMP THREADPRIVATE(first)
@@ -205,5 +205,5 @@
   !
   !$OMP MASTER
-  if (ok_sync) then
+  if (ok_sync) THEN
     CALL histsync(histid)
     CALL histsync(histvid)
@@ -211,3 +211,3 @@
   endif
   !$OMP END MASTER
-end subroutine writehist_loc
+END SUBROUTINE writehist_loc
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/calfis.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/calfis.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/calfis.f90	(revision 5116)
@@ -180,9 +180,9 @@
     debut = .TRUE.
     IF (ngridmx/=2+(jjm-1)*iim) THEN
-     write(lunout,*) 'STOP dans calfis'
-     write(lunout,*) &
+     WRITE(lunout,*) 'STOP dans calfis'
+     WRITE(lunout,*) &
            'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-     write(lunout,*) '  ngridmx  jjm   iim   '
-     write(lunout,*) ngridmx,jjm,iim
+     WRITE(lunout,*) '  ngridmx  jjm   iim   '
+     WRITE(lunout,*) ngridmx,jjm,iim
      CALL abort_gcm("calfis", "", 1)
     ENDIF
@@ -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
@@ -467,5 +467,5 @@
 
 
-   ! write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
+   ! WRITE(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
   zdt_split=dtphys/nsplit_phys
   zdufic(:,:)=0.
@@ -482,5 +482,5 @@
      lafin_split=lafin.and.isplit==nsplit_phys
 
-   ! if (planet_type=="earth") then
+   ! if (planet_type=="earth") THEN
     CALL call_physiq(ngridmx,llm,nqtot,tracers(:)%name, &
           debut_split,lafin_split, &
@@ -493,6 +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
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/gr_dyn_fi.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/gr_dyn_fi.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/gr_dyn_fi.f90	(revision 5116)
@@ -22,5 +22,5 @@
   !   -------
 
-  IF (ngrid/=2+(jm-2)*(im-1)) then
+  IF (ngrid/=2+(jm-2)*(im-1)) THEN
      CALL abort_gcm("gr_dyn_fi", 'probleme de dim', 1)
   end if
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/inigeomphy_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/inigeomphy_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/inigeomphy_mod.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/lmdz_calfis_loc.F90	(revision 5116)
@@ -227,5 +227,5 @@
   INTEGER, dimension(4) :: Req
   REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
-  integer :: k,kstart,kend
+  INTEGER :: k,kstart,kend
   INTEGER :: offset
   INTEGER :: jjb,jje
@@ -243,9 +243,9 @@
     debut = .TRUE.
     IF (ngridmx/=2+(jjm-1)*iim) THEN
-      write(lunout,*) 'STOP dans calfis'
-      write(lunout,*) &
+      WRITE(lunout,*) 'STOP dans calfis'
+      WRITE(lunout,*) &
             'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-      write(lunout,*) '  ngridmx  jjm   iim   '
-      write(lunout,*) ngridmx,jjm,iim
+      WRITE(lunout,*) '  ngridmx  jjm   iim   '
+      WRITE(lunout,*) ngridmx,jjm,iim
       CALL abort_gcm("calfis_loc", "", 1)
     ENDIF
@@ -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) )
@@ -472,5 +472,5 @@
         zrfi(ig0,l) = 0 !  AdlC MAY 2014
       else
-        if(i==1)then
+        IF(i==1)THEN
         zrfi(ig0,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l) &
               +zrot(1,j-1,l)+zrot(1,j,l))   !  AdlC MAY 2014
@@ -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
@@ -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
@@ -561,5 +561,5 @@
 
 !$OMP BARRIER
-  if (first_omp) then
+  if (first_omp) THEN
     klon=klon_omp
 
@@ -697,5 +697,5 @@
 
 !$OMP MASTER
-   ! write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
+   ! WRITE(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
 !$OMP END MASTER
   zdt_split=dtphys/nsplit_phys
@@ -837,6 +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
@@ -861,5 +860,5 @@
   endif
 
-  if (MPI_rank<MPI_Size-1) then
+  if (MPI_rank<MPI_Size-1) THEN
 !$OMP BARRIER
 
@@ -880,9 +879,9 @@
 !$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
@@ -909,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
@@ -922,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
@@ -951,5 +950,5 @@
      enddo
 
-    if (is_north_pole_dyn) then
+    if (is_north_pole_dyn) THEN
         DO i=1,iip1
           pdpsfi(i,1)    = zdpsrf(1)
@@ -957,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)
@@ -987,5 +986,5 @@
      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)
@@ -993,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)
@@ -1015,5 +1014,5 @@
    !      enddo
 
-  !       if (is_north_pole_dyn) then
+  !       if (is_north_pole_dyn) THEN
   !         do i=1,iip1
   !           pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
@@ -1021,5 +1020,5 @@
   !       endif
 
-  !       if (is_south_pole_dyn) then
+  !       if (is_south_pole_dyn) THEN
   !         do i=1,iip1
   !           pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq)
@@ -1057,5 +1056,5 @@
         ENDDO
 
-        IF (is_north_pole_dyn) then
+        IF (is_north_pole_dyn) THEN
           DO i=1,iip1
             pdqfi(i,1,l,iq)    = zdqfi(1,l,itr)
@@ -1063,5 +1062,5 @@
         ENDIF
 
-        IF (is_south_pole_dyn) then
+        IF (is_south_pole_dyn) THEN
           DO i=1,iip1
             pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,itr)
@@ -1084,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)
@@ -1096,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.
@@ -1102,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.
@@ -1142,6 +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
@@ -1162,6 +1160,5 @@
   endif
 
-  if (is_south_pole_dyn) then
-
+  if (is_south_pole_dyn) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
      DO l=1,llm
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/callphysiq_mod.F90	(revision 5116)
@@ -69,5 +69,5 @@
 
   !$OMP MASTER
-  if (ok_dyn_xios) then
+  if (ok_dyn_xios) THEN
      CALL xios_get_current_context(dyn3d_ctx_handle)
   endif
@@ -99,5 +99,5 @@
 ! 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
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/ce0l.F90	(revision 5116)
@@ -36,5 +36,5 @@
   USE mod_hallo,      ONLY: init_mod_hallo
   USE mod_interface_dyn_phys, ONLY: init_interface_dyn_phys
-  USE lmdz_xios, only: using_xios, xios_finalize
+  USE lmdz_xios, ONLY: using_xios, xios_finalize
 #endif
 
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90	(revision 5116)
@@ -1,44 +1,44 @@
 MODULE etat0dyn
 
-!*******************************************************************************
-! Purpose: Create dynamical initial state using atmospheric fields from a
-!          database of atmospheric to initialize the model.
-!-------------------------------------------------------------------------------
-! Comments:
-
-!    *  This module is designed to work for Earth (and with ioipsl)
-
-!    *  etat0dyn_netcdf routine can access to NetCDF data through the following
-!  routine (to be called after restget):
-!    CALL startget_dyn3d(varname, lon_in,  lat_in, pls, workvar,&
-!                          champ, lon_in2, lat_in2)
-
-!    *  Variables should have the following names in the NetCDF files:
-!            'U'      : East ward wind              (in "ECDYN.nc")
-!            'V'      : Northward wind              (in "ECDYN.nc")
-!            'TEMP'   : Temperature                 (in "ECDYN.nc")
-!            'R'      : Relative humidity           (in "ECDYN.nc")
-!            'RELIEF' : High resolution orography   (in "Relief.nc") 
-
-!    * The land mask and corresponding weights can be:
-!      1) already known (in particular if etat0dyn has been called before) ;
-!         in this case, ANY(masque(:,:)/=-99999.) = .TRUE.
-!      2) computed using the ocean mask from the ocean model (to ensure ocean
-!         fractions are the same for atmosphere and ocean) for coupled runs.
-!         File name: "o2a.nc"  ;  variable name: "OceMask"
-!      3) computed from topography file "Relief.nc" for forced runs.
-
-!   *   There is a big mess with the longitude size. Should it be iml or iml+1 ?
-!  I have chosen to use the iml+1 as an argument to this routine and we declare
-!  internaly smaller fields when needed. This needs to be cleared once and for
-!  all in LMDZ. A convention is required.
-!-------------------------------------------------------------------------------
-  USE ioipsl,         ONLY: flininfo, flinopen, flinget, flinclo, histclo
-  USE lmdz_assert_eq,    ONLY: assert_eq
+  !*******************************************************************************
+  ! Purpose: Create dynamical initial state using atmospheric fields from a
+  !          database of atmospheric to initialize the model.
+  !-------------------------------------------------------------------------------
+  ! Comments:
+
+  !    *  This module is designed to work for Earth (and with ioipsl)
+
+  !    *  etat0dyn_netcdf routine can access to NetCDF data through the following
+  !  routine (to be called after restget):
+  !    CALL startget_dyn3d(varname, lon_in,  lat_in, pls, workvar,&
+  !                          champ, lon_in2, lat_in2)
+
+  !    *  Variables should have the following names in the NetCDF files:
+  !            'U'      : East ward wind              (in "ECDYN.nc")
+  !            'V'      : Northward wind              (in "ECDYN.nc")
+  !            'TEMP'   : Temperature                 (in "ECDYN.nc")
+  !            'R'      : Relative humidity           (in "ECDYN.nc")
+  !            'RELIEF' : High resolution orography   (in "Relief.nc")
+
+  !    * The land mask and corresponding weights can be:
+  !      1) already known (in particular if etat0dyn has been called before) ;
+  !         in this case, ANY(masque(:,:)/=-99999.) = .TRUE.
+  !      2) computed using the ocean mask from the ocean model (to ensure ocean
+  !         fractions are the same for atmosphere and ocean) for coupled runs.
+  !         File name: "o2a.nc"  ;  variable name: "OceMask"
+  !      3) computed from topography file "Relief.nc" for forced runs.
+
+  !   *   There is a big mess with the longitude size. Should it be iml or iml+1 ?
+  !  I have chosen to use the iml+1 as an argument to this routine and we declare
+  !  internaly smaller fields when needed. This needs to be cleared once and for
+  !  all in LMDZ. A convention is required.
+  !-------------------------------------------------------------------------------
+  USE ioipsl, ONLY: flininfo, flinopen, flinget, flinclo, histclo
+  USE lmdz_assert_eq, ONLY: assert_eq
   USE comconst_mod, ONLY: pi, cpp, kappa
   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
-  
+
   IMPLICIT NONE
 
@@ -52,455 +52,460 @@
   include "comdissnew.h"
   REAL, SAVE :: deg2rad
-  INTEGER,            SAVE      :: iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn
-  REAL, ALLOCATABLE,  SAVE      :: lon_dyn(:,:), lat_dyn(:,:), levdyn_ini(:)
-  CHARACTER(LEN=120), PARAMETER :: dynfname='ECDYN.nc'
+  INTEGER, SAVE :: iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn
+  REAL, ALLOCATABLE, SAVE :: lon_dyn(:, :), lat_dyn(:, :), levdyn_ini(:)
+  CHARACTER(LEN = 120), PARAMETER :: dynfname = 'ECDYN.nc'
 
 CONTAINS
 
-!-------------------------------------------------------------------------------
-
-SUBROUTINE etat0dyn_netcdf(masque, phis)
-
-!-------------------------------------------------------------------------------
-! Purpose: Create dynamical initial states.
-!-------------------------------------------------------------------------------
-! Notes:  1) This routine is designed to work for Earth
-!         2) If masque(:,:)/=-99999., masque and phis are already known.
-!         Otherwise: compute it.
-!-------------------------------------------------------------------------------
-  USE control_mod
-  USE regr_lat_time_coefoz_m, ONLY: regr_lat_time_coefoz
-  USE regr_pr_o3_m,   ONLY: regr_pr_o3
-  USE press_coefoz_m, ONLY: press_coefoz
-  USE exner_hyb_m,    ONLY: exner_hyb
-  USE exner_milieu_m, ONLY: exner_milieu
-  USE infotrac,       ONLY: nqtot, tracers
-  USE lmdz_filtreg
-  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  REAL,    INTENT(INOUT) :: masque(iip1,jjp1)   !--- Land-ocean mask
-  REAL,    INTENT(INOUT) :: phis  (iip1,jjp1)   !--- Ground geopotential
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname, fmt
-  INTEGER            :: i, j, l, ji, itau, iday, iq
-  REAL               :: xpn, xps, time, phystep
-  REAL, DIMENSION(iip1,jjp1)       :: psol
-  REAL, DIMENSION(iip1,jjp1,llm+1) :: p3d
-  REAL, DIMENSION(iip1,jjp1,llm)   :: uvent, t3d, tpot, qsat, qd
-  REAL, DIMENSION(iip1,jjp1,llm)   :: pk, pls, y, masse
-  REAL, DIMENSION(iip1,jjm ,llm)   :: vvent
-  REAL, DIMENSION(ip1jm    ,llm)   :: pbarv
-  REAL, DIMENSION(ip1jmp1  ,llm)   :: pbaru, phi, w
-  REAL, DIMENSION(ip1jmp1)         :: pks
-  REAL, DIMENSION(iim)             :: xppn, xpps
-  REAL, ALLOCATABLE                :: q3d(:,:,:,:)
-!-------------------------------------------------------------------------------
-  modname='etat0dyn_netcdf'
-
-  deg2rad = pi/180.0
-  y(:,:,:)=0  !ym warning unitialized variable
-  
-! Compute psol AND tsol, knowing phis.
-!*******************************************************************************
-  CALL start_init_dyn(rlonv, rlatu, rlonu, rlatv, phis, psol)
-
-! Mid-levels pressure computation
-!*******************************************************************************
-  CALL pression(ip1jmp1, ap, bp, psol, p3d)             !--- Update p3d
-  IF(pressure_exner) THEN                               !--- Update pk, pks
-    CALL exner_hyb   (ip1jmp1,psol,p3d,pks,pk)
-  ELSE
-    CALL exner_milieu(ip1jmp1,psol,p3d,pks,pk)
-  END IF
-  pls(:,:,:)=preff*(pk(:,:,:)/cpp)**(1./kappa)          !--- Update pls
-
-! Update uvent, vvent, t3d and tpot
-!*******************************************************************************
-  uvent(:,:,:) = 0.0 ; vvent(:,:,:) = 0.0 ; t3d (:,:,:) = 0.0
-  CALL startget_dyn3d('u'   ,rlonu,rlatu,pls,y ,uvent,rlonv,rlatv)
-  CALL startget_dyn3d('v'   ,rlonv,rlatv,pls(:,:jjm,:),y(:,:jjm,:),vvent,      &
-                             rlonu,rlatu(:jjm))
-  CALL startget_dyn3d('t'   ,rlonv,rlatu,pls,y ,t3d ,rlonu,rlatv)
-  tpot(:,:,:)=t3d(:,:,:)
-  CALL startget_dyn3d('tpot',rlonv,rlatu,pls,pk,tpot,rlonu,rlatv)
-
-  WRITE(lunout,*) 'T3D min,max:',MINVAL(t3d(:,:,:)),MAXVAL(t3d(:,:,:))
-  WRITE(lunout,*) 'PLS min,max:',MINVAL(pls(:,:,:)),MAXVAL(pls(:,:,:))
-
-! Humidity at saturation computation
-!*******************************************************************************
-  WRITE(lunout,*) 'avant q_sat'
-  CALL q_sat(llm*jjp1*iip1, t3d, pls, qsat)
-  WRITE(lunout,*) 'apres q_sat'
-  WRITE(lunout,*) 'QSAT min,max:',MINVAL(qsat(:,:,:)),MAXVAL(qsat(:,:,:))
-!  WRITE(lunout,*) 'QSAT :',qsat(10,20,:)
-  qd (:,:,:) = 0.0
-  CALL startget_dyn3d('q',rlonv,rlatu,pls,qsat,qd,rlonu,rlatv)
-  ALLOCATE(q3d(iip1,jjp1,llm,nqtot)); q3d(:,:,:,:)=0.0 ; q3d(:,:,:,1)=qd(:,:,:)
-  CALL flinclo(fid_dyn)
-
-! Parameterization of ozone chemistry:
-!*******************************************************************************
-! Look for ozone tracer:
-IF (CPPKEY_INCA) THEN
-  DO iq=1,nqtot; IF(strLower(tracers(iq)%name)=="o3") EXIT; END DO
-  IF(iq/=nqtot+1) THEN
-    CALL regr_lat_time_coefoz
-    CALL press_coefoz
-    CALL regr_pr_o3(p3d, q3d(:,:,:,iq))
-    q3d(:,:,:,iq)=q3d(:,:,:,iq)*48./ 29.                !--- Mole->mass fraction         
-  END IF
-END IF
-  q3d(iip1,:,:,:)=q3d(1,:,:,:)
-
-! Writing
-!*******************************************************************************
-  CALL inidissip(lstardis, nitergdiv, nitergrot, niterh, tetagdiv, tetagrot,   &
-       tetatemp, vert_prof_dissip)
-  WRITE(lunout,*)'sortie inidissip'
-  itau=0
-  itau_dyn=0
-  itau_phy=0
-  iday=dayref+itau/day_step
-  time=FLOAT(itau-(iday-dayref)*day_step)/day_step
-  IF(time>1.) THEN
-   time=time-1
-   iday=iday+1
-  END IF
-  day_ref=dayref
-  annee_ref=anneeref
-  CALL geopot( ip1jmp1, tpot, pk, pks, phis, phi )
-  WRITE(lunout,*)'sortie geopot'
-  CALL caldyn0( itau, uvent, vvent, tpot, psol, masse, pk, phis,               &
-                phi,  w, pbaru, pbarv, time+iday-dayref)
-  WRITE(lunout,*)'sortie caldyn0'
-  start_time = 0.
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE etat0dyn_netcdf(masque, phis)
+
+    !-------------------------------------------------------------------------------
+    ! Purpose: Create dynamical initial states.
+    !-------------------------------------------------------------------------------
+    ! Notes:  1) This routine is designed to work for Earth
+    !         2) If masque(:,:)/=-99999., masque and phis are already known.
+    !         Otherwise: compute it.
+    !-------------------------------------------------------------------------------
+    USE control_mod
+    USE regr_lat_time_coefoz_m, ONLY: regr_lat_time_coefoz
+    USE regr_pr_o3_m, ONLY: regr_pr_o3
+    USE press_coefoz_m, ONLY: press_coefoz
+    USE exner_hyb_m, ONLY: exner_hyb
+    USE exner_milieu_m, ONLY: exner_milieu
+    USE infotrac, ONLY: nqtot, tracers
+    USE lmdz_filtreg
+    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
+    IMPLICIT NONE
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    REAL, INTENT(INOUT) :: masque(iip1, jjp1)   !--- Land-ocean mask
+    REAL, INTENT(INOUT) :: phis  (iip1, jjp1)   !--- Ground geopotential
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    CHARACTER(LEN = 256) :: modname, fmt
+    INTEGER :: i, j, l, ji, itau, iday, iq
+    REAL :: xpn, xps, time, phystep
+    REAL, DIMENSION(iip1, jjp1) :: psol
+    REAL, DIMENSION(iip1, jjp1, llm + 1) :: p3d
+    REAL, DIMENSION(iip1, jjp1, llm) :: uvent, t3d, tpot, qsat, qd
+    REAL, DIMENSION(iip1, jjp1, llm) :: pk, pls, y, masse
+    REAL, DIMENSION(iip1, jjm, llm) :: vvent
+    REAL, DIMENSION(ip1jm, llm) :: pbarv
+    REAL, DIMENSION(ip1jmp1, llm) :: pbaru, phi, w
+    REAL, DIMENSION(ip1jmp1) :: pks
+    REAL, DIMENSION(iim) :: xppn, xpps
+    REAL, ALLOCATABLE :: q3d(:, :, :, :)
+    !-------------------------------------------------------------------------------
+    modname = 'etat0dyn_netcdf'
+
+    deg2rad = pi / 180.0
+    y(:, :, :) = 0  !ym warning unitialized variable
+
+    ! Compute psol AND tsol, knowing phis.
+    !*******************************************************************************
+    CALL start_init_dyn(rlonv, rlatu, rlonu, rlatv, phis, psol)
+
+    ! Mid-levels pressure computation
+    !*******************************************************************************
+    CALL pression(ip1jmp1, ap, bp, psol, p3d)             !--- Update p3d
+    IF(pressure_exner) THEN                               !--- Update pk, pks
+      CALL exner_hyb   (ip1jmp1, psol, p3d, pks, pk)
+    ELSE
+      CALL exner_milieu(ip1jmp1, psol, p3d, pks, pk)
+    END IF
+    pls(:, :, :) = preff * (pk(:, :, :) / cpp)**(1. / kappa)          !--- Update pls
+
+    ! Update uvent, vvent, t3d and tpot
+    !*******************************************************************************
+    uvent(:, :, :) = 0.0 ; vvent(:, :, :) = 0.0 ; t3d (:, :, :) = 0.0
+    CALL startget_dyn3d('u', rlonu, rlatu, pls, y, uvent, rlonv, rlatv)
+    CALL startget_dyn3d('v', rlonv, rlatv, pls(:, :jjm, :), y(:, :jjm, :), vvent, &
+            rlonu, rlatu(:jjm))
+    CALL startget_dyn3d('t', rlonv, rlatu, pls, y, t3d, rlonu, rlatv)
+    tpot(:, :, :) = t3d(:, :, :)
+    CALL startget_dyn3d('tpot', rlonv, rlatu, pls, pk, tpot, rlonu, rlatv)
+
+    WRITE(lunout, *) 'T3D min,max:', MINVAL(t3d(:, :, :)), MAXVAL(t3d(:, :, :))
+    WRITE(lunout, *) 'PLS min,max:', MINVAL(pls(:, :, :)), MAXVAL(pls(:, :, :))
+
+    ! Humidity at saturation computation
+    !*******************************************************************************
+    WRITE(lunout, *) 'avant q_sat'
+    CALL q_sat(llm * jjp1 * iip1, t3d, pls, qsat)
+    WRITE(lunout, *) 'apres q_sat'
+    WRITE(lunout, *) 'QSAT min,max:', MINVAL(qsat(:, :, :)), MAXVAL(qsat(:, :, :))
+    !  WRITE(lunout,*) 'QSAT :',qsat(10,20,:)
+    qd (:, :, :) = 0.0
+    CALL startget_dyn3d('q', rlonv, rlatu, pls, qsat, qd, rlonu, rlatv)
+    ALLOCATE(q3d(iip1, jjp1, llm, nqtot)); q3d(:, :, :, :) = 0.0 ; q3d(:, :, :, 1) = qd(:, :, :)
+    CALL flinclo(fid_dyn)
+
+    ! Parameterization of ozone chemistry:
+    !*******************************************************************************
+    ! Look for ozone tracer:
+    IF (CPPKEY_INCA) THEN
+      DO iq = 1, nqtot; IF(strLower(tracers(iq)%name)=="o3") EXIT;
+      END DO
+      IF(iq/=nqtot + 1) THEN
+        CALL regr_lat_time_coefoz
+        CALL press_coefoz
+        CALL regr_pr_o3(p3d, q3d(:, :, :, iq))
+        q3d(:, :, :, iq) = q3d(:, :, :, iq) * 48. / 29.                !--- Mole->mass fraction
+      END IF
+    END IF
+    q3d(iip1, :, :, :) = q3d(1, :, :, :)
+
+    ! Writing
+    !*******************************************************************************
+    CALL inidissip(lstardis, nitergdiv, nitergrot, niterh, tetagdiv, tetagrot, &
+            tetatemp, vert_prof_dissip)
+    WRITE(lunout, *)'sortie inidissip'
+    itau = 0
+    itau_dyn = 0
+    itau_phy = 0
+    iday = dayref + itau / day_step
+    time = FLOAT(itau - (iday - dayref) * day_step) / day_step
+    IF(time>1.) THEN
+      time = time - 1
+      iday = iday + 1
+    END IF
+    day_ref = dayref
+    annee_ref = anneeref
+    CALL geopot(ip1jmp1, tpot, pk, pks, phis, phi)
+    WRITE(lunout, *)'sortie geopot'
+    CALL caldyn0(itau, uvent, vvent, tpot, psol, masse, pk, phis, &
+            phi, w, pbaru, pbarv, time + iday - dayref)
+    WRITE(lunout, *)'sortie caldyn0'
+    start_time = 0.
 #ifdef CPP_PARA
   CALL dynredem0_loc( "start.nc", dayref, phis)
 #else
-  CALL dynredem0( "start.nc", dayref, phis)
+    CALL dynredem0("start.nc", dayref, phis)
 #endif
-  WRITE(lunout,*)'sortie dynredem0'
+    WRITE(lunout, *)'sortie dynredem0'
 #ifdef CPP_PARA
   CALL dynredem1_loc( "start.nc", 0.0, vvent, uvent, tpot, q3d, masse, psol)
 #else
-  CALL dynredem1( "start.nc", 0.0, vvent, uvent, tpot, q3d, masse, psol)
+    CALL dynredem1("start.nc", 0.0, vvent, uvent, tpot, q3d, masse, psol)
 #endif
-  WRITE(lunout,*)'sortie dynredem1' 
-  CALL histclo()
-
-END SUBROUTINE etat0dyn_netcdf
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE startget_dyn3d(var, lon_in,  lat_in,  pls,  workvar,&
-                        champ, lon_in2, lat_in2)
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!===============================================================================
-! Purpose: Compute some quantities (u,v,t,q,tpot) using variables U,V,TEMP and R
-!     (3D fields) of file dynfname.
-!-------------------------------------------------------------------------------
-! Note: An input auxilliary field "workvar" has to be specified in two cases:
-!     * for "q":    the saturated humidity.
-!     * for "tpot": the Exner function.
-!===============================================================================
-! Arguments:
-  CHARACTER(LEN=*), INTENT(IN)    :: var
-  REAL,             INTENT(IN)    :: lon_in(:)        ! dim (iml)
-  REAL,             INTENT(IN)    :: lat_in(:)        ! dim (jml)
-  REAL,             INTENT(IN)    :: pls    (:, :, :) ! dim (iml, jml, lml)
-  REAL,             INTENT(IN)    :: workvar(:, :, :) ! dim (iml, jml, lml)
-  REAL,             INTENT(INOUT) :: champ  (:, :, :) ! dim (iml, jml, lml)
-  REAL,             INTENT(IN)    :: lon_in2(:)       ! dim (iml)
-  REAL,             INTENT(IN)    :: lat_in2(:)       ! dim (jml2)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=10)  :: vname
-  CHARACTER(LEN=256) :: msg, modname="startget_dyn3d"
-  INTEGER            :: iml, jml, jml2, lml, il
-  REAL               :: xppn, xpps
-!-------------------------------------------------------------------------------
-  iml=assert_eq([SIZE(lon_in),SIZE(pls,1),SIZE(workvar,1),SIZE(champ,1),       &
-                                          SIZE(lon_in2)], TRIM(modname)//" iml")
-  jml=assert_eq( SIZE(lat_in),SIZE(pls,2),SIZE(workvar,2),SIZE(champ,2),       &
-                                                          TRIM(modname)//" jml")
-  lml=assert_eq(              SIZE(pls,3),SIZE(workvar,3),SIZE(champ,3),       &
-                                                          TRIM(modname)//" lml")
-  jml2=SIZE(lat_in2)
-
-!--- CHECK IF THE FIELD IS KNOWN
-   SELECT CASE(var)
-    CASE('u');    vname='U'
-    CASE('v');    vname='V'
-    CASE('t');    vname='TEMP'
-    CASE('q');    vname='R';    msg='humidity as the saturated humidity'
-    CASE('tpot'); msg='potential temperature as the Exner function'
-    CASE DEFAULT; msg='No rule to extract variable '//TRIM(var)
-      CALL abort_gcm(modname,TRIM(msg)//' from any data set',1)
-  END SELECT
-
-!--- CHECK IF SOMETHING IS MISSING
-  IF((var=='tpot'.OR.var=='q').AND.MINVAL(workvar)==MAXVAL(workvar)) THEN
-    msg='Could not compute '//TRIM(msg)//' is missing or constant.'
-    CALL abort_gcm(modname,TRIM(msg),1)
-  END IF
-
-!--- INTERPOLATE 3D FIELD IF NEEDED
-  IF(var/='tpot') CALL start_inter_3d(TRIM(vname),lon_in,lat_in,lon_in2,      &
-                                                  lat_in2,pls,champ)
-
-!--- COMPUTE THE REQUIRED FILED
-  SELECT CASE(var)
-    CASE('u'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cu(:,1:jml); END DO
-      champ(iml,:,:)=champ(1,:,:)                   !--- Eastward wind
-
-    CASE('v'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cv(:,1:jml); END DO
-      champ(iml,:,:)=champ(1,:,:)                   !--- Northward wind
-
-    CASE('tpot','q')
-      IF(var=='tpot') THEN; champ=champ*cpp/workvar !--- Potential temperature
-      ELSE;                 champ=champ*.01*workvar !--- Relative humidity
-        WHERE(champ<0.) champ=1.0E-10
+    WRITE(lunout, *)'sortie dynredem1'
+    CALL histclo()
+
+  END SUBROUTINE etat0dyn_netcdf
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE startget_dyn3d(var, lon_in, lat_in, pls, workvar, &
+          champ, lon_in2, lat_in2)
+    !-------------------------------------------------------------------------------
+    IMPLICIT NONE
+    !===============================================================================
+    ! Purpose: Compute some quantities (u,v,t,q,tpot) using variables U,V,TEMP and R
+    !     (3D fields) of file dynfname.
+    !-------------------------------------------------------------------------------
+    ! Note: An input auxilliary field "workvar" has to be specified in two cases:
+    !     * for "q":    the saturated humidity.
+    !     * for "tpot": the Exner function.
+    !===============================================================================
+    ! Arguments:
+    CHARACTER(LEN = *), INTENT(IN) :: var
+    REAL, INTENT(IN) :: lon_in(:)        ! dim (iml)
+    REAL, INTENT(IN) :: lat_in(:)        ! dim (jml)
+    REAL, INTENT(IN) :: pls    (:, :, :) ! dim (iml, jml, lml)
+    REAL, INTENT(IN) :: workvar(:, :, :) ! dim (iml, jml, lml)
+    REAL, INTENT(INOUT) :: champ  (:, :, :) ! dim (iml, jml, lml)
+    REAL, INTENT(IN) :: lon_in2(:)       ! dim (iml)
+    REAL, INTENT(IN) :: lat_in2(:)       ! dim (jml2)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    CHARACTER(LEN = 10) :: vname
+    CHARACTER(LEN = 256) :: msg, modname = "startget_dyn3d"
+    INTEGER :: iml, jml, jml2, lml, il
+    REAL :: xppn, xpps
+    !-------------------------------------------------------------------------------
+    iml = assert_eq([SIZE(lon_in), SIZE(pls, 1), SIZE(workvar, 1), SIZE(champ, 1), &
+            SIZE(lon_in2)], TRIM(modname) // " iml")
+    jml = assert_eq(SIZE(lat_in), SIZE(pls, 2), SIZE(workvar, 2), SIZE(champ, 2), &
+            TRIM(modname) // " jml")
+    lml = assert_eq(SIZE(pls, 3), SIZE(workvar, 3), SIZE(champ, 3), &
+            TRIM(modname) // " lml")
+    jml2 = SIZE(lat_in2)
+
+    !--- CHECK IF THE FIELD IS KNOWN
+    SELECT CASE(var)
+    CASE('u');    vname = 'U'
+    CASE('v');    vname = 'V'
+    CASE('t');    vname = 'TEMP'
+    CASE('q');    vname = 'R';    msg = 'humidity as the saturated humidity'
+    CASE('tpot'); msg = 'potential temperature as the Exner function'
+    CASE DEFAULT; msg = 'No rule to extract variable ' // TRIM(var)
+    CALL abort_gcm(modname, TRIM(msg) // ' from any data set', 1)
+    END SELECT
+
+    !--- CHECK IF SOMETHING IS MISSING
+    IF((var=='tpot'.OR.var=='q').AND.MINVAL(workvar)==MAXVAL(workvar)) THEN
+      msg = 'Could not compute ' // TRIM(msg) // ' is missing or constant.'
+      CALL abort_gcm(modname, TRIM(msg), 1)
+    END IF
+
+    !--- INTERPOLATE 3D FIELD IF NEEDED
+    IF(var/='tpot') CALL start_inter_3d(TRIM(vname), lon_in, lat_in, lon_in2, &
+            lat_in2, pls, champ)
+
+    !--- COMPUTE THE REQUIRED FILED
+    SELECT CASE(var)
+    CASE('u'); DO il = 1, lml; champ(:, :, il) = champ(:, :, il) * cu(:, 1:jml);
+    END DO
+    champ(iml, :, :) = champ(1, :, :)                   !--- Eastward wind
+
+    CASE('v'); DO il = 1, lml; champ(:, :, il) = champ(:, :, il) * cv(:, 1:jml);
+    END DO
+    champ(iml, :, :) = champ(1, :, :)                   !--- Northward wind
+
+    CASE('tpot', 'q')
+      IF(var=='tpot') THEN; champ = champ * cpp / workvar !--- Potential temperature
+      ELSE;                 champ = champ * .01 * workvar !--- Relative humidity
+      WHERE(champ<0.) champ = 1.0E-10
       END IF
-      DO il=1,lml
-        xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
-        xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
-        champ(:,1  ,il) = xppn
-        champ(:,jml,il) = xpps
+      DO il = 1, lml
+        xppn = SUM(aire(:, 1) * champ(:, 1, il)) / apoln
+        xpps = SUM(aire(:, jml) * champ(:, jml, il)) / apols
+        champ(:, 1, il) = xppn
+        champ(:, jml, il) = xpps
       END DO
-  END SELECT
-
-END SUBROUTINE startget_dyn3d
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE start_init_dyn(lon_in,lat_in,lon_in2,lat_in2,zs,psol)
-
-!-------------------------------------------------------------------------------
-  IMPLICIT NONE
-!===============================================================================
-! Purpose:   Compute psol, knowing phis.
-!===============================================================================
-! Arguments:
-  REAL,    INTENT(IN)  :: lon_in (:),  lat_in (:)    ! dim (iml) (jml)
-  REAL,    INTENT(IN)  :: lon_in2(:),  lat_in2(:)    ! dim (iml) (jml2)
-  REAL,    INTENT(IN)  :: zs  (:,:)                  ! dim (iml,jml)
-  REAL,    INTENT(OUT) :: psol(:,:)                  ! dim (iml,jml)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname='start_init_dyn'
-  REAL               :: date, dt
-  INTEGER            :: iml, jml, jml2, itau(1)
-  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), var_ana(:,:)
-  REAL, ALLOCATABLE  :: lat_rad(:), lat_ini(:)
-  REAL, ALLOCATABLE  :: z(:,:), ps(:,:), ts(:,:)
-!-------------------------------------------------------------------------------
-  iml=assert_eq(SIZE(lon_in),SIZE(zs,1),SIZE(psol,1),SIZE(lon_in2),            &
-                                                     TRIM(modname)//" iml")
-  jml=assert_eq(SIZE(lat_in),SIZE(zs,2),SIZE(psol,2),TRIM(modname)//" jml")
-  jml2=SIZE(lat_in2)
-
-  WRITE(lunout,*) 'Opening the surface analysis'
-  CALL flininfo(dynfname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
-  WRITE(lunout,*) 'Values read: ', iml_dyn, jml_dyn, llm_dyn, ttm_dyn
-
-  ALLOCATE(lon_dyn(iml_dyn,jml_dyn), lat_dyn(iml_dyn,jml_dyn))
-  ALLOCATE(levdyn_ini(llm_dyn))
-  CALL flinopen(dynfname, .FALSE., iml_dyn, jml_dyn, llm_dyn,                  &
-                lon_dyn,lat_dyn,levdyn_ini,ttm_dyn,itau,date,dt,fid_dyn)
-
-!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
-  ALLOCATE(lon_ini(iml_dyn),lat_ini(jml_dyn))
-  lon_ini(:)=lon_dyn(:,1); IF(MAXVAL(lon_dyn)>pi) lon_ini=lon_ini*deg2rad
-  lat_ini(:)=lat_dyn(1,:); IF(MAXVAL(lat_dyn)>pi) lat_ini=lat_ini*deg2rad
-
-  ALLOCATE(var_ana(iml_dyn,jml_dyn),lon_rad(iml_dyn),lat_rad(jml_dyn))
-  CALL get_var_dyn('Z',z)                        !--- SURFACE GEOPOTENTIAL
-  CALL get_var_dyn('SP',ps)                      !--- SURFACE PRESSURE
-  CALL get_var_dyn('ST',ts)                      !--- SURFACE TEMPERATURE
-!  CALL flinclo(fid_dyn)
-  DEALLOCATE(var_ana,lon_rad,lat_rad,lon_ini,lat_ini)
-
-!--- PSOL IS COMPUTED IN PASCALS
-  psol(:iml-1,:) = ps(:iml-1,:)*(1.0+(z(:iml-1,:)-zs(:iml-1,:))/287.0          &
-                  /ts(:iml-1,:))
-  psol(iml,:)=psol(1,:)
-  DEALLOCATE(z,ps,ts)
-  psol(:,1  )=SUM(aire(1:iml-1,1  )*psol(1:iml-1,1  ))/apoln  !--- NORTH POLE
-  psol(:,jml)=SUM(aire(1:iml-1,jml)*psol(1:iml-1,jml))/apols  !--- SOUTH POLE
-
-CONTAINS
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE get_var_dyn(title,field)
-
-!-------------------------------------------------------------------------------
-  USE conf_dat_m, ONLY: conf_dat2d
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  CHARACTER(LEN=*),  INTENT(IN)    :: title
-  REAL, ALLOCATABLE, INTENT(INOUT) :: field(:,:)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: msg
-  INTEGER :: tllm
-!-------------------------------------------------------------------------------
-  SELECT CASE(title)
-    CASE('Z');     tllm=0;       msg='geopotential'
-    CASE('SP');    tllm=0;       msg='surface pressure'
-    CASE('ST');    tllm=llm_dyn; msg='temperature'
-  END SELECT
-  IF(.NOT.ALLOCATED(field)) THEN
-    ALLOCATE(field(iml,jml))
-    CALL flinget(fid_dyn, title, iml_dyn,jml_dyn, tllm, ttm_dyn, 1, 1, var_ana)
-    CALL conf_dat2d(title, lon_ini, lat_ini, lon_rad, lat_rad, var_ana, .TRUE.)
-    CALL interp_startvar(title, .TRUE., lon_rad,lat_rad, var_ana,              &
-                                        lon_in, lat_in, lon_in2, lat_in2, field)
-  ELSE IF(SIZE(field)/=SIZE(z)) THEN
-    msg='The '//TRIM(msg)//' field we have does not have the right size'
-    CALL abort_gcm(TRIM(modname),msg,1)
-  END IF
-
-END SUBROUTINE get_var_dyn
-
-!-------------------------------------------------------------------------------
-
-END SUBROUTINE start_init_dyn
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE start_inter_3d(var,lon_in,lat_in,lon_in2,lat_in2,pls_in,var3d)
-
-!-------------------------------------------------------------------------------
-  USE conf_dat_m, ONLY: conf_dat3d
-  USE lmdz_libmath_pch, ONLY: pchsp_95, pchfe_95
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  CHARACTER(LEN=*), INTENT(IN) :: var
-  REAL,    INTENT(IN)  :: lon_in(:),  lat_in(:)   ! dim (iml) (jml)
-  REAL,    INTENT(IN)  :: lon_in2(:), lat_in2(:)  ! dim (iml) (jml2)
-  REAL,    INTENT(IN)  :: pls_in(:,:,:)           ! dim (iml,jml,lml)
-  REAL,    INTENT(OUT) :: var3d (:,:,:)           ! dim (iml,jml,lml)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname='start_inter_3d'
-  LOGICAL :: skip
-  REAL    :: chmin, chmax
-  INTEGER :: iml, jml, lml, jml2, ii, ij, il, ierr
-  INTEGER :: n_extrap                             ! Extrapolated points number
-  REAL, ALLOCATABLE :: ax(:), lon_rad(:), lon_ini(:), lev_dyn(:), yder(:)
-  REAL, ALLOCATABLE :: ay(:), lat_rad(:), lat_ini(:), var_tmp3d(:,:,:)
-  REAL, ALLOCATABLE, SAVE :: var_ana3d(:,:,:)
-!-------------------------------------------------------------------------------
-  iml=assert_eq(SIZE(lon_in),SIZE(lon_in2),SIZE(pls_in,1),SIZE(var3d,1),TRIM(modname)//" iml")
-  jml=assert_eq(SIZE(lat_in),              SIZE(pls_in,2),SIZE(var3d,2),TRIM(modname)//" jml")
-  lml=assert_eq(SIZE(pls_in,3),SIZE(var3d,3),TRIM(modname)//" lml"); jml2=SIZE(lat_in2)
-
-  WRITE(lunout, *)'Going into flinget to extract the 3D field.'
-  IF(.NOT.ALLOCATED(var_ana3d)) ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
-  CALL flinget(fid_dyn,var,iml_dyn,jml_dyn,llm_dyn,ttm_dyn,1,1,var_ana3d)
-
-!--- ANGLES IN DEGREES ARE CONVERTED INTO RADIANS
-  ALLOCATE(lon_ini(iml_dyn), lat_ini(jml_dyn))
-  lon_ini(:)=lon_dyn(:,1); IF(MAXVAL(lon_dyn)>pi) lon_ini=lon_ini*deg2rad
-  lat_ini(:)=lat_dyn(1,:); IF(MAXVAL(lat_dyn)>pi) lat_ini=lat_ini*deg2rad
-
-!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
-  ALLOCATE(lon_rad(iml_dyn), lat_rad(jml_dyn), lev_dyn(llm_dyn))
-  CALL conf_dat3d(var, lon_ini, lat_ini, levdyn_ini,                           &
-                       lon_rad, lat_rad, lev_dyn, var_ana3d, .TRUE.)
-  DEALLOCATE(lon_ini, lat_ini)
-
-!--- COMPUTE THE REQUIRED FIELDS USING ROUTINE grid_noro
-  ALLOCATE(var_tmp3d(iml,jml,llm_dyn))
-  DO il = 1,llm_dyn
-    CALL interp_startvar(var,il==1,lon_rad,lat_rad,var_ana3d(:,:,il),          &
-                          lon_in,lat_in,lon_in2,lat_in2,var_tmp3d(:,:,il))
-  END DO
-  DEALLOCATE(lon_rad, lat_rad)
-
-!--- VERTICAL INTERPOLATION FROM TOP OF ATMOSPHERE TO GROUND
-  ALLOCATE(ax(llm_dyn),ay(llm_dyn),yder(llm_dyn))
-  ax = lev_dyn(llm_dyn:1:-1) 
-  skip = .FALSE.
-  n_extrap = 0
-  DO ij=1, jml
-    DO ii=1, iml-1
-      ay = var_tmp3d(ii, ij, llm_dyn:1:-1)
-      yder = pchsp_95(ax, ay, ibeg=2, iend=2, vc_beg=0., vc_end=0.)
-      CALL pchfe_95(ax, ay, yder, skip, pls_in(ii, ij, lml:1:-1),              &
-           var3d(ii, ij, lml:1:-1), ierr)
-      IF(ierr<0) CALL abort_gcm(TRIM(modname),'error in pchfe_95',1)
-      n_extrap = n_extrap + ierr
+    END SELECT
+
+  END SUBROUTINE startget_dyn3d
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE start_init_dyn(lon_in, lat_in, lon_in2, lat_in2, zs, psol)
+
+    !-------------------------------------------------------------------------------
+    IMPLICIT NONE
+    !===============================================================================
+    ! Purpose:   Compute psol, knowing phis.
+    !===============================================================================
+    ! Arguments:
+    REAL, INTENT(IN) :: lon_in (:), lat_in (:)    ! dim (iml) (jml)
+    REAL, INTENT(IN) :: lon_in2(:), lat_in2(:)    ! dim (iml) (jml2)
+    REAL, INTENT(IN) :: zs  (:, :)                  ! dim (iml,jml)
+    REAL, INTENT(OUT) :: psol(:, :)                  ! dim (iml,jml)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    CHARACTER(LEN = 256) :: modname = 'start_init_dyn'
+    REAL :: date, dt
+    INTEGER :: iml, jml, jml2, itau(1)
+    REAL, ALLOCATABLE :: lon_rad(:), lon_ini(:), var_ana(:, :)
+    REAL, ALLOCATABLE :: lat_rad(:), lat_ini(:)
+    REAL, ALLOCATABLE :: z(:, :), ps(:, :), ts(:, :)
+    !-------------------------------------------------------------------------------
+    iml = assert_eq(SIZE(lon_in), SIZE(zs, 1), SIZE(psol, 1), SIZE(lon_in2), &
+            TRIM(modname) // " iml")
+    jml = assert_eq(SIZE(lat_in), SIZE(zs, 2), SIZE(psol, 2), TRIM(modname) // " jml")
+    jml2 = SIZE(lat_in2)
+
+    WRITE(lunout, *) 'Opening the surface analysis'
+    CALL flininfo(dynfname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
+    WRITE(lunout, *) 'Values read: ', iml_dyn, jml_dyn, llm_dyn, ttm_dyn
+
+    ALLOCATE(lon_dyn(iml_dyn, jml_dyn), lat_dyn(iml_dyn, jml_dyn))
+    ALLOCATE(levdyn_ini(llm_dyn))
+    CALL flinopen(dynfname, .FALSE., iml_dyn, jml_dyn, llm_dyn, &
+            lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)
+
+    !--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+    ALLOCATE(lon_ini(iml_dyn), lat_ini(jml_dyn))
+    lon_ini(:) = lon_dyn(:, 1); IF(MAXVAL(lon_dyn)>pi) lon_ini = lon_ini * deg2rad
+    lat_ini(:) = lat_dyn(1, :); IF(MAXVAL(lat_dyn)>pi) lat_ini = lat_ini * deg2rad
+
+    ALLOCATE(var_ana(iml_dyn, jml_dyn), lon_rad(iml_dyn), lat_rad(jml_dyn))
+    CALL get_var_dyn('Z', z)                        !--- SURFACE GEOPOTENTIAL
+    CALL get_var_dyn('SP', ps)                      !--- SURFACE PRESSURE
+    CALL get_var_dyn('ST', ts)                      !--- SURFACE TEMPERATURE
+    !  CALL flinclo(fid_dyn)
+    DEALLOCATE(var_ana, lon_rad, lat_rad, lon_ini, lat_ini)
+
+    !--- PSOL IS COMPUTED IN PASCALS
+    psol(:iml - 1, :) = ps(:iml - 1, :) * (1.0 + (z(:iml - 1, :) - zs(:iml - 1, :)) / 287.0          &
+            / ts(:iml - 1, :))
+    psol(iml, :) = psol(1, :)
+    DEALLOCATE(z, ps, ts)
+    psol(:, 1) = SUM(aire(1:iml - 1, 1) * psol(1:iml - 1, 1)) / apoln  !--- NORTH POLE
+    psol(:, jml) = SUM(aire(1:iml - 1, jml) * psol(1:iml - 1, jml)) / apols  !--- SOUTH POLE
+
+  CONTAINS
+
+    !-------------------------------------------------------------------------------
+
+    SUBROUTINE get_var_dyn(title, field)
+
+      !-------------------------------------------------------------------------------
+      USE conf_dat_m, ONLY: conf_dat2d
+      IMPLICIT NONE
+      !-------------------------------------------------------------------------------
+      ! Arguments:
+      CHARACTER(LEN = *), INTENT(IN) :: title
+      REAL, ALLOCATABLE, INTENT(INOUT) :: field(:, :)
+      !-------------------------------------------------------------------------------
+      ! Local variables:
+      CHARACTER(LEN = 256) :: msg
+      INTEGER :: tllm
+      !-------------------------------------------------------------------------------
+      SELECT CASE(title)
+      CASE('Z');     tllm = 0;       msg = 'geopotential'
+      CASE('SP');    tllm = 0;       msg = 'surface pressure'
+      CASE('ST');    tllm = llm_dyn; msg = 'temperature'
+      END SELECT
+      IF(.NOT.ALLOCATED(field)) THEN
+        ALLOCATE(field(iml, jml))
+        CALL flinget(fid_dyn, title, iml_dyn, jml_dyn, tllm, ttm_dyn, 1, 1, var_ana)
+        CALL conf_dat2d(title, lon_ini, lat_ini, lon_rad, lat_rad, var_ana, .TRUE.)
+        CALL interp_startvar(title, .TRUE., lon_rad, lat_rad, var_ana, &
+                lon_in, lat_in, lon_in2, lat_in2, field)
+      ELSE IF(SIZE(field)/=SIZE(z)) THEN
+        msg = 'The ' // TRIM(msg) // ' field we have does not have the right size'
+        CALL abort_gcm(TRIM(modname), msg, 1)
+      END IF
+
+    END SUBROUTINE get_var_dyn
+
+    !-------------------------------------------------------------------------------
+
+  END SUBROUTINE start_init_dyn
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE start_inter_3d(var, lon_in, lat_in, lon_in2, lat_in2, pls_in, var3d)
+
+    !-------------------------------------------------------------------------------
+    USE conf_dat_m, ONLY: conf_dat3d
+    USE lmdz_libmath_pch, ONLY: pchsp_95, pchfe_95
+    USE lmdz_libmath, ONLY: minmax
+
+    IMPLICIT NONE
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    CHARACTER(LEN = *), INTENT(IN) :: var
+    REAL, INTENT(IN) :: lon_in(:), lat_in(:)   ! dim (iml) (jml)
+    REAL, INTENT(IN) :: lon_in2(:), lat_in2(:)  ! dim (iml) (jml2)
+    REAL, INTENT(IN) :: pls_in(:, :, :)           ! dim (iml,jml,lml)
+    REAL, INTENT(OUT) :: var3d (:, :, :)           ! dim (iml,jml,lml)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    CHARACTER(LEN = 256) :: modname = 'start_inter_3d'
+    LOGICAL :: skip
+    REAL :: chmin, chmax
+    INTEGER :: iml, jml, lml, jml2, ii, ij, il, ierr
+    INTEGER :: n_extrap                             ! Extrapolated points number
+    REAL, ALLOCATABLE :: ax(:), lon_rad(:), lon_ini(:), lev_dyn(:), yder(:)
+    REAL, ALLOCATABLE :: ay(:), lat_rad(:), lat_ini(:), var_tmp3d(:, :, :)
+    REAL, ALLOCATABLE, SAVE :: var_ana3d(:, :, :)
+    !-------------------------------------------------------------------------------
+    iml = assert_eq(SIZE(lon_in), SIZE(lon_in2), SIZE(pls_in, 1), SIZE(var3d, 1), TRIM(modname) // " iml")
+    jml = assert_eq(SIZE(lat_in), SIZE(pls_in, 2), SIZE(var3d, 2), TRIM(modname) // " jml")
+    lml = assert_eq(SIZE(pls_in, 3), SIZE(var3d, 3), TRIM(modname) // " lml"); jml2 = SIZE(lat_in2)
+
+    WRITE(lunout, *)'Going into flinget to extract the 3D field.'
+    IF(.NOT.ALLOCATED(var_ana3d)) ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
+    CALL flinget(fid_dyn, var, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, var_ana3d)
+
+    !--- ANGLES IN DEGREES ARE CONVERTED INTO RADIANS
+    ALLOCATE(lon_ini(iml_dyn), lat_ini(jml_dyn))
+    lon_ini(:) = lon_dyn(:, 1); IF(MAXVAL(lon_dyn)>pi) lon_ini = lon_ini * deg2rad
+    lat_ini(:) = lat_dyn(1, :); IF(MAXVAL(lat_dyn)>pi) lat_ini = lat_ini * deg2rad
+
+    !--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
+    ALLOCATE(lon_rad(iml_dyn), lat_rad(jml_dyn), lev_dyn(llm_dyn))
+    CALL conf_dat3d(var, lon_ini, lat_ini, levdyn_ini, &
+            lon_rad, lat_rad, lev_dyn, var_ana3d, .TRUE.)
+    DEALLOCATE(lon_ini, lat_ini)
+
+    !--- COMPUTE THE REQUIRED FIELDS USING ROUTINE grid_noro
+    ALLOCATE(var_tmp3d(iml, jml, llm_dyn))
+    DO il = 1, llm_dyn
+      CALL interp_startvar(var, il==1, lon_rad, lat_rad, var_ana3d(:, :, il), &
+              lon_in, lat_in, lon_in2, lat_in2, var_tmp3d(:, :, il))
     END DO
-  END DO
-  IF(n_extrap/=0) WRITE(lunout,*)TRIM(modname)//" pchfe_95: n_extrap=", n_extrap
-  var3d(iml, :, :) = var3d(1, :, :) 
-
-  DO il=1, lml
-    CALL minmax(iml*jml, var3d(1, 1, il), chmin, chmax)
-    WRITE(lunout, *)' '//TRIM(var)//'  min max l ', il, chmin, chmax
-  END DO
-
-END SUBROUTINE start_inter_3d
-
-!-------------------------------------------------------------------------------
-
-
-!-------------------------------------------------------------------------------
-
-SUBROUTINE interp_startvar(nam,ibeg,lon,lat,vari,lon1,lat1,lon2,lat2,varo)
-
-!-------------------------------------------------------------------------------
-  USE inter_barxy_m, ONLY: inter_barxy
-  IMPLICIT NONE
-!-------------------------------------------------------------------------------
-! Arguments:
-  CHARACTER(LEN=*), INTENT(IN)  :: nam
-  LOGICAL,          INTENT(IN)  :: ibeg
-  REAL,             INTENT(IN)  :: lon(:), lat(:)   ! dim (ii) (jj)
-  REAL,             INTENT(IN)  :: vari(:,:)        ! dim (ii,jj)
-  REAL,             INTENT(IN)  :: lon1(:), lat1(:) ! dim (i1) (j1)
-  REAL,             INTENT(IN)  :: lon2(:), lat2(:) ! dim (i1) (j2)
-  REAL,             INTENT(OUT) :: varo(:,:)        ! dim (i1) (j1)
-!-------------------------------------------------------------------------------
-! Local variables:
-  CHARACTER(LEN=256) :: modname="interp_startvar"
-  INTEGER            :: ii, jj, i1, j1, j2
-  REAL, ALLOCATABLE  :: vtmp(:,:)
-!-------------------------------------------------------------------------------
-  ii=assert_eq(SIZE(lon),            SIZE(vari,1),TRIM(modname)//" ii")
-  jj=assert_eq(SIZE(lat),            SIZE(vari,2),TRIM(modname)//" jj")
-  i1=assert_eq(SIZE(lon1),SIZE(lon2),SIZE(varo,1),TRIM(modname)//" i1")
-  j1=assert_eq(SIZE(lat1),           SIZE(varo,2),TRIM(modname)//" j1")
-  j2=SIZE(lat2)
-  ALLOCATE(vtmp(i1-1,j1))
-  IF(ibeg.AND.prt_level>1) THEN
-    WRITE(lunout,*)"---------------------------------------------------------"
-    WRITE(lunout,*)"$$$ Interpolation barycentrique pour "//TRIM(nam)//" $$$"
-    WRITE(lunout,*)"---------------------------------------------------------"
-  END IF
-  CALL inter_barxy(lon, lat(:jj-1), vari, lon2(:i1-1), lat2, vtmp)
-  CALL gr_int_dyn(vtmp, varo, i1-1, j1)
-
-END SUBROUTINE interp_startvar
-
-!-------------------------------------------------------------------------------
+    DEALLOCATE(lon_rad, lat_rad)
+
+    !--- VERTICAL INTERPOLATION FROM TOP OF ATMOSPHERE TO GROUND
+    ALLOCATE(ax(llm_dyn), ay(llm_dyn), yder(llm_dyn))
+    ax = lev_dyn(llm_dyn:1:-1)
+    skip = .FALSE.
+    n_extrap = 0
+    DO ij = 1, jml
+      DO ii = 1, iml - 1
+        ay = var_tmp3d(ii, ij, llm_dyn:1:-1)
+        yder = pchsp_95(ax, ay, ibeg = 2, iend = 2, vc_beg = 0., vc_end = 0.)
+        CALL pchfe_95(ax, ay, yder, skip, pls_in(ii, ij, lml:1:-1), &
+                var3d(ii, ij, lml:1:-1), ierr)
+        IF(ierr<0) CALL abort_gcm(TRIM(modname), 'error in pchfe_95', 1)
+        n_extrap = n_extrap + ierr
+      END DO
+    END DO
+    IF(n_extrap/=0) WRITE(lunout, *)TRIM(modname) // " pchfe_95: n_extrap=", n_extrap
+    var3d(iml, :, :) = var3d(1, :, :)
+
+    DO il = 1, lml
+      CALL minmax(iml * jml, var3d(1, 1, il), chmin, chmax)
+      WRITE(lunout, *)' ' // TRIM(var) // '  min max l ', il, chmin, chmax
+    END DO
+
+  END SUBROUTINE start_inter_3d
+
+  !-------------------------------------------------------------------------------
+
+
+  !-------------------------------------------------------------------------------
+
+  SUBROUTINE interp_startvar(nam, ibeg, lon, lat, vari, lon1, lat1, lon2, lat2, varo)
+
+    !-------------------------------------------------------------------------------
+    USE inter_barxy_m, ONLY: inter_barxy
+    IMPLICIT NONE
+    !-------------------------------------------------------------------------------
+    ! Arguments:
+    CHARACTER(LEN = *), INTENT(IN) :: nam
+    LOGICAL, INTENT(IN) :: ibeg
+    REAL, INTENT(IN) :: lon(:), lat(:)   ! dim (ii) (jj)
+    REAL, INTENT(IN) :: vari(:, :)        ! dim (ii,jj)
+    REAL, INTENT(IN) :: lon1(:), lat1(:) ! dim (i1) (j1)
+    REAL, INTENT(IN) :: lon2(:), lat2(:) ! dim (i1) (j2)
+    REAL, INTENT(OUT) :: varo(:, :)        ! dim (i1) (j1)
+    !-------------------------------------------------------------------------------
+    ! Local variables:
+    CHARACTER(LEN = 256) :: modname = "interp_startvar"
+    INTEGER :: ii, jj, i1, j1, j2
+    REAL, ALLOCATABLE :: vtmp(:, :)
+    !-------------------------------------------------------------------------------
+    ii = assert_eq(SIZE(lon), SIZE(vari, 1), TRIM(modname) // " ii")
+    jj = assert_eq(SIZE(lat), SIZE(vari, 2), TRIM(modname) // " jj")
+    i1 = assert_eq(SIZE(lon1), SIZE(lon2), SIZE(varo, 1), TRIM(modname) // " i1")
+    j1 = assert_eq(SIZE(lat1), SIZE(varo, 2), TRIM(modname) // " j1")
+    j2 = SIZE(lat2)
+    ALLOCATE(vtmp(i1 - 1, j1))
+    IF(ibeg.AND.prt_level>1) THEN
+      WRITE(lunout, *)"---------------------------------------------------------"
+      WRITE(lunout, *)"$$$ Interpolation barycentrique pour " // TRIM(nam) // " $$$"
+      WRITE(lunout, *)"---------------------------------------------------------"
+    END IF
+    CALL inter_barxy(lon, lat(:jj - 1), vari, lon2(:i1 - 1), lat2, vtmp)
+    CALL gr_int_dyn(vtmp, varo, i1 - 1, j1)
+
+  END SUBROUTINE interp_startvar
+
+  !-------------------------------------------------------------------------------
 
 END MODULE etat0dyn
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90	(revision 5116)
@@ -281,5 +281,5 @@
   CALL pbl_surface_init( fder, snsrf, qsurf, tsoil )
 
-  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
+  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) THEN
      delta_tsurf = 0.
      beta_aridity = 0.
@@ -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,5 +548,5 @@
          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
Index: /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/limit_netcdf.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/limit_netcdf.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/limit_netcdf.f90	(revision 5116)
@@ -331,4 +331,5 @@
       USE indice_sol_mod
       USE lmdz_abort_physic, ONLY: abort_physic
+      USE lmdz_libmath, ONLY: minmax
 
       IMPLICIT NONE
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/test_disvert_m.F90	(revision 5116)
@@ -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
 
@@ -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/eigen.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/filtrez/eigen.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/filtrez/eigen.f90	(revision 5116)
@@ -4,7 +4,7 @@
   IMPLICIT NONE
   INCLUDE "dimensions.h"
-  real :: e( iim,iim ), d( iim )
-  real :: asm( iim )
-  integer :: im,i,j
+  REAL :: e( iim,iim ), d( iim )
+  REAL :: asm( iim )
+  INTEGER :: im,i,j
   im=iim
   !
Index: /LMDZ6/branches/Amaury_dev/libf/filtrez/lmdz_filtreg.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/filtrez/lmdz_filtreg.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/filtrez/lmdz_filtreg.F90	(revision 5116)
@@ -433,8 +433,8 @@
 
     ! local variables:
-    integer :: IP, IQ, I, J
-    real :: SM, TRESH, G, H, T, THETA, C, S, TAU
-    real :: B(N)
-    real :: Z(N)
+    INTEGER :: IP, IQ, I, J
+    REAL :: SM, TRESH, G, H, T, THETA, C, S, TAU
+    REAL :: B(N)
+    REAL :: Z(N)
 
     DO IP = 1, N
@@ -558,8 +558,8 @@
   SUBROUTINE acc(vec, d, im)
     IMPLICIT NONE
-    integer :: im
-    real :: vec(im, im), d(im)
-    integer :: i, j
-    real :: sum
+    INTEGER :: im
+    REAL :: vec(im, im), d(im)
+    INTEGER :: i, j
+    REAL :: sum
     real, external :: ssum
     do j = 1, im
@@ -573,6 +573,6 @@
       enddo
     enddo
-    return
-  end subroutine acc
+    RETURN
+  END SUBROUTINE acc
 
 
Index: DZ6/branches/Amaury_dev/libf/misc/formcoord.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/formcoord.f90	(revision 5115)
+++ 	(revision )
@@ -1,54 +1,0 @@
-
-! $Header$
-
-SUBROUTINE formcoord(unit,n,x,a,rev,text)
-  IMPLICIT NONE
-  integer :: n,unit,ndec
-  logical :: rev
-  real :: x(n),a
-  character(len=4) :: text
-
-  integer :: i,id,i1,i2,in
-  real :: dx,dxmin
-
-  if(rev) then
-     id=-1
-     i1=n
-     i2=n-1
-     in=1
-     write(unit,3000) text(1:1)
-  else
-     id=1
-     i1=1
-     i2=2
-     in=n
-  endif
-
-  if (n<2) then
-     ndec=1
-     write(unit,1000) text,n,x(1)*a
-  else
-     dxmin=abs(x(2)-x(1))
-     do i=2,n-1
-        dx=abs(x(i+1)-x(i))
-        if (dx<dxmin) dxmin=dx
-     enddo
-
-     ndec=-log10(dxmin)+2
-     if(mod(n,6)==1) then
-        write(unit,1000) text,n,x(i1)*a
-        write(unit,2000) (x(i)*a,i=i2,in,id)
-     else
-        write(unit,1000) text,n
-        write(unit,2000) (x(i)*a,i=i1,in,id)
-     endif
-  endif
-
-1000   format(a4,2x,i4,' LEVELS',43x,f12.2)
-2000   format(6f12.2)
-  !1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
-  !2000  format(6f12.<ndec>)
-3000   format('FORMAT ',a1,'REV')
-
-
-end subroutine formcoord
Index: DZ6/branches/Amaury_dev/libf/misc/interpolation.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/interpolation.F90	(revision 5115)
+++ 	(revision )
@@ -1,138 +1,0 @@
-! $Id$
-module interpolation
-
-  ! From Press et al., 1996, version 2.10a
-  ! B3 Interpolation and Extrapolation
-
-  IMPLICIT NONE 
-
-contains
-
-  pure FUNCTION locate(xx,x)
-
-    REAL, DIMENSION(:), INTENT(IN) :: xx
-    REAL, INTENT(IN) :: x
-    INTEGER  locate
-
-    ! Given an array xx(1:N), and given a value x, returns a value j,
-    ! between 0 and N, such that x is between xx(j) and xx(j + 1). xx
-    ! must be monotonic, either increasing or decreasing. j = 0 or j =
-    ! N is returned to indicate that x is out of range. This
-    ! procedure should not be called with a zero-sized array argument.
-    ! See notes.
-
-    INTEGER  n,jl,jm,ju
-    LOGICAL  ascnd
-
-    !----------------------------
-
-    n=size(xx)
-    ascnd = (xx(n) >= xx(1))
-    ! (True if ascending order of table, false otherwise.)
-    ! Initialize lower and upper limits:
-    jl=0
-    ju=n+1
-    do while (ju-jl > 1)
-       jm=(ju+jl)/2 ! Compute a midpoint,
-       if (ascnd .eqv. (x >= xx(jm))) then
-          jl=jm ! and replace either the lower limit
-       else
-          ju=jm ! or the upper limit, as appropriate.
-       end if
-    END DO
-    ! {ju == jl + 1}
-
-    ! {(ascnd .and. xx(jl) <= x < xx(jl+1)) 
-    !  .neqv. 
-    !  (.not. ascnd .and. xx(jl+1) <= x < xx(jl))}
-
-    ! Then set the output, being careful with the endpoints:
-    if (x == xx(1)) then
-       locate=1
-    else if (x == xx(n)) then
-       locate=n-1
-    else
-       locate=jl
-    end if
-
-  END FUNCTION locate
-
-  !***************************
-
-  pure SUBROUTINE hunt(xx,x,jlo)
-
-    ! Given an array xx(1:N ), and given a value x, returns a value
-    ! jlo such that x is between xx(jlo) and xx(jlo+1). xx must be
-    ! monotonic, either increasing or decreasing. jlo = 0 or jlo = N is
-    ! returned to indicate that x is out of range. jlo on input is taken as
-    ! the initial guess for jlo on output.
-    ! Modified so that it uses the information "jlo = 0" on input.
-
-    INTEGER, INTENT(INOUT) :: jlo
-    REAL, INTENT(IN) :: x
-    REAL, DIMENSION(:), INTENT(IN) :: xx
-    INTEGER  n,inc,jhi,jm
-    LOGICAL  ascnd, hunt_up
-
-    !-----------------------------------------------------
-
-    n=size(xx)
-    ascnd = (xx(n) >= xx(1))
-    ! (True if ascending order of table, false otherwise.)
-    if (jlo < 0 .or. jlo > n) then
-       ! Input guess not useful. Go immediately to bisection.
-       jlo=0
-       jhi=n+1
-    else
-       inc=1 ! Set the hunting increment.
-       if (jlo == 0) then
-          hunt_up = .TRUE.
-       else
-          hunt_up = x >= xx(jlo) .eqv. ascnd
-       end if
-       if (hunt_up) then ! Hunt up:
-          do
-             jhi=jlo+inc
-             if (jhi > n) then ! Done hunting, since off end of table.
-                jhi=n+1
-                exit
-             else
-                if (x < xx(jhi) .eqv. ascnd) exit
-                jlo=jhi ! Not done hunting,
-                inc=inc+inc ! so double the increment
-             end if
-          END DO ! and try again.
-       else ! Hunt down:
-          jhi=jlo
-          do
-             jlo=jhi-inc
-             if (jlo < 1) then ! Done hunting, since off end of table.
-                jlo=0
-                exit
-             else
-                if (x >= xx(jlo) .eqv. ascnd) exit
-                jhi=jlo ! Not done hunting,
-                inc=inc+inc ! so double the increment
-             end if
-          END DO ! and try again.
-       end if
-    end if ! Done hunting, value bracketed.
-
-    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
-          exit
-       else
-          jm=(jhi+jlo)/2
-          if (x >= xx(jm) .eqv. ascnd) then
-             jlo=jm
-          else
-             jhi=jm
-          end if
-       end if
-    END DO
-
-  END SUBROUTINE hunt
-
-end module interpolation
Index: DZ6/branches/Amaury_dev/libf/misc/ismax.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/ismax.f90	(revision 5115)
+++ 	(revision )
@@ -1,24 +1,0 @@
-
-! $Header$
-
-function ismax(n,sx,incx)
-  !
-  IMPLICIT NONE
-  !
-  INTEGER :: n,i,incx,ismax,ix
-  real :: sx((n-1)*incx+1),sxmax
-  !
-  ix=1
-  ismax=1
-  sxmax=sx(1)
-  do i=1,n-1
-   ix=ix+incx
-   if(sx(ix)>sxmax) then
-     sxmax=sx(ix)
-     ismax=i+1
-   endif
-  END DO
-  !
-
-end function ismax
-
Index: DZ6/branches/Amaury_dev/libf/misc/ismin.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/ismin.f90	(revision 5115)
+++ 	(revision )
@@ -1,24 +1,0 @@
-
-! $Header$
-
-FUNCTION ismin(n,sx,incx)
-  !
-  IMPLICIT NONE
-  !
-  integer :: n,i,incx,ismin,ix
-  real :: sx((n-1)*incx+1),sxmin
-  !
-  ix=1
-  ismin=1
-  sxmin=sx(1)
-  DO i=1,n-1
-     ix=ix+incx
-     if(sx(ix)<sxmin) then
-         sxmin=sx(ix)
-         ismin=i+1
-     endif
-  ENDDO
-  !
-
-end function ismin
-!
Index: DZ6/branches/Amaury_dev/libf/misc/j4save.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/j4save.f90	(revision 5115)
+++ 	(revision )
@@ -1,67 +1,0 @@
-!DECK J4SAVE
-FUNCTION J4SAVE(IWHICH, IVALUE, ISET)
-  IMPLICIT NONE
-  !***BEGIN PROLOGUE  J4SAVE
-  !***SUBSIDIARY
-  !***PURPOSE  Save or reCALL global variables needed by error
-         ! handling routines.
-  !***LIBRARY   SLATEC (XERROR)
-  !***TYPE      INTEGER (J4SAVE-I)
-  !***KEYWORDS  ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
-  !***AUTHOR  Jones, R. E., (SNLA)
-  !***DESCRIPTION
-  !
-  ! Abstract
-  !    J4SAVE saves and recalls several global variables needed
-  !    by the library error handling routines.
-  !
-  ! Description of Parameters
-  !  --Input--
-  !    IWHICH - Index of item desired.
-  !            = 1 Refers to current error number.
-  !            = 2 Refers to current error control flag.
-  !            = 3 Refers to current unit number to which error
-  !                messages are to be sent.  (0 means use standard.)
-  !            = 4 Refers to the maximum number of times any
-  !                 message is to be printed (as set by XERMAX).
-  !            = 5 Refers to the total number of units to which
-  !                 each error message is to be written.
-  !            = 6 Refers to the 2nd unit for error messages
-  !            = 7 Refers to the 3rd unit for error messages
-  !            = 8 Refers to the 4th unit for error messages
-  !            = 9 Refers to the 5th unit for error messages
-  !    IVALUE - The value to be set for the IWHICH-th parameter,
-  !             if ISET is .TRUE. .
-  !    ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
-  !             given the value, IVALUE.  If ISET=.FALSE., the
-  !             IWHICH-th parameter will be unchanged, and IVALUE
-  !             is a dummy parameter.
-  !  --Output--
-  !    The (old) value of the IWHICH-th parameter will be returned
-  !    in the function value, J4SAVE.
-  !
-  !***SEE ALSO  XERMSG
-  !***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
-  !             Error-handling Package, SAND82-0800, Sandia
-  !             Laboratories, 1982.
-  !***ROUTINES CALLED  (NONE)
-  !***REVISION HISTORY  (YYMMDD)
-  !   790801  DATE WRITTEN
-  !   891214  Prologue converted to Version 4.0 format.  (BAB)
-  !   900205  Minor modifications to prologue.  (WRB)
-  !   900402  Added TYPE section.  (WRB)
-  !   910411  Added KEYWORDS section.  (WRB)
-  !   920501  Reformatted the REFERENCES section.  (WRB)
-  !***END PROLOGUE  J4SAVE
-  LOGICAL :: ISET
-  INTEGER :: IPARAM(9)
-  SAVE IPARAM
-  DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/
-  DATA IPARAM(5)/1/
-  DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
-  INTEGER :: J4SAVE,IWHICH,IVALUE
-  !***FIRST EXECUTABLE STATEMENT  J4SAVE
-  J4SAVE = IPARAM(IWHICH)
-  IF (ISET) IPARAM(IWHICH) = IVALUE
-
-END FUNCTION J4SAVE
Index: DZ6/branches/Amaury_dev/libf/misc/juldate.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/juldate.f90	(revision 5115)
+++ 	(revision )
@@ -1,39 +1,0 @@
-
-! $Id$
-
-  SUBROUTINE juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
-  ! Sous-routine de changement de date:
-  ! gregorien>>>date julienne
-  ! En entree:an,mois,jour,heure,min.,sec.
-  ! En sortie:tjd
-    IMPLICIT NONE
-    INTEGER,INTENT(IN) :: ian,imoi,ijou,oh,om,os
-    REAL,INTENT(OUT) :: tjd,tjdsec
-
-    REAL :: frac,year,rmon,cf,a,b
-    INTEGER :: ojou
-
-    frac=((os/60.+om)/60.+oh)/24.
-    ojou=dble(ijou)+frac
-        year=dble(ian)
-        rmon=dble(imoi)
-    if (imoi <= 2) then
-        year=year-1.
-        rmon=rmon+12.
-    endif
-    cf=year+(rmon/100.)+(ojou/10000.)
-    if (cf >= 1582.1015) then
-        a=int(year/100)
-        b=2-a+int(a/4)
-    else
-        b=0
-    endif
-    tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou) &
-          +1720994.5+b
-    tjdsec=(ojou-int(ojou))+(tjd-int(tjd))
-    tjd=int(tjd)+int(tjdsec)
-    tjdsec=tjdsec-int(tjdsec)
-
-end subroutine juldate
-
-
Index: /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90	(revision 5116)
@@ -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_coefpoly.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90	(revision 5116)
@@ -1,5 +1,6 @@
 module lmdz_coefpoly
 
-  IMPLICIT NONE
+  IMPLICIT NONE; PRIVATE
+  PUBLIC coefpoly
 
 contains
@@ -25,5 +26,5 @@
     ! a0, a1, a2, a3.
 
-    use nrtype, only: k8
+    use nrtype, ONLY: k8
 
     REAL(K8), intent(in) :: xf1, xf2, xprim1, xprim2, xtild1, xtild2
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 5116)
@@ -0,0 +1,54 @@
+MODULE lmdz_formcoord
+  IMPLICIT NONE; PRIVATE
+  PUBLIC formcoord
+CONTAINS
+
+  SUBROUTINE formcoord(unit, n, x, a, rev, text)
+    IMPLICIT NONE
+    INTEGER :: n, unit, ndec
+    logical :: rev
+    REAL :: x(n), a
+    CHARACTER(LEN = 4) :: text
+
+    INTEGER :: i, id, i1, i2, in
+    REAL :: dx, dxmin
+
+    IF(rev) THEN
+      id = -1
+      i1 = n
+      i2 = n - 1
+      in = 1
+      WRITE(unit, 3000) text(1:1)
+    else
+      id = 1
+      i1 = 1
+      i2 = 2
+      in = n
+    endif
+
+    if (n<2) THEN
+      ndec = 1
+      WRITE(unit, 1000) text, n, x(1) * a
+    else
+      dxmin = abs(x(2) - x(1))
+      do i = 2, n - 1
+        dx = abs(x(i + 1) - x(i))
+        if (dx<dxmin) dxmin = dx
+      enddo
+
+      ndec = -log10(dxmin) + 2
+      IF(mod(n, 6)==1) THEN
+        WRITE(unit, 1000) text, n, x(i1) * a
+        WRITE(unit, 2000) (x(i) * a, i=i2, in, id)
+      else
+        WRITE(unit, 1000) text, n
+        WRITE(unit, 2000) (x(i) * a, i=i1, in, id)
+      endif
+    endif
+
+    1000   format(a4, 2x, i4, ' LEVELS', 43x, f12.2)
+    2000   format(6f12.2)
+    3000   format('FORMAT ', a1, 'REV')
+
+  END SUBROUTINE formcoord
+END MODULE lmdz_formcoord
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 5116)
@@ -0,0 +1,139 @@
+! $Id$
+module lmdz_interpolation
+
+  ! From Press et al., 1996, version 2.10a
+  ! B3 Interpolation and Extrapolation
+
+  IMPLICIT NONE; PRIVATE
+  PUBLIC locate, hunt
+
+contains
+
+  pure FUNCTION locate(xx, x)
+
+    REAL, DIMENSION(:), INTENT(IN) :: xx
+    REAL, INTENT(IN) :: x
+    INTEGER  locate
+
+    ! Given an array xx(1:N), and given a value x, returns a value j,
+    ! between 0 and N, such that x is between xx(j) and xx(j + 1). xx
+    ! must be monotonic, either increasing or decreasing. j = 0 or j =
+    ! N is returned to indicate that x is out of range. This
+    ! procedure should not be called with a zero-sized array argument.
+    ! See notes.
+
+    INTEGER  n, jl, jm, ju
+    LOGICAL  ascnd
+
+    !----------------------------
+
+    n = size(xx)
+    ascnd = (xx(n) >= xx(1))
+    ! (True if ascending order of table, false otherwise.)
+    ! Initialize lower and upper limits:
+    jl = 0
+    ju = n + 1
+    do while (ju - jl > 1)
+      jm = (ju + jl) / 2 ! Compute a midpoint,
+      if (ascnd .eqv. (x >= xx(jm))) THEN
+        jl = jm ! and replace either the lower limit
+      else
+        ju = jm ! or the upper limit, as appropriate.
+      end if
+    END DO
+    ! {ju == jl + 1}
+
+    ! {(ascnd .and. xx(jl) <= x < xx(jl+1)) 
+    !  .neqv. 
+    !  (.not. ascnd .and. xx(jl+1) <= x < xx(jl))}
+
+    ! Then set the output, being careful with the endpoints:
+    if (x == xx(1)) THEN
+      locate = 1
+    else if (x == xx(n)) THEN
+      locate = n - 1
+    else
+      locate = jl
+    end if
+
+  END FUNCTION locate
+
+  !***************************
+
+  pure SUBROUTINE hunt(xx, x, jlo)
+
+    ! Given an array xx(1:N ), and given a value x, returns a value
+    ! jlo such that x is between xx(jlo) and xx(jlo+1). xx must be
+    ! monotonic, either increasing or decreasing. jlo = 0 or jlo = N is
+    ! returned to indicate that x is out of range. jlo on input is taken as
+    ! the initial guess for jlo on output.
+    ! Modified so that it uses the information "jlo = 0" on input.
+
+    INTEGER, INTENT(INOUT) :: jlo
+    REAL, INTENT(IN) :: x
+    REAL, DIMENSION(:), INTENT(IN) :: xx
+    INTEGER  n, inc, jhi, jm
+    LOGICAL  ascnd, hunt_up
+
+    !-----------------------------------------------------
+
+    n = size(xx)
+    ascnd = (xx(n) >= xx(1))
+    ! (True if ascending order of table, false otherwise.)
+    if (jlo < 0 .or. jlo > n) THEN
+      ! Input guess not useful. Go immediately to bisection.
+      jlo = 0
+      jhi = n + 1
+    else
+      inc = 1 ! Set the hunting increment.
+      if (jlo == 0) THEN
+        hunt_up = .TRUE.
+      else
+        hunt_up = x >= xx(jlo) .eqv. ascnd
+      end if
+      if (hunt_up) then ! Hunt up:
+        do
+          jhi = jlo + inc
+          if (jhi > n) then ! Done hunting, since off end of table.
+            jhi = n + 1
+            exit
+          else
+            if (x < xx(jhi) .eqv. ascnd) exit
+            jlo = jhi ! Not done hunting,
+            inc = inc + inc ! so double the increment
+          end if
+        END DO ! and try again.
+      else ! Hunt down:
+        jhi = jlo
+        do
+          jlo = jhi - inc
+          if (jlo < 1) then ! Done hunting, since off end of table.
+            jlo = 0
+            exit
+          else
+            if (x >= xx(jlo) .eqv. ascnd) exit
+            jhi = jlo ! Not done hunting,
+            inc = inc + inc ! so double the increment
+          end if
+        END DO ! and try again.
+      end if
+    end if ! Done hunting, value bracketed.
+
+    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
+        exit
+      else
+        jm = (jhi + jlo) / 2
+        if (x >= xx(jm) .eqv. ascnd) THEN
+          jlo = jm
+        else
+          jhi = jm
+        end if
+      end if
+    END DO
+
+  END SUBROUTINE hunt
+
+end module lmdz_interpolation
Index: /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath.f90	(revision 5116)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath.f90	(revision 5116)
@@ -0,0 +1,61 @@
+! Library for misc. useful math functions
+
+MODULE lmdz_libmath
+  IMPLICIT NONE; PRIVATE
+  PUBLIC ismin, ismax
+
+CONTAINS
+
+  function ismax(n, sx, incx)
+    INTEGER :: n, i, incx, ismax, ix
+    REAL :: sx((n - 1) * incx + 1), sxmax
+
+    ix = 1
+    ismax = 1
+    sxmax = sx(1)
+    do i = 1, n - 1
+      ix = ix + incx
+      IF(sx(ix)>sxmax) THEN
+        sxmax = sx(ix)
+        ismax = i + 1
+      endif
+    END DO
+  END FUNCTION ismax
+
+
+  FUNCTION ismin(n, sx, incx)
+    INTEGER :: n, i, incx, ismin, ix
+    REAL :: sx((n - 1) * incx + 1), sxmin
+    !
+    ix = 1
+    ismin = 1
+    sxmin = sx(1)
+    DO i = 1, n - 1
+      ix = ix + incx
+      IF(sx(ix)<sxmin) THEN
+        sxmin = sx(ix)
+        ismin = i + 1
+      endif
+    ENDDO
+  END FUNCTION ismin
+
+  SUBROUTINE minmax(imax, xi, zmin, zmax)
+    !
+    !  P. Le Van
+
+    INTEGER :: imax
+    REAL :: xi(imax)
+    REAL :: zmin, zmax
+    INTEGER :: i
+
+    zmin = xi(1)
+    zmax = xi(1)
+
+    DO i = 2, imax
+      zmin = MIN(zmin, xi(i))
+      zmax = MAX(zmax, xi(i))
+    ENDDO
+
+  END SUBROUTINE minmax
+
+END MODULE lmdz_libmath
Index: /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath_pch.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath_pch.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_libmath_pch.f90	(revision 5116)
@@ -489,5 +489,5 @@
     ! the points  XE.
 
-    use lmdz_assert_eq, only: assert_eq
+    use lmdz_assert_eq, ONLY: assert_eq
 
     REAL, intent(in) :: X(:) ! real array of independent variable values
@@ -572,5 +572,5 @@
     ! 2001, pages 43-47
 
-    use lmdz_assert_eq, only: assert_eq
+    use lmdz_assert_eq, ONLY: assert_eq
 
     real, intent(in) :: x(:)
@@ -638,9 +638,9 @@
 
     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
Index: /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_xer.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_xer.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/lmdz_xer.f90	(revision 5116)
@@ -748,5 +748,5 @@
     !     intrinsic function LEN is used to determine its length.  If
     !         it is zero, PREFIX is not used.  If it exceeds 16 or if
-    !     LEN(PREFIX) exceeds 16, only the first 16 characters will be
+    !     LEN(PREFIX) exceeds 16, ONLY the first 16 characters will be
     !     used.  If NPREF is positive and the length of PREFIX is less
     !     than NPREF, a copy of PREFIX extended with blanks to length
@@ -1055,4 +1055,72 @@
   END SUBROUTINE XERCNT
 
+  !DECK J4SAVE
+  FUNCTION J4SAVE(IWHICH, IVALUE, ISET)
+    IMPLICIT NONE
+    !***BEGIN PROLOGUE  J4SAVE
+    !***SUBSIDIARY
+    !***PURPOSE  Save or reCALL global variables needed by error
+    ! handling routines.
+    !***LIBRARY   SLATEC (XERROR)
+    !***TYPE      INTEGER (J4SAVE-I)
+    !***KEYWORDS  ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
+    !***AUTHOR  Jones, R. E., (SNLA)
+    !***DESCRIPTION
+    !
+    ! Abstract
+    !    J4SAVE saves and recalls several global variables needed
+    !    by the library error handling routines.
+    !
+    ! Description of Parameters
+    !  --Input--
+    !    IWHICH - Index of item desired.
+    !            = 1 Refers to current error number.
+    !            = 2 Refers to current error control flag.
+    !            = 3 Refers to current unit number to which error
+    !                messages are to be sent.  (0 means use standard.)
+    !            = 4 Refers to the maximum number of times any
+    !                 message is to be printed (as set by XERMAX).
+    !            = 5 Refers to the total number of units to which
+    !                 each error message is to be written.
+    !            = 6 Refers to the 2nd unit for error messages
+    !            = 7 Refers to the 3rd unit for error messages
+    !            = 8 Refers to the 4th unit for error messages
+    !            = 9 Refers to the 5th unit for error messages
+    !    IVALUE - The value to be set for the IWHICH-th parameter,
+    !             if ISET is .TRUE. .
+    !    ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
+    !             given the value, IVALUE.  If ISET=.FALSE., the
+    !             IWHICH-th parameter will be unchanged, and IVALUE
+    !             is a dummy parameter.
+    !  --Output--
+    !    The (old) value of the IWHICH-th parameter will be returned
+    !    in the function value, J4SAVE.
+    !
+    !***SEE ALSO  XERMSG
+    !***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+    !             Error-handling Package, SAND82-0800, Sandia
+    !             Laboratories, 1982.
+    !***ROUTINES CALLED  (NONE)
+    !***REVISION HISTORY  (YYMMDD)
+    !   790801  DATE WRITTEN
+    !   891214  Prologue converted to Version 4.0 format.  (BAB)
+    !   900205  Minor modifications to prologue.  (WRB)
+    !   900402  Added TYPE section.  (WRB)
+    !   910411  Added KEYWORDS section.  (WRB)
+    !   920501  Reformatted the REFERENCES section.  (WRB)
+    !***END PROLOGUE  J4SAVE
+    LOGICAL :: ISET
+    INTEGER :: IPARAM(9)
+    SAVE IPARAM
+    DATA IPARAM(1), IPARAM(2), IPARAM(3), IPARAM(4)/0, 2, 0, 10/
+    DATA IPARAM(5)/1/
+    DATA IPARAM(6), IPARAM(7), IPARAM(8), IPARAM(9)/0, 0, 0, 0/
+    INTEGER :: J4SAVE, IWHICH, IVALUE
+    !***FIRST EXECUTABLE STATEMENT  J4SAVE
+    J4SAVE = IPARAM(IWHICH)
+    IF (ISET) IPARAM(IWHICH) = IVALUE
+
+  END FUNCTION J4SAVE
+
 
 END MODULE lmdz_xer
Index: DZ6/branches/Amaury_dev/libf/misc/minmax.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/minmax.f90	(revision 5115)
+++ 	(revision )
@@ -1,23 +1,0 @@
-
-! $Header$
-
- SUBROUTINE minmax(imax, xi, zmin, zmax )
-  !
-  !  P. Le Van
-
-   INTEGER :: imax
-   REAL :: xi(imax)
-   REAL :: zmin,zmax
-   INTEGER :: i
-
-   zmin = xi(1)
-   zmax = xi(1)
-
-   DO i = 2, imax
-     zmin = MIN( zmin,xi(i) )
-     zmax = MAX( zmax,xi(i) )
-   ENDDO
-
-
-END SUBROUTINE minmax
-
Index: DZ6/branches/Amaury_dev/libf/misc/minmax2.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/minmax2.f90	(revision 5115)
+++ 	(revision )
@@ -1,20 +1,0 @@
-
-! $Header$
-
- SUBROUTINE minmax2(imax, jmax, lmax, xi, zmin, zmax )
-  !
-   INTEGER :: lmax,jmax,imax
-   REAL :: xi(imax*jmax*lmax)
-   REAL :: zmin,zmax
-   INTEGER :: i
-
-   zmin = xi(1)
-   zmax = xi(1)
-
-   DO i = 2, imax*jmax*lmax
-     zmin = MIN( zmin,xi(i) )
-     zmax = MAX( zmax,xi(i) )
-   ENDDO
-
-
-END SUBROUTINE minmax2
Index: /LMDZ6/branches/Amaury_dev/libf/misc/q_sat.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/q_sat.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/q_sat.f90	(revision 5116)
@@ -19,5 +19,5 @@
   !======================================================================
 
-  integer :: np
+  INTEGER :: np
   REAL :: temp(np),pres(np),qsat(np)
 
@@ -39,6 +39,6 @@
   PARAMETER (retv=28.9644/18.0153 - 1.0)
 
-  real :: zqsat
-  integer :: ip
+  REAL :: zqsat
+  INTEGER :: ip
 
   ! ------------------------------------------------------------------
@@ -47,6 +47,6 @@
   do ip=1,np
 
-   ! write(*,*)'kelvin,millibar=',kelvin,millibar
-   !  write(*,*)'temp,pres=',temp(ip),pres(ip)
+   ! WRITE(*,*)'kelvin,millibar=',kelvin,millibar
+   !  WRITE(*,*)'temp,pres=',temp(ip),pres(ip)
 
      IF (temp(ip) <= rtt) THEN
@@ -63,5 +63,5 @@
 
      qsat(ip)= zqsat
-   ! write(*,*)'qsat=',qsat(ip)
+   ! WRITE(*,*)'qsat=',qsat(ip)
 
   enddo
Index: /LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90	(revision 5116)
@@ -30,7 +30,7 @@
     ! "vs" has rank 1.
 
-    use lmdz_assert_eq, only: assert_eq
-    use lmdz_assert, only: assert
-    use interpolation, only: locate
+    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
@@ -81,5 +81,5 @@
     END DO
 
-  end function regr11_step_av
+  END FUNCTION regr11_step_av
 
   !********************************************
@@ -89,7 +89,7 @@
     ! "vs" has rank 2.
 
-    use lmdz_assert_eq, only: assert_eq
-    use lmdz_assert, only: assert
-    use interpolation, only: locate
+    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
@@ -141,5 +141,5 @@
     END DO
 
-  end function regr12_step_av
+  END FUNCTION regr12_step_av
 
   !********************************************
@@ -149,7 +149,7 @@
     ! "vs" has rank 3.
 
-    use lmdz_assert_eq, only: assert_eq
-    use lmdz_assert, only: assert
-    use interpolation, only: locate
+    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
@@ -202,5 +202,5 @@
     END DO
 
-  end function regr13_step_av
+  END FUNCTION regr13_step_av
 
   !********************************************
@@ -210,7 +210,7 @@
     ! "vs" has rank 4.
 
-    use lmdz_assert_eq, only: assert_eq
-    use lmdz_assert, only: assert
-    use interpolation, only: locate
+    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
@@ -264,5 +264,5 @@
     END DO
 
-  end function regr14_step_av
+  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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/regr_conserv_m.F90	(revision 5116)
@@ -3,5 +3,5 @@
   USE lmdz_assert_eq,   ONLY: assert_eq
   USE lmdz_assert,      ONLY: assert
-  USE interpolation, ONLY: locate
+  use lmdz_interpolation, ONLY: locate
 
   IMPLICIT NONE
Index: /LMDZ6/branches/Amaury_dev/libf/misc/regr_lint_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/regr_lint_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/regr_lint_m.F90	(revision 5116)
@@ -3,5 +3,5 @@
   USE lmdz_assert_eq,   ONLY: assert_eq
   USE lmdz_assert,      ONLY: assert
-  USE interpolation, ONLY: hunt
+  use lmdz_interpolation, ONLY: hunt
 
   IMPLICIT NONE
Index: /LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90	(revision 5116)
@@ -20,5 +20,5 @@
 #ifdef USE_VT
     include 'VT.inc'
-    integer :: ierr
+    INTEGER :: ierr
     
     CALL VTSYMDEF(VTcaldyn,"caldyn","caldyn",ierr)
@@ -33,5 +33,5 @@
 #ifdef USE_MPE
     include 'mpe_logf.h' 
-    integer :: ierr,i
+    INTEGER :: ierr,i
     
     DO i=1,nb_inst
@@ -54,5 +54,5 @@
 #ifdef USE_VT    
     include 'VT.inc'
-    integer :: ierr
+    INTEGER :: ierr
     
     CALL VTBEGIN(number,ierr)
@@ -60,5 +60,5 @@
 #ifdef USE_MPE
     include 'mpe_logf.h' 
-    integer :: ierr,i
+    INTEGER :: ierr,i
     ierr = MPE_Log_event( MPE_begin(number), 0, '' )
 #endif
@@ -71,5 +71,5 @@
 #ifdef USE_VT    
     include 'VT.inc'
-    integer :: ierr
+    INTEGER :: ierr
    
     CALL VTEND(number,ierr)
@@ -78,5 +78,5 @@
 #ifdef USE_MPE
     include 'mpe_logf.h' 
-    integer :: ierr,i
+    INTEGER :: ierr,i
     ierr = MPE_Log_event( MPE_end(number), 0, '' )
 #endif
Index: /LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90	(revision 5116)
@@ -12,5 +12,5 @@
   integer, dimension(MaxWriteField), save :: FieldVarId
   integer, dimension(MaxWriteField), save :: FieldIndex
-  character(len = 255), dimension(MaxWriteField) :: FieldName
+  CHARACTER(LEN = 255), dimension(MaxWriteField) :: FieldName
 
   integer, save :: NbField = 0
@@ -23,9 +23,9 @@
   function GetFieldIndex(name)
     IMPLICIT NONE
-    integer :: GetFieldindex
-    character(len = *) :: name
-
-    character(len = 255) :: TrueName
-    integer :: i
+    INTEGER :: GetFieldindex
+    CHARACTER(LEN = *) :: name
+
+    CHARACTER(LEN = 255) :: TrueName
+    INTEGER :: i
 
     TrueName = TRIM(ADJUSTL(name))
@@ -33,14 +33,14 @@
     GetFieldIndex = -1
     do i = 1, NbField
-      if (TrueName==FieldName(i)) then
+      if (TrueName==FieldName(i)) THEN
         GetFieldIndex = i
         exit
       endif
     enddo
-  end function GetFieldIndex
+  END FUNCTION GetFieldIndex
 
   subroutine WriteField3d(name, Field)
     IMPLICIT NONE
-    character(len = *) :: name
+    CHARACTER(LEN = *) :: name
     real, dimension(:, :, :) :: Field
     integer, dimension(3) :: Dim
@@ -49,9 +49,9 @@
     CALL WriteField_gen(name, Field, Dim(1), Dim(2), Dim(3))
 
-  end subroutine WriteField3d
+  END SUBROUTINE WriteField3d
 
   subroutine WriteField2d(name, Field)
     IMPLICIT NONE
-    character(len = *) :: name
+    CHARACTER(LEN = *) :: name
     real, dimension(:, :) :: Field
     integer, dimension(2) :: Dim
@@ -60,9 +60,9 @@
     CALL WriteField_gen(name, Field, Dim(1), Dim(2), 1)
 
-  end subroutine WriteField2d
+  END SUBROUTINE WriteField2d
 
   subroutine WriteField1d(name, Field)
     IMPLICIT NONE
-    character(len = *) :: name
+    CHARACTER(LEN = *) :: name
     real, dimension(:) :: Field
     integer, dimension(1) :: Dim
@@ -71,19 +71,19 @@
     CALL WriteField_gen(name, Field, Dim(1), 1, 1)
 
-  end subroutine WriteField1d
+  END SUBROUTINE WriteField1d
 
   subroutine WriteField_gen(name, Field, dimx, dimy, dimz)
     IMPLICIT NONE
-    character(len = *) :: name
-    integer :: dimx, dimy, dimz
+    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)
+    INTEGER :: status
+    INTEGER :: index
+    INTEGER :: start(4)
+    INTEGER :: count(4)
 
     Index = GetFieldIndex(name)
-    if (Index==-1) then
+    if (Index==-1) THEN
       CALL CreateNewField(name, dimx, dimy, dimz)
       Index = GetFieldIndex(name)
@@ -105,12 +105,12 @@
     status = nf90_sync(FieldId(Index))
 
-  end subroutine WriteField_gen
+  END SUBROUTINE WriteField_gen
 
   subroutine CreateNewField(name, dimx, dimy, dimz)
     IMPLICIT NONE
-    character(len = *) :: name
-    integer :: dimx, dimy, dimz
-    integer :: TabDim(4)
-    integer :: status
+    CHARACTER(LEN = *) :: name
+    INTEGER :: dimx, dimy, dimz
+    INTEGER :: TabDim(4)
+    INTEGER :: status
 
     NbField = NbField + 1
@@ -126,5 +126,5 @@
     status = nf90_enddef(FieldId(NbField))
 
-  end subroutine CreateNewField
+  END SUBROUTINE CreateNewField
 
   subroutine write_field1D(name, Field)
@@ -132,16 +132,16 @@
 
     integer, parameter :: MaxDim = 1
-    character(len = *) :: name
+    CHARACTER(LEN = *) :: name
     real, dimension(:) :: Field
     real, dimension(:), allocatable :: New_Field
-    character(len = 20) :: str
+    CHARACTER(LEN = 20) :: str
     integer, dimension(MaxDim) :: Dim
-    integer :: i, nb
+    INTEGER :: i, nb
     integer, parameter :: id = 10
     integer, parameter :: NbCol = 4
-    integer :: ColumnSize
-    integer :: pos
-    character(len = 255) :: form
-    character(len = 255) :: MaxLen
+    INTEGER :: ColumnSize
+    INTEGER :: pos
+    CHARACTER(LEN = 255) :: form
+    CHARACTER(LEN = 255) :: MaxLen
 
     open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
@@ -155,5 +155,5 @@
       nb = nb + 1
 
-      if (MOD(nb, NbCol)==0) then
+      if (MOD(nb, NbCol)==0) THEN
         form = '(t' // trim(int2str(pos)) // ',i' // trim(MaxLen) // '," ---> ",g22.16,/)'
         Pos = 2
@@ -167,5 +167,5 @@
     close(id)
 
-  end subroutine write_field1D
+  END SUBROUTINE write_field1D
 
   subroutine write_field2D(name, Field)
@@ -173,16 +173,16 @@
 
     integer, parameter :: MaxDim = 2
-    character(len = *) :: name
+    CHARACTER(LEN = *) :: name
     real, dimension(:, :) :: Field
     real, dimension(:, :), allocatable :: New_Field
-    character(len = 20) :: str
+    CHARACTER(LEN = 20) :: str
     integer, dimension(MaxDim) :: Dim
-    integer :: i, j, nb
+    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
+    INTEGER :: ColumnSize
+    INTEGER :: pos, offset
+    CHARACTER(LEN = 255) :: form
+    CHARACTER(LEN = 255) :: spacing
 
     open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
@@ -201,5 +201,5 @@
         nb = nb + 1
 
-        if (MOD(nb, NbCol)==0) then
+        if (MOD(nb, NbCol)==0) THEN
           form = '(t' // trim(int2str(pos)) // &
                   ',"(' // trim(int2str(j)) // ','          &
@@ -218,5 +218,5 @@
         write (id, form, advance = 'no') Field(j, i)
       enddo
-      if (MOD(nb, NbCol)==0) then
+      if (MOD(nb, NbCol)==0) THEN
         write (id, spacing)
       else
@@ -226,5 +226,5 @@
     enddo
 
-  end subroutine write_field2D
+  END SUBROUTINE write_field2D
 
   subroutine write_field3D(name, Field)
@@ -232,15 +232,15 @@
 
     integer, parameter :: MaxDim = 3
-    character(len = *) :: name
+    CHARACTER(LEN = *) :: name
     real, dimension(:, :, :) :: Field
     real, dimension(:, :, :), allocatable :: New_Field
     integer, dimension(MaxDim) :: Dim
-    integer :: i, j, k, nb
+    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
+    INTEGER :: ColumnSize
+    INTEGER :: pos, offset
+    CHARACTER(LEN = 255) :: form
+    CHARACTER(LEN = 255) :: spacing
 
     open(unit = id, file = name // '.field', form = 'formatted', status = 'replace')
@@ -264,5 +264,5 @@
           nb = nb + 1
 
-          if (MOD(nb, NbCol)==0) then
+          if (MOD(nb, NbCol)==0) THEN
             form = '(t' // trim(int2str(pos)) // &
                     ',"(' // trim(int2str(k)) // ','          &
@@ -284,5 +284,5 @@
           write (id, form, advance = 'no') Field(k, j, i)
         enddo
-        if (MOD(nb, NbCol)==0) then
+        if (MOD(nb, NbCol)==0) THEN
           write (id, spacing)
         else
@@ -296,5 +296,5 @@
     close(id)
 
-  end subroutine write_field3D
+  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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/misc/wxios.F90	(revision 5116)
@@ -359,10 +359,10 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     SUBROUTINE wxios_domain_param(dom_id)
-       USE dimphy, only: klon
+       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, &
+       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_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
        USE lmdz_print_control, ONLY: prt_level, lunout
        USE lmdz_geometry
@@ -390,5 +390,5 @@
         io_lat(1)=rlat_glo(1)
         io_lat(nbp_lat)=rlat_glo(klon_glo)
-        IF ((nbp_lon*nbp_lat) > 1) then
+        IF ((nbp_lon*nbp_lat) > 1) THEN
           DO i=2,nbp_lat-1
             io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
@@ -532,11 +532,11 @@
         
         ! Ehouarn: New way to declare axis, without axis_group:
-        if (PRESENT(positif) .AND. PRESENT(bnds)) then
+        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
+        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
+        else if (PRESENT(bnds)) THEN
           CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
                                   bounds=bnds)
@@ -605,5 +605,5 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
-        USE netcdf, only: nf90_fill_real
+        USE netcdf, ONLY: nf90_fill_real
 
         IMPLICIT NONE
Index: /LMDZ6/branches/Amaury_dev/libf/obsolete/juldate.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/obsolete/juldate.f90	(revision 5116)
+++ /LMDZ6/branches/Amaury_dev/libf/obsolete/juldate.f90	(revision 5116)
@@ -0,0 +1,41 @@
+! Amaury (07/2024): utilisé nulle part, code de <2004
+! Je suggère de bouger dans obsolète
+
+! $Id$
+
+  SUBROUTINE juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
+  ! Sous-routine de changement de date:
+  ! gregorien>>>date julienne
+  ! En entree:an,mois,jour,heure,min.,sec.
+  ! En sortie:tjd
+    IMPLICIT NONE
+    INTEGER,INTENT(IN) :: ian,imoi,ijou,oh,om,os
+    REAL,INTENT(OUT) :: tjd,tjdsec
+
+    REAL :: frac,year,rmon,cf,a,b
+    INTEGER :: ojou
+
+    frac=((os/60.+om)/60.+oh)/24.
+    ojou=dble(ijou)+frac
+        year=dble(ian)
+        rmon=dble(imoi)
+    if (imoi <= 2) THEN
+        year=year-1.
+        rmon=rmon+12.
+    endif
+    cf=year+(rmon/100.)+(ojou/10000.)
+    if (cf >= 1582.1015) THEN
+        a=int(year/100)
+        b=2-a+int(a/4)
+    else
+        b=0
+    endif
+    tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou) &
+          +1720994.5+b
+    tjdsec=(ojou-int(ojou))+(tjd-int(tjd))
+    tjd=int(tjd)+int(tjdsec)
+    tjdsec=tjdsec-int(tjdsec)
+
+END SUBROUTINE juldate
+
+
Index: /LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_abort_physic.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_abort_physic.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_abort_physic.F90	(revision 5116)
@@ -18,22 +18,22 @@
     !         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_physic'
+    WRITE(lunout, *) 'in abort_physic'
     !$OMP MASTER
     CALL histclo
     CALL restclo
-    if (mpi_rank == 0) then
+    if (mpi_rank == 0) THEN
       CALL getin_dump
     endif
     !$OMP END MASTER
 
-    write(lunout, *) 'Stopping in ', modname
-    write(lunout, *) 'Reason = ', message
-    if (ierr == 0) then
-      write(lunout, *) 'Everything is cool'
-      if (using_mpi) then
+    WRITE(lunout, *) 'Stopping in ', modname
+    WRITE(lunout, *) 'Reason = ', message
+    if (ierr == 0) THEN
+      WRITE(lunout, *) 'Everything is cool'
+      if (using_mpi) THEN
         !$OMP CRITICAL (MPI_ABORT_PHYSIC)
         CALL MPI_ABORT(COMM_LMDZ_PHY, 0, ierror_mpi)
@@ -43,6 +43,6 @@
       endif
     else
-      write(lunout, *) 'Houston, we have a problem, ierr = ', ierr
-      if (using_mpi) then
+      WRITE(lunout, *) 'Houston, we have a problem, ierr = ', ierr
+      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_phys_omp_data.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_omp_data.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_phys_omp_data.F90	(revision 5116)
@@ -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_print_control.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_print_control.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_print_control.f90	(revision 5116)
@@ -43,5 +43,5 @@
     INTEGER :: alarm_file = 15 ! in case we want/need to print out the special alarms in a separate file
 
-    IF (alert_first_call) then
+    IF (alert_first_call) THEN
       IF (alarm_file /= lunout) THEN
         OPEN(unit = alarm_file, file = "ALERTES.txt")
@@ -50,5 +50,5 @@
 
     alarm_couleur = alarm_color(niv_alerte)
-    IF (niv_alerte < 0 .OR. niv_alerte > 3) then
+    IF (niv_alerte < 0 .OR. niv_alerte > 3) THEN
       message = 'NIVEAU ALERTE INVALIDE  ' // message
       alarm_couleur = 'NOIRE  '
Index: /LMDZ6/branches/Amaury_dev/libf/phydev/comcstphy.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phydev/comcstphy.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phydev/comcstphy.F90	(revision 5116)
@@ -1,8 +1,8 @@
 module comcstphy
   
-  real :: rradius ! planet radius (m)
-  real :: rr      ! recuced gas constant: R/molar mass of atm
-  real :: rg      ! gravity
-  real :: rcpp    ! specific heat of the atmosphere
+  REAL :: rradius ! planet radius (m)
+  REAL :: rr      ! recuced gas constant: R/molar mass of atm
+  REAL :: rg      ! gravity
+  REAL :: rcpp    ! specific heat of the atmosphere
 
 end module comcstphy
Index: /LMDZ6/branches/Amaury_dev/libf/phydev/iophy.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phydev/iophy.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phydev/iophy.F90	(revision 5116)
@@ -25,14 +25,14 @@
 
   SUBROUTINE init_iophy_new(rlat, rlon)
-    USE dimphy, only: klon
-    USE lmdz_phys_para, only: gather, bcast, &
+    USE dimphy, ONLY: klon
+    USE lmdz_phys_para, ONLY: gather, bcast, &
             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_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
     USE lmdz_print_control, ONLY: lunout, prt_level
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
-    USE ioipsl, only: flio_dom_set
-    use wxios, only: wxios_domain_param, using_xios
+    USE ioipsl, ONLY: flio_dom_set
+    use wxios, ONLY: wxios_domain_param, using_xios
     IMPLICIT NONE
     real, dimension(klon), intent(in) :: rlon
@@ -50,5 +50,5 @@
     INTEGER, DIMENSION(2) :: dhe
     INTEGER :: i
-    integer :: data_ibegin, data_iend
+    INTEGER :: data_ibegin, data_iend
 
     CALL gather(rlat, rlat_glo)
@@ -61,5 +61,5 @@
     io_lat(1) = rlat_glo(1)
     io_lat(nbp_lat) = rlat_glo(klon_glo)
-    IF ((nbp_lon * nbp_lat) > 1) then
+    IF ((nbp_lon * nbp_lat) > 1) THEN
       DO i = 2, nbp_lat - 1
         io_lat(i) = rlat_glo(2 + (i - 2) * nbp_lon)
@@ -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,10 +117,10 @@
       END IF
 
-      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
-        write(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " data_ibegin=", data_ibegin, " data_iend=", data_iend
-        write(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " data_ibegin=", data_ibegin, " data_iend=", data_iend
-        write(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " is_south_pole=", is_south_pole_dyn
+      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
+        WRITE(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " data_ibegin=", data_ibegin, " data_iend=", data_iend
+        WRITE(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " data_ibegin=", data_ibegin, " data_iend=", data_iend
+        WRITE(lunout, *) "init_iophy_new: mpirank=", mpi_rank, " is_south_pole=", is_south_pole_dyn
       endif
 
@@ -139,6 +139,6 @@
 
   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 lmdz_phys_para, ONLY: is_sequential, jj_begin, jj_end, jj_nb
+    use ioipsl, ONLY: histbeg
     USE lmdz_print_control, ONLY: prt_level, lunout
     USE lmdz_grid_phy, ONLY: nbp_lon
@@ -153,5 +153,5 @@
 
     !$OMP MASTER
-    if (is_sequential) then
+    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)
@@ -169,6 +169,6 @@
   ! SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
   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_phys_para, ONLY: is_using_mpi, is_mpi_root
+    use wxios, ONLY: wxios_add_file
     IMPLICIT NONE
 
@@ -198,9 +198,9 @@
 
   SUBROUTINE histwrite2d_phy(nid, lpoint, name, itau, field)
-    USE dimphy, only: klon
-    USE lmdz_phys_para, only: Gather_omp, grid1Dto2D_mpi, &
+    USE dimphy, ONLY: klon
+    USE lmdz_phys_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
             is_sequential, klon_mpi_begin, klon_mpi_end, &
             jj_nb, klon_mpi
-    USE ioipsl, only: histwrite
+    USE ioipsl, ONLY: histwrite
     USE lmdz_grid_phy, ONLY: nbp_lon
     USE lmdz_abort_physic, ONLY: abort_physic
@@ -216,5 +216,5 @@
     REAL :: Field2d(nbp_lon, jj_nb)
 
-    integer :: ip
+    INTEGER :: ip
     real, allocatable, dimension(:) :: fieldok
 
@@ -224,5 +224,5 @@
     !$OMP MASTER
     CALL grid1Dto2D_mpi(buffer_omp, Field2d)
-    if(.NOT.lpoint) THEN
+    IF(.NOT.lpoint) THEN
       ALLOCATE(index2d(nbp_lon * jj_nb))
       ALLOCATE(fieldok(nbp_lon * jj_nb))
@@ -232,5 +232,5 @@
       ALLOCATE(index2d(npstn))
 
-      if(is_sequential) then
+      IF(is_sequential) THEN
         !     klon_mpi_begin=1
         !     klon_mpi_end=klon
@@ -258,9 +258,9 @@
 
   SUBROUTINE histwrite3d_phy(nid, lpoint, name, itau, field)
-    USE dimphy, only: klon
-    USE lmdz_phys_para, only: Gather_omp, grid1Dto2D_mpi, &
+    USE dimphy, ONLY: klon
+    USE lmdz_phys_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
             is_sequential, klon_mpi_begin, klon_mpi_end, &
             jj_nb, klon_mpi
-    USE ioipsl, only: histwrite
+    USE ioipsl, ONLY: histwrite
     USE lmdz_grid_phy, ONLY: nbp_lon
     USE lmdz_abort_physic, ONLY: abort_physic
@@ -284,5 +284,5 @@
     !$OMP MASTER
     CALL grid1Dto2D_mpi(buffer_omp, field3d)
-    if(.NOT.lpoint) THEN
+    IF(.NOT.lpoint) THEN
       ALLOCATE(index3d(nbp_lon * jj_nb * nlev))
       ALLOCATE(fieldok(nbp_lon * jj_nb, nlev))
@@ -293,5 +293,5 @@
       ALLOCATE(fieldok(npstn, nlev))
 
-      if(is_sequential) then
+      IF(is_sequential) THEN
         !      klon_mpi_begin=1
         !      klon_mpi_end=klon
@@ -323,8 +323,8 @@
 
   SUBROUTINE histwrite2d_xios(field_name, field)
-    USE dimphy, only: klon
-    USE lmdz_phys_para, only: gather_omp, grid1Dto2D_mpi, &
+    USE dimphy, ONLY: klon
+    USE lmdz_phys_para, ONLY: gather_omp, grid1Dto2D_mpi, &
             jj_nb, klon_mpi
-    USE lmdz_xios, only: xios_send_field
+    USE lmdz_xios, ONLY: xios_send_field
     USE lmdz_print_control, ONLY: prt_level, lunout
     USE lmdz_grid_phy, ONLY: nbp_lon
@@ -357,8 +357,8 @@
 
   SUBROUTINE histwrite3d_xios(field_name, field)
-    USE dimphy, only: klon, klev
-    USE lmdz_phys_para, only: gather_omp, grid1Dto2D_mpi, &
+    USE dimphy, ONLY: klon, klev
+    USE lmdz_phys_para, ONLY: gather_omp, grid1Dto2D_mpi, &
             jj_nb, klon_mpi
-    USE lmdz_xios, only: xios_send_field
+    USE lmdz_xios, ONLY: xios_send_field
     USE lmdz_print_control, ONLY: prt_level, lunout
     USE lmdz_grid_phy, ONLY: nbp_lon
@@ -373,5 +373,5 @@
     INTEGER :: ip, n, nlev
 
-    IF (prt_level >= 10) write(lunout, *)'Begin histrwrite3d_xios ', trim(field_name)
+    IF (prt_level >= 10) WRITE(lunout, *)'Begin histrwrite3d_xios ', trim(field_name)
 
     !Et on.... écrit
@@ -386,5 +386,5 @@
     !$OMP END MASTER
 
-    IF (prt_level >= 10) write(lunout, *)'End histrwrite3d_xios ', trim(field_name)
+    IF (prt_level >= 10) WRITE(lunout, *)'End histrwrite3d_xios ', trim(field_name)
   END SUBROUTINE histwrite3d_xios
 
Index: /LMDZ6/branches/Amaury_dev/libf/phydev/phyetat0.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phydev/phyetat0.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phydev/phyetat0.F90	(revision 5116)
@@ -6,5 +6,5 @@
 ! and do some resulting initializations
 
-  USE dimphy, only: klon
+  USE dimphy, ONLY: klon
   USE iostart, ONLY: open_startphy,get_field,close_startphy
   USE iophy, ONLY: init_iophy_new
Index: /LMDZ6/branches/Amaury_dev/libf/phydev/phys_state_var_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phydev/phys_state_var_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phydev/phys_state_var_mod.F90	(revision 5116)
@@ -19,8 +19,8 @@
 !  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"
+!    WRITE(*,*) "phys_state_var_init: warning, rlat already allocated"
 !  endif
   
Index: /LMDZ6/branches/Amaury_dev/libf/phydev/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phydev/physiq_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phydev/physiq_mod.F90	(revision 5116)
@@ -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 wxios, ONLY: wxios_add_vaxis, wxios_set_cal, wxios_closedef
       USE iophy, ONLY: histwrite_phy
 
@@ -54,23 +54,23 @@
 integer,save :: itau=0 ! counter to count number of calls to physics
 !$OMP THREADPRIVATE(itau)
-real :: temp_newton(klon,klev)
-integer :: k
+REAL :: temp_newton(klon,klev)
+INTEGER :: k
 logical, save :: first=.TRUE.
 !$OMP THREADPRIVATE(first)
 
 ! For I/Os
-integer :: itau0
-real :: zjulian
-real :: dtime
-integer :: nhori ! horizontal coordinate ID
+INTEGER :: itau0
+REAL :: zjulian
+REAL :: dtime
+INTEGER :: nhori ! horizontal coordinate ID
 integer,save :: nid_hist ! output file ID
 !$OMP THREADPRIVATE(nid_hist)
-integer :: zvertid ! vertical coordinate ID
+INTEGER :: zvertid ! vertical coordinate ID
 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
                                 ! (must be shared by all threads)
-real :: t_ops ! frequency of the IOIPSL operations (eg average over...)
-real :: t_wrt ! frequency of the IOIPSL outputs
+REAL :: t_ops ! frequency of the IOIPSL operations (eg average over...)
+REAL :: t_wrt ! frequency of the IOIPSL outputs
 
 ! initializations
@@ -165,5 +165,5 @@
 ! IOIPSL
 #ifndef CPP_IOIPSL_NO_OUTPUT 
-IF (modulo(itau,iwrite_phys)==0) then
+IF (modulo(itau,iwrite_phys)==0) THEN
   CALL histwrite_phy(nid_hist,.FALSE.,"temperature",itau,t)
   CALL histwrite_phy(nid_hist,.FALSE.,"u",itau,u)
@@ -191,5 +191,5 @@
 
 ! if lastcall, then it is time to write "restartphy.nc" file
-IF (lafin) then
+IF (lafin) THEN
   CALL phyredem("restartphy.nc")
 END IF
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90	(revision 5116)
@@ -94,5 +94,5 @@
   REAL :: dust_ec(klon)
 
-  real :: tmp_var2(klon, nbtr) ! auxiliary variable to replace source
+  REAL :: tmp_var2(klon, nbtr) ! auxiliary variable to replace source
   REAL :: qmin, qmax
   !----------------------DUST Sahara ---------------
@@ -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)) * &
@@ -266,5 +266,5 @@
   ENDDO
   CALL minmaxsource(tmp_var2, qmin, qmax, 'src: before SS emiss')
-  IF(id_coss>0) then
+  IF(id_coss>0) THEN
     print *, 'Source = ', SUM(source_tr(:, id_coss)), &
             MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
@@ -299,5 +299,5 @@
   ENDDO
   CALL minmaxsource(tmp_var2, qmin, qmax, 'src: after SS emiss')
-  IF(id_coss>0) then
+  IF(id_coss>0) THEN
     print *, 'Source = ', SUM(source_tr(:, id_coss)), &
             MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90	(revision 5116)
@@ -35,7 +35,7 @@
 
   ierr = nf90_open ("limitcarbon.nc", nf90_nowrite, nid1)
-  if (ierr/=nf90_noerr) then
-    write(6, *)' Pb d''ouverture du fichier limitbc.nc'
-    write(6, *)' ierr = ', ierr
+  if (ierr/=nf90_noerr) THEN
+    WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc'
+    WRITE(6, *)' ierr = ', ierr
     CALL exit(1)
   endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90	(revision 5116)
@@ -58,7 +58,7 @@
 
     ierr = nf90_open ("carbon_emissions.nc", nf90_nowrite, nid1)
-    if (ierr/=nf90_noerr) then
-      write(6, *)' Pb d''ouverture du fichier limitbc.nc'
-      write(6, *)' ierr = ', ierr
+    if (ierr/=nf90_noerr) THEN
+      WRITE(6, *)' Pb d''ouverture du fichier limitbc.nc'
+      WRITE(6, *)' ierr = ', ierr
       CALL exit(1)
     endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90	(revision 5116)
@@ -36,7 +36,7 @@
 
   ierr = nf90_open ("limitsoufre.nc", nf90_nowrite, nid)
-  if (ierr/=nf90_noerr) then
-    write(6, *)' Pb d''ouverture du fichier limitsoufre.nc'
-    write(6, *)' ierr = ', ierr
+  if (ierr/=nf90_noerr) THEN
+    WRITE(6, *)' Pb d''ouverture du fichier limitsoufre.nc'
+    WRITE(6, *)' ierr = ', ierr
     CALL exit(1)
   endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90	(revision 5116)
@@ -61,7 +61,7 @@
 
     ierr = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid)
-    if (ierr/=nf90_noerr) then
-      write(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro'
-      write(6, *)' ierr = ', ierr
+    if (ierr/=nf90_noerr) THEN
+      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro'
+      WRITE(6, *)' ierr = ', ierr
       CALL exit(1)
     endif
@@ -130,7 +130,7 @@
     !=======================================================================
     ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid)
-    if (ierr/=nf90_noerr) then
-      write(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat'
-      write(6, *)' ierr = ', ierr
+    if (ierr/=nf90_noerr) THEN
+      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat'
+      WRITE(6, *)' ierr = ', ierr
       CALL exit(1)
     endif
@@ -185,7 +185,7 @@
     print *, ' Jour = ', jour
     ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid)
-    if (ierr/=nf90_noerr) then
-      write(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc'
-      write(6, *)' ierr = ', ierr
+    if (ierr/=nf90_noerr) THEN
+      WRITE(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc'
+      WRITE(6, *)' ierr = ', ierr
       CALL exit(1)
     endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5116)
@@ -253,5 +253,5 @@
   INTEGER,DIMENSION(klon) :: maskdustloc
   INTEGER :: i,j,k
-  integer :: iaux
+  INTEGER :: iaux
  
 
@@ -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
@@ -332,5 +332,5 @@
 
   logical ::  debutphy
-  real :: diff, auxr1,auxr2,auxr3,auxr4
+  REAL :: diff, auxr1,auxr2,auxr3,auxr4
   real,dimension(klon,nbins) :: itvmean
   real,dimension(klon,nbins+1) :: itv2
@@ -346,7 +346,6 @@
 
 writeaerosoldistrib=.FALSE.
-IF (debutphy) then
-
-  if (sizedustmin>sizeacclow .or. sizedustmax<sizescohigh) then 
+IF (debutphy) THEN
+  if (sizedustmin>sizeacclow .or. sizedustmax<sizescohigh) THEN
    CALL abort_gcm('adaptdustemission', 'Dust range problem',1)
   endif
@@ -360,24 +359,24 @@
   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
    endif
   enddo
-IF (writeaerosoldistrib) then
+IF (writeaerosoldistrib) THEN
 !JEdbg<<
   do j=1,klon
@@ -468,5 +467,5 @@
 
 !JEdbg<<
-IF (writeaerosoldistrib) then
+IF (writeaerosoldistrib) THEN
   do i=1,nbins
     do j=1,klon
@@ -700,6 +699,5 @@
 
 ! print *,'JEOK2',mpi_rank,omp_rank
-IF ( 1==1 ) then
-
+IF ( 1==1 ) THEN
 ! print *,'JEOK4',mpi_rank,omp_rank
    CALL writefield_phy("SOL",sol,5)
@@ -756,5 +754,5 @@
          dp=dp*exp(dstep)
          sizeclass(i)=dp
-         if(dp>=dmax+eps)goto 30
+         IF(dp>=dmax+eps)goto 30
          newstep(i)=dstep
         ! WRITE(18,*)i,sizeclass(i)
@@ -765,9 +763,9 @@
       PRINT*,'   soil size classes used   ',ncl,' / ',nclass
       PRINT*,'   soil size min: ',sizeclass(1),' soil size max: ',sizeclass(ncl)
-      if(ncl>nclass)stop
+      IF(ncl>nclass)stop
 
 ! Threshold velocity:
-IF (.FALSE.) then
-!if (.TRUE.) then
+IF (.FALSE.) THEN
+!if (.TRUE.) THEN
 !c 0: Iversen and White 1982
        print *,'Using  Iversen and White 1982 Uth'
@@ -776,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
@@ -786,5 +784,5 @@
          enddo
 END IF
-IF(.TRUE.) then
+IF(.TRUE.) THEN
 ! 1: Shao and Lu 2000
        print *,'Using  Shao and Lu 2000 Uth'
@@ -850,7 +848,7 @@
           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
+     !       if (zos(i,k)<=0..or.z01(i,k)<=0.) THEN
+!              if (zos(i,k)<0..or.z01(i,k)<0.) THEN
      !            PRINT*,'INI DUST WARNING zos ou z01<0',zos(i,k),z01(i,k)
 !              endif
@@ -869,5 +867,5 @@
 ! drag partition between zo1 and zo2
 ! feff: total efficient fraction
-              if(D(i,k)==0.)then
+              IF(D(i,k)==0.)THEN
                  feff(i,k)=cc
    !       PRINT*,'IKKK C ',i,klon,k,ntyp
@@ -887,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
@@ -898,5 +896,5 @@
 
 
-IF (1==1) then
+IF (1==1) THEN
 !  !  CALL writefield_phy("AA",tmp1(1:klon,1:5),5)
 
@@ -919,5 +917,5 @@
 
 
-!  if (.FALSE.) then
+!  if (.FALSE.) THEN
 !!**************L718
 
@@ -1083,5 +1081,5 @@
       DO k=1,ndistb
         DO nb=1,nbins
-            write(15001,*) k,nb,massfrac(k,nb)
+            WRITE(15001,*) k,nb,massfrac(k,nb)
         ENDDO
       ENDDO
@@ -1242,5 +1240,5 @@
 
                  !IF(n.eq.1.and.nat.eq.99)GOTO 80
-             !      if(n.eq.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)
+             !      IF(n.eq.1) PRINT*,'nat1=',nat,'sol1=',sol(i,n)
                    IF(n==1.and.nat==99)GOTO 80
 
@@ -1248,5 +1246,5 @@
              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>>>>
@@ -1277,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.
@@ -1293,8 +1291,8 @@
             t2=0.
             t3=0.
-            if(ec>=e1)t1=1.
-            if(ec>=e2)t2=1.
-            if(ec>=e3)t3=1.
-            if(dfec3/=0.)then
+            IF(ec>=e1)t1=1.
+            IF(ec>=e2)t2=1.
+            IF(ec>=e3)t3=1.
+            IF(dfec3/=0.)THEN
                p1=t1*dfec1/dfec3
                p2=t2*(1.-p1)*dfec2/dfec3
@@ -1405,5 +1403,5 @@
             srel2(nat,kfin)=srel(nat,i)*istep
          enddo
-         if(kfin>=nclass)then
+         IF(kfin>=nclass)THEN
             PRINT*,'$$$$ Tables dimension problem:',kfin,'>',nclass
          endif
@@ -1436,5 +1434,5 @@
       ihalf=int((ismax+ismin)/2.)
       do k2=1,1000000
-          if(ds>siz(ihalf))then
+          IF(ds>siz(ihalf))THEN
              ismin=ihalf
           else
@@ -1443,5 +1441,5 @@
           ihalf=int((ismax+ismin)/2.)
           idiff=ismax-ismin
-          if(idiff<=1)then
+          IF(idiff<=1)THEN
              iout=ismin
              goto 52
@@ -1449,5 +1447,5 @@
       enddo
  52   continue
-      if(iout==0)then
+      IF(iout==0)THEN
         PRINT*,'$$$$ Tables dimension problem: ',iout
       endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90	(revision 5116)
@@ -87,5 +87,5 @@
 !$OMP THREADPRIVATE(alpha_r, alpha_s, R_r, R_s)
   REAL           :: pr, ps, ice, water
-  real :: conserv
+  REAL :: conserv
 
 !!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!!
@@ -98,5 +98,5 @@
 !  inscav_fisrt=.TRUE.
 !  CALL getin('inscav_fisrt',inscav_fisrt)
-!  if(inscav_fisrt) then 
+!  IF(inscav_fisrt) THEN
 !   PRINT*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
 !  else
@@ -200,6 +200,6 @@
     DO i=1, klon 
 !  incloud scavenging
-!   if(inscav_fisrt) then 
-   if (iflag_lscav == 4) then
+!   IF(inscav_fisrt) THEN
+   if (iflag_lscav == 4) THEN
       beta=beta_fisrt(i,k)*rneb(i,k)
    else
@@ -217,5 +217,5 @@
 
 !  below-cloud impaction
-    IF(it==1) then
+    IF(it==1) THEN
       d_tr_bcscav(i,k,it)=0.
     ELSE
@@ -234,5 +234,5 @@
       deltaP(i,k)=max(deltaP(i,k),0.)
 
-      if(flxr(i,k+1)+flxs(i,k+1)>1.e-16) then
+      IF(flxr(i,k+1)+flxs(i,k+1)>1.e-16) THEN
        beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1))
       else
@@ -244,5 +244,5 @@
 !jyg
       
-      if(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) then
+      IF(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) THEN
 ! remove tracers from precipitation owing to release by evaporation in his_dh
 !      dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) &
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_spl.F90	(revision 5116)
@@ -97,5 +97,5 @@
 !$OMP THREADPRIVATE(R_r, R_s)
   REAL           :: pr, ps, ice, water
-  real :: conserv
+  REAL :: conserv
 
 !!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!!
@@ -108,5 +108,5 @@
 !  inscav_fisrt=.TRUE.
 !  CALL getin('inscav_fisrt',inscav_fisrt)
-!  if(inscav_fisrt) then 
+!  IF(inscav_fisrt) THEN
 !   PRINT*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt
 !  else
@@ -211,6 +211,6 @@
     DO i=1, klon 
 !  incloud scavenging
-!   if(inscav_fisrt) then 
-   if (iflag_lscav == 4) then
+!   IF(inscav_fisrt) THEN
+   if (iflag_lscav == 4) THEN
       beta=beta_fisrt(i,k)*rneb(i,k)
    else
@@ -228,5 +228,5 @@
 
 !  below-cloud impaction
-    IF(it==id_prec) then
+    IF(it==id_prec) THEN
       d_tr_bcscav(i,k,it)=0.
     ELSE
@@ -245,5 +245,5 @@
       deltaP(i,k)=max(deltaP(i,k),0.)
 
-      if(flxr(i,k+1)+flxs(i,k+1)>1.e-16) then
+      IF(flxr(i,k+1)+flxs(i,k+1)>1.e-16) THEN
        beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1))
       else
@@ -255,5 +255,5 @@
 !jyg
       
-      if(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) then
+      IF(abs(1-(1-frac_ev)*beta_ev(i,k))>1.e-16) THEN
 ! remove tracers from precipitation owing to release by evaporation in his_dh
 !      dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) &
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90	(revision 5116)
@@ -3,15 +3,14 @@
   USE dimphy
   USE infotrac
+  USE lmdz_libmath, ONLY: ismax, ismin
   INCLUDE "dimensions.h"
 
   ! character*20 comment
-  character(len = *) :: comment
-  real :: qmin, qmax
-  real :: zq(klon, klev)
+  CHARACTER(LEN = *) :: comment
+  REAL :: qmin, qmax
+  REAL :: zq(klon, klev)
 
-  integer :: ijmin, lmin, ijlmin
-  integer :: ijmax, lmax, ijlmax
-
-  integer :: ismin, ismax
+  INTEGER :: ijmin, lmin, ijlmin
+  INTEGER :: ijmax, lmax, ijlmax
 
   ijlmin = ismin(klon * klev, zq, 1)
@@ -25,9 +24,9 @@
   zqmax = zq(ijmax, lmax)
 
-  if(zqmin<qmin.or.zqmax>qmax) &
-          write(*, 9999) comment, &
+  IF(zqmin<qmin.or.zqmax>qmax) &
+          WRITE(*, 9999) comment, &
                   ijmin, lmin, zqmin, ijmax, lmax, zqmax
 
-  return
+  RETURN
   9999   format(a20, 2('  q(', i4, ',', i2, ')=', e12.5))
-end subroutine minmaxqfi2
+END SUBROUTINE minmaxqfi2
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90	(revision 5116)
@@ -3,16 +3,15 @@
   USE dimphy
   USE infotrac
+  USE lmdz_libmath, ONLY: ismax, ismin
 
   INCLUDE "dimensions.h"
 
   ! character*20 comment
-  character(len = *) :: comment
-  real :: qmin, qmax
-  real :: zq(klon, nbtr)
+  CHARACTER(LEN = *) :: comment
+  REAL :: qmin, qmax
+  REAL :: zq(klon, nbtr)
 
-  integer :: ijmin, lmin, ijlmin
-  integer :: ijmax, lmax, ijlmax
-
-  integer :: ismin, ismax
+  INTEGER :: ijmin, lmin, ijlmin
+  INTEGER :: ijmax, lmax, ijlmax
 
   ijlmin = ismin(klon * nbtr, zq, 1)
@@ -26,9 +25,9 @@
   zqmax = zq(ijmax, lmax)
 
-  if(zqmin<qmin.or.zqmax>qmax) &
-          write(*, 9999) comment, &
+  IF(zqmin<qmin.or.zqmax>qmax) &
+          WRITE(*, 9999) comment, &
                   ijmin, lmin, zqmin, ijmax, lmax, zqmax
 
-  return
+  RETURN
   9999   format(a20, 2('  q(', i4, ',', i2, ')=', e12.5))
-end subroutine minmaxsource
+END SUBROUTINE minmaxsource
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90	(revision 5116)
@@ -30,13 +30,13 @@
   INCLUDE "dimensions.h"
   !
-  real :: u10_mps(klon), ustar_mps(klon), obklen_m(klon)
-  real :: u10n_mps(klon)
-  real :: pi, von_karman
+  REAL :: u10_mps(klon), ustar_mps(klon), obklen_m(klon)
+  REAL :: u10n_mps(klon)
+  REAL :: pi, von_karman
   ! parameter (pi = 3.141592653589793, von_karman = 0.4)
   ! pour etre coherent avec vk de bl_for_dms.F
   parameter (pi = 3.141592653589793, von_karman = 0.35)
   !
-  real :: phi, phi_inv, phi_inv_sq, f1, f2, f3, dum1, psi
-  integer :: i
+  REAL :: phi, phi_inv, phi_inv_sq, f1, f2, f3, dum1, psi
+  INTEGER :: i
 
   psi = 0.
@@ -45,5 +45,5 @@
     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,5 +61,5 @@
     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
@@ -68,4 +68,4 @@
   enddo
 
-end subroutine neutral
+END SUBROUTINE neutral
 !***********************************************************************
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90	(revision 5116)
@@ -466,5 +466,5 @@
          IF (vars_defined) THEN
             IF (prt_level >= 10) THEN
-               write(lunout,*)"phys_output_write: CALL xios_update_calendar, itau_w=",itau_w
+               WRITE(lunout,*)"phys_output_write: CALL xios_update_calendar, itau_w=",itau_w
             ENDIF
 !           CALL xios_update_calendar(itau_w)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5116)
@@ -1213,5 +1213,5 @@
     source_tr = 0.
 
-    if (debutphy) then
+    if (debutphy) THEN
 #ifdef IOPHYS_DUST
          CALL iophys_ini(pdtphys)
@@ -1230,5 +1230,5 @@
          IF(.NOT.tracers(iq)%isInPhysics) CYCLE
          itr = itr+1
-         write(str2,'(i2.2)') itrr
+         WRITE(str2,'(i2.2)') itrr
          CALL iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -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
@@ -1418,43 +1418,43 @@
     !---fraction of tracer that is convected (Tiedke)
     xconv(:) = 0.
-    if(id_prec>0)  xconv(id_prec) = 0.8
-    if(id_fine>0)  xconv(id_fine) = 0.5
-    if(id_coss>0)  xconv(id_coss) = 0.5
-    if(id_codu>0)  xconv(id_codu) = 0.6
-    if(id_scdu>0)  xconv(id_scdu) = 0.6  !!JE fix
+    IF(id_prec>0)  xconv(id_prec) = 0.8
+    IF(id_fine>0)  xconv(id_fine) = 0.5
+    IF(id_coss>0)  xconv(id_coss) = 0.5
+    IF(id_codu>0)  xconv(id_codu) = 0.6
+    IF(id_scdu>0)  xconv(id_scdu) = 0.6  !!JE fix
 
     masse(:) = 1.
-    if(id_prec>0)  masse(id_prec) = 32.
-    if(id_fine>0)  masse(id_fine) = 6.02e23
-    if(id_coss>0)  masse(id_coss) = 6.02e23
-    if(id_codu>0)  masse(id_codu) = 6.02e23
-    if(id_scdu>0)  masse(id_scdu) = 6.02e23
+    IF(id_prec>0)  masse(id_prec) = 32.
+    IF(id_fine>0)  masse(id_fine) = 6.02e23
+    IF(id_coss>0)  masse(id_coss) = 6.02e23
+    IF(id_codu>0)  masse(id_codu) = 6.02e23
+    IF(id_scdu>0)  masse(id_scdu) = 6.02e23
 
     henry(:) = 0.
-    if(id_prec>0)  henry(id_prec) = 1.4
-    if(id_fine>0)  henry(id_fine) = 0.0
-    if(id_coss>0)  henry(id_coss) = 0.0
-    if(id_codu>0)  henry(id_codu) = 0.0
-    if(id_scdu>0)  henry(id_scdu) = 0.0
+    IF(id_prec>0)  henry(id_prec) = 1.4
+    IF(id_fine>0)  henry(id_fine) = 0.0
+    IF(id_coss>0)  henry(id_coss) = 0.0
+    IF(id_codu>0)  henry(id_codu) = 0.0
+    IF(id_scdu>0)  henry(id_scdu) = 0.0
     !henry= (/1.4, 0.0, 0.0, 0.0/)
     kk(:) = 0.
-    if(id_prec>0)  kk(id_prec) = 2900.
-    if(id_fine>0)  kk(id_fine) = 0.0
-    if(id_coss>0)  kk(id_coss) = 0.0
-    if(id_codu>0)  kk(id_codu) = 0.0
-    if(id_scdu>0)  kk(id_scdu) = 0.0
+    IF(id_prec>0)  kk(id_prec) = 2900.
+    IF(id_fine>0)  kk(id_fine) = 0.0
+    IF(id_coss>0)  kk(id_coss) = 0.0
+    IF(id_codu>0)  kk(id_codu) = 0.0
+    IF(id_scdu>0)  kk(id_scdu) = 0.0
     !kk = (/2900., 0., 0., 0./)
     alpha_r(:) = 0.
-    if(id_prec>0)  alpha_r(id_prec) = 0.0
-    if(id_fine>0)  alpha_r(id_fine) = 0.001
-    if(id_coss>0)  alpha_r(id_coss) = 0.001
-    if(id_codu>0)  alpha_r(id_codu) = 0.001
-    if(id_scdu>0)  alpha_r(id_scdu) = 0.001  !JE fix
+    IF(id_prec>0)  alpha_r(id_prec) = 0.0
+    IF(id_fine>0)  alpha_r(id_fine) = 0.001
+    IF(id_coss>0)  alpha_r(id_coss) = 0.001
+    IF(id_codu>0)  alpha_r(id_codu) = 0.001
+    IF(id_scdu>0)  alpha_r(id_scdu) = 0.001  !JE fix
     alpha_s(:) = 0.
-    if(id_prec>0)  alpha_s(id_prec) = 0.0
-    if(id_fine>0)  alpha_s(id_fine) = 0.01
-    if(id_coss>0)  alpha_s(id_coss) = 0.01
-    if(id_codu>0)  alpha_s(id_codu) = 0.01
-    if(id_scdu>0)  alpha_s(id_scdu) = 0.01  !JE fix
+    IF(id_prec>0)  alpha_s(id_prec) = 0.0
+    IF(id_fine>0)  alpha_s(id_fine) = 0.01
+    IF(id_coss>0)  alpha_s(id_coss) = 0.01
+    IF(id_codu>0)  alpha_s(id_codu) = 0.01
+    IF(id_scdu>0)  alpha_s(id_scdu) = 0.01  !JE fix
 
     !      alpha_r =  (/0., 0.001, 0.001, 0.001/)
@@ -1465,31 +1465,31 @@
     !vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
     vdep_oce(:) = 0.
-    if(id_prec>0)  vdep_oce(id_prec) = 0.28
-    if(id_fine>0)  vdep_oce(id_fine) = 0.28
-    if(id_coss>0)  vdep_oce(id_coss) = 1.2
-    if(id_codu>0)  vdep_oce(id_codu) = 1.2
-    if(id_scdu>0)  vdep_oce(id_scdu) = 1.2
+    IF(id_prec>0)  vdep_oce(id_prec) = 0.28
+    IF(id_fine>0)  vdep_oce(id_fine) = 0.28
+    IF(id_coss>0)  vdep_oce(id_coss) = 1.2
+    IF(id_codu>0)  vdep_oce(id_codu) = 1.2
+    IF(id_scdu>0)  vdep_oce(id_scdu) = 1.2
     vdep_sic(:) = 0.
-    if(id_prec>0)  vdep_sic(id_prec) = 0.2
-    if(id_fine>0)  vdep_sic(id_fine) = 0.17
-    if(id_coss>0)  vdep_sic(id_coss) = 1.2
-    if(id_codu>0)  vdep_sic(id_codu) = 1.2
-    if(id_scdu>0)  vdep_sic(id_scdu) = 1.2
+    IF(id_prec>0)  vdep_sic(id_prec) = 0.2
+    IF(id_fine>0)  vdep_sic(id_fine) = 0.17
+    IF(id_coss>0)  vdep_sic(id_coss) = 1.2
+    IF(id_codu>0)  vdep_sic(id_codu) = 1.2
+    IF(id_scdu>0)  vdep_sic(id_scdu) = 1.2
 
     !vdep_sic = (/0.2, 0.17, 1.2, 1.2/)
     !vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
     vdep_ter(:) = 0.
-    if(id_prec>0)  vdep_ter(id_prec) = 0.3
-    if(id_fine>0)  vdep_ter(id_fine) = 0.14
-    if(id_coss>0)  vdep_ter(id_coss) = 1.2
-    if(id_codu>0)  vdep_ter(id_codu) = 1.2
-    if(id_scdu>0)  vdep_ter(id_scdu) = 1.2
+    IF(id_prec>0)  vdep_ter(id_prec) = 0.3
+    IF(id_fine>0)  vdep_ter(id_fine) = 0.14
+    IF(id_coss>0)  vdep_ter(id_coss) = 1.2
+    IF(id_codu>0)  vdep_ter(id_codu) = 1.2
+    IF(id_scdu>0)  vdep_ter(id_scdu) = 1.2
 
     vdep_lic(:) = 0.
-    if(id_prec>0)  vdep_lic(id_prec) = 0.2
-    if(id_fine>0)  vdep_lic(id_fine) = 0.17
-    if(id_coss>0)  vdep_lic(id_coss) = 1.2
-    if(id_codu>0)  vdep_lic(id_codu) = 1.2
-    if(id_scdu>0)  vdep_lic(id_scdu) = 1.2
+    IF(id_prec>0)  vdep_lic(id_prec) = 0.2
+    IF(id_fine>0)  vdep_lic(id_fine) = 0.17
+    IF(id_coss>0)  vdep_lic(id_coss) = 1.2
+    IF(id_codu>0)  vdep_lic(id_codu) = 1.2
+    IF(id_scdu>0)  vdep_lic(id_scdu) = 1.2
 
 
@@ -1498,28 +1498,28 @@
     !     mais effet negligeable sur l'AOD
     ccntrAA_spla(:) = 0.
-    if(id_prec>0)  ccntrAA_spla(id_prec) = -9999.
-    if(id_fine>0)  ccntrAA_spla(id_fine) = 0.7
-    if(id_coss>0)  ccntrAA_spla(id_coss) = 1.0
-    if(id_codu>0)  ccntrAA_spla(id_codu) = 0.7
-    if(id_scdu>0)  ccntrAA_spla(id_scdu) = 0.7
+    IF(id_prec>0)  ccntrAA_spla(id_prec) = -9999.
+    IF(id_fine>0)  ccntrAA_spla(id_fine) = 0.7
+    IF(id_coss>0)  ccntrAA_spla(id_coss) = 1.0
+    IF(id_codu>0)  ccntrAA_spla(id_codu) = 0.7
+    IF(id_scdu>0)  ccntrAA_spla(id_scdu) = 0.7
 
     ccntrENV_spla(:) = 0.
-    if(id_prec>0)  ccntrENV_spla(id_prec) = -9999.
-    if(id_fine>0)  ccntrENV_spla(id_fine) = 0.7
-    if(id_coss>0)  ccntrENV_spla(id_coss) = 1.0
-    if(id_codu>0)  ccntrENV_spla(id_codu) = 0.7
-    if(id_scdu>0)  ccntrENV_spla(id_scdu) = 0.7
+    IF(id_prec>0)  ccntrENV_spla(id_prec) = -9999.
+    IF(id_fine>0)  ccntrENV_spla(id_fine) = 0.7
+    IF(id_coss>0)  ccntrENV_spla(id_coss) = 1.0
+    IF(id_codu>0)  ccntrENV_spla(id_codu) = 0.7
+    IF(id_scdu>0)  ccntrENV_spla(id_scdu) = 0.7
     ! #DFB
     coefcoli_spla(:) = 0.
-    if(id_prec>0)  coefcoli_spla(id_prec) = -9999.
-    if(id_fine>0)  coefcoli_spla(id_fine) = 0.001
-    if(id_coss>0)  coefcoli_spla(id_coss) = 0.001
-    if(id_codu>0)  coefcoli_spla(id_codu) = 0.001
-    if(id_scdu>0)  coefcoli_spla(id_scdu) = 0.001
+    IF(id_prec>0)  coefcoli_spla(id_prec) = -9999.
+    IF(id_fine>0)  coefcoli_spla(id_fine) = 0.001
+    IF(id_coss>0)  coefcoli_spla(id_coss) = 0.001
+    IF(id_codu>0)  coefcoli_spla(id_codu) = 0.001
+    IF(id_scdu>0)  coefcoli_spla(id_scdu) = 0.001
 
     !vdep_lic = (/0.2, 0.17, 1.2, 1.2/)
 
     iscm3 = .FALSE.
-    if (debutphy) then
+    if (debutphy) THEN
       !$OMP MASTER
       CALL suphel
@@ -1813,6 +1813,5 @@
     ENDIF
 
-    IF (debutphy) then
-
+    IF (debutphy) THEN
       ! AS: initialisation des indices par point de grille physique iregion_*
       ! (variables tenant de l'assimilation, a eliminer dans un 2eme temps)
@@ -2067,10 +2066,10 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,itr))
          CALL iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,itr))
       enddo
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -2100,5 +2099,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,itr))
          CALL iophys_ecrit('fap'//str2,1,'SOURCE','',source_tr(:,itr))
@@ -2197,5 +2196,5 @@
 
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,itr))
          CALL iophys_ecrit('fpr'//str2,1,'SOURCE','',flux_tr(:,itr))
@@ -2241,5 +2240,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,itr))
          CALL iophys_ecrit('f'//str2,1,'SOURCE','',flux_tr(:,itr))
@@ -2297,5 +2296,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -2337,5 +2336,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -2411,5 +2410,5 @@
       CALL iophys_ecrit('delp',klev,'delp','',delp)
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -2603,5 +2602,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -2690,5 +2689,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -2855,5 +2854,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -3054,5 +3053,5 @@
 
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -3175,5 +3174,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -3441,5 +3440,5 @@
 #ifdef IOPHYS_DUST
       do itr=1,nbtr
-         write(str2,'(i2.2)') itr
+         WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
       enddo
@@ -3861,54 +3860,54 @@
       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-      if(id_prec>0)  trm01(i) = trm(i, id_prec)
-      if(id_fine>0)  trm02(i) = trm(i, id_fine)
-      if(id_coss>0)  trm03(i) = trm(i, id_coss)
-      if(id_codu>0)  trm04(i) = trm(i, id_codu)
-      if(id_scdu>0)  trm05(i) = trm(i, id_scdu)
-      if(id_prec>0)    sconc01(i) = sconc_seri(i, id_prec)
-      if(id_fine>0)    sconc02(i) = sconc_seri(i, id_fine)
-      if(id_coss>0)    sconc03(i) = sconc_seri(i, id_coss)
-      if(id_codu>0)    sconc04(i) = sconc_seri(i, id_codu)
-      if(id_scdu>0)    sconc05(i) = sconc_seri(i, id_scdu)
-      if(id_prec>0)    flux01(i) = flux_tr(i, id_prec)
-      if(id_fine>0)    flux02(i) = flux_tr(i, id_fine)
-      if(id_coss>0)    flux03(i) = flux_tr(i, id_coss)
-      if(id_codu>0)    flux04(i) = flux_tr(i, id_codu)
-      if(id_scdu>0)    flux05(i) = flux_tr(i, id_scdu)
-      if(id_prec>0)    ds01(i) = his_ds(i, id_prec)
-      if(id_fine>0)    ds02(i) = his_ds(i, id_fine)
-      if(id_coss>0)    ds03(i) = his_ds(i, id_coss)
-      if(id_codu>0)    ds04(i) = his_ds(i, id_codu)
-      if(id_scdu>0)    ds05(i) = his_ds(i, id_scdu)
-      if(id_prec>0)    dh01(i) = his_dh(i, id_prec)
-      if(id_fine>0)    dh02(i) = his_dh(i, id_fine)
-      if(id_coss>0)    dh03(i) = his_dh(i, id_coss)
-      if(id_codu>0)    dh04(i) = his_dh(i, id_codu)
-      if(id_scdu>0)    dh05(i) = his_dh(i, id_scdu)
-      if(id_prec>0)    dtrconv01(i) = dtrconv(i, id_prec)
-      if(id_fine>0)    dtrconv02(i) = dtrconv(i, id_fine)
-      if(id_coss>0)    dtrconv03(i) = dtrconv(i, id_coss)
-      if(id_codu>0)    dtrconv04(i) = dtrconv(i, id_codu)
-      if(id_scdu>0)    dtrconv05(i) = dtrconv(i, id_scdu)
-      if(id_prec>0)    dtherm01(i) = his_th(i, id_prec)
-      if(id_fine>0)    dtherm02(i) = his_th(i, id_fine)
-      if(id_coss>0)    dtherm03(i) = his_th(i, id_coss)
-      if(id_codu>0)    dtherm04(i) = his_th(i, id_codu)
-      if(id_scdu>0)    dtherm05(i) = his_th(i, id_scdu)
-      if(id_prec>0)    dhkecv01(i) = his_dhkecv(i, id_prec)
-      if(id_fine>0)    dhkecv02(i) = his_dhkecv(i, id_fine)
-      if(id_coss>0)    dhkecv03(i) = his_dhkecv(i, id_coss)
-      if(id_codu>0)    dhkecv04(i) = his_dhkecv(i, id_codu)
-      if(id_scdu>0)    dhkecv05(i) = his_dhkecv(i, id_scdu)
-      if(id_prec>0)    d_tr_ds01(i) = his_ds(i, id_prec)
-      if(id_fine>0)    d_tr_ds02(i) = his_ds(i, id_fine)
-      if(id_coss>0)    d_tr_ds03(i) = his_ds(i, id_coss)
-      if(id_codu>0)    d_tr_ds04(i) = his_ds(i, id_codu)
-      if(id_scdu>0)    d_tr_ds05(i) = his_ds(i, id_scdu)
-      if(id_prec>0)    dhkelsc01(i) = his_dhkelsc(i, id_prec)
-      if(id_fine>0)    dhkelsc02(i) = his_dhkelsc(i, id_fine)
-      if(id_coss>0)    dhkelsc03(i) = his_dhkelsc(i, id_coss)
-      if(id_codu>0)    dhkelsc04(i) = his_dhkelsc(i, id_codu)
-      if(id_scdu>0)    dhkelsc05(i) = his_dhkelsc(i, id_scdu)
+      IF(id_prec>0)  trm01(i) = trm(i, id_prec)
+      IF(id_fine>0)  trm02(i) = trm(i, id_fine)
+      IF(id_coss>0)  trm03(i) = trm(i, id_coss)
+      IF(id_codu>0)  trm04(i) = trm(i, id_codu)
+      IF(id_scdu>0)  trm05(i) = trm(i, id_scdu)
+      IF(id_prec>0)    sconc01(i) = sconc_seri(i, id_prec)
+      IF(id_fine>0)    sconc02(i) = sconc_seri(i, id_fine)
+      IF(id_coss>0)    sconc03(i) = sconc_seri(i, id_coss)
+      IF(id_codu>0)    sconc04(i) = sconc_seri(i, id_codu)
+      IF(id_scdu>0)    sconc05(i) = sconc_seri(i, id_scdu)
+      IF(id_prec>0)    flux01(i) = flux_tr(i, id_prec)
+      IF(id_fine>0)    flux02(i) = flux_tr(i, id_fine)
+      IF(id_coss>0)    flux03(i) = flux_tr(i, id_coss)
+      IF(id_codu>0)    flux04(i) = flux_tr(i, id_codu)
+      IF(id_scdu>0)    flux05(i) = flux_tr(i, id_scdu)
+      IF(id_prec>0)    ds01(i) = his_ds(i, id_prec)
+      IF(id_fine>0)    ds02(i) = his_ds(i, id_fine)
+      IF(id_coss>0)    ds03(i) = his_ds(i, id_coss)
+      IF(id_codu>0)    ds04(i) = his_ds(i, id_codu)
+      IF(id_scdu>0)    ds05(i) = his_ds(i, id_scdu)
+      IF(id_prec>0)    dh01(i) = his_dh(i, id_prec)
+      IF(id_fine>0)    dh02(i) = his_dh(i, id_fine)
+      IF(id_coss>0)    dh03(i) = his_dh(i, id_coss)
+      IF(id_codu>0)    dh04(i) = his_dh(i, id_codu)
+      IF(id_scdu>0)    dh05(i) = his_dh(i, id_scdu)
+      IF(id_prec>0)    dtrconv01(i) = dtrconv(i, id_prec)
+      IF(id_fine>0)    dtrconv02(i) = dtrconv(i, id_fine)
+      IF(id_coss>0)    dtrconv03(i) = dtrconv(i, id_coss)
+      IF(id_codu>0)    dtrconv04(i) = dtrconv(i, id_codu)
+      IF(id_scdu>0)    dtrconv05(i) = dtrconv(i, id_scdu)
+      IF(id_prec>0)    dtherm01(i) = his_th(i, id_prec)
+      IF(id_fine>0)    dtherm02(i) = his_th(i, id_fine)
+      IF(id_coss>0)    dtherm03(i) = his_th(i, id_coss)
+      IF(id_codu>0)    dtherm04(i) = his_th(i, id_codu)
+      IF(id_scdu>0)    dtherm05(i) = his_th(i, id_scdu)
+      IF(id_prec>0)    dhkecv01(i) = his_dhkecv(i, id_prec)
+      IF(id_fine>0)    dhkecv02(i) = his_dhkecv(i, id_fine)
+      IF(id_coss>0)    dhkecv03(i) = his_dhkecv(i, id_coss)
+      IF(id_codu>0)    dhkecv04(i) = his_dhkecv(i, id_codu)
+      IF(id_scdu>0)    dhkecv05(i) = his_dhkecv(i, id_scdu)
+      IF(id_prec>0)    d_tr_ds01(i) = his_ds(i, id_prec)
+      IF(id_fine>0)    d_tr_ds02(i) = his_ds(i, id_fine)
+      IF(id_coss>0)    d_tr_ds03(i) = his_ds(i, id_coss)
+      IF(id_codu>0)    d_tr_ds04(i) = his_ds(i, id_codu)
+      IF(id_scdu>0)    d_tr_ds05(i) = his_ds(i, id_scdu)
+      IF(id_prec>0)    dhkelsc01(i) = his_dhkelsc(i, id_prec)
+      IF(id_fine>0)    dhkelsc02(i) = his_dhkelsc(i, id_fine)
+      IF(id_coss>0)    dhkelsc03(i) = his_dhkelsc(i, id_coss)
+      IF(id_codu>0)    dhkelsc04(i) = his_dhkelsc(i, id_codu)
+      IF(id_scdu>0)    dhkelsc05(i) = his_dhkelsc(i, id_scdu)
       u10m_ss(i) = u10m_ec(i)
       v10m_ss(i) = v10m_ec(i)
@@ -3985,44 +3984,44 @@
         DO k = 1, klev
 
-          if(id_prec>0)        d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu)
         ENDDO
       ENDDO
@@ -4030,44 +4029,44 @@
       DO i = 1, klon
         DO k = 1, klev
-          if(id_prec>0)        d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys
         ENDDO
       ENDDO
@@ -4077,24 +4076,24 @@
       DO i = 1, klon
         DO k = 1, klev
-          if(id_prec>0)        d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu)
-          if(id_prec>0)        d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec)
-          if(id_fine>0)        d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine)
-          if(id_coss>0)        d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss)
-          if(id_codu>0)        d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu)
-          if(id_scdu>0)        d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu)
+          IF(id_prec>0)        d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec)
+          IF(id_fine>0)        d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine)
+          IF(id_coss>0)        d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss)
+          IF(id_codu>0)        d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu)
+          IF(id_scdu>0)        d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu)
         ENDDO
       ENDDO
@@ -4102,24 +4101,24 @@
       DO i = 1, klon
         DO k = 1, klev
-          if(id_prec>0)        d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys
-          if(id_prec>0)        d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys
-          if(id_fine>0)        d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys
-          if(id_coss>0)        d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys
-          if(id_codu>0)        d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys
-          if(id_scdu>0)        d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys
+          IF(id_prec>0)        d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys
+          IF(id_fine>0)        d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys
+          IF(id_coss>0)        d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys
+          IF(id_codu>0)        d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys
+          IF(id_scdu>0)        d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys
         ENDDO
       ENDDO
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90	(revision 5116)
@@ -11,20 +11,20 @@
   INTEGER :: step, nbjour
   LOGICAL :: debutphy
-  real :: dust_ec(klon)
-  real :: dust_ec_glo(klon_glo)
+  REAL :: dust_ec(klon)
+  REAL :: dust_ec_glo(klon_glo)
 
   ! as      real dust_nc(iip1,jjp1)
-  real :: dust_nc_glo(nbp_lon + 1, nbp_lat)
-  integer :: rcode
-  integer :: ncid1, varid1, ncid2, varid2
+  REAL :: dust_nc_glo(nbp_lon + 1, nbp_lat)
+  INTEGER :: rcode
+  INTEGER :: ncid1, varid1, ncid2, varid2
 
   save ncid1, varid1, ncid2, varid2
   !$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2)
-  integer :: start(4), count(4), status
-  integer :: i, j, ig
+  INTEGER :: start(4), count(4), status
+  INTEGER :: i, j, ig
 
   !$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_surface.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90	(revision 5116)
@@ -39,5 +39,5 @@
       real, dimension(jjp1) :: lats
       real, dimension(nbp_lat) :: lats_glo
-      real :: rcode2
+      REAL :: rcode2
       integer, dimension(1) :: startj,endj
 !JE20140526>>
@@ -83,5 +83,5 @@
 
        DO i=1,5
-          write(str1,'(i1)') i
+          WRITE(str1,'(i1)') i
           varname=trim(name)//str1
        PRINT*,'lecture variable:',varname
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90	(revision 5116)
@@ -10,22 +10,21 @@
   INTEGER :: step, nbjour
   LOGICAL :: debutphy
-  real :: u10m_ec(klon), v10m_ec(klon)
-  real :: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)
+  REAL :: u10m_ec(klon), v10m_ec(klon)
+  REAL :: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)
 
   !  real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72
   !  real v10m_nc(iip1,jjp1)  ! dim 97x73
-  real :: u10m_nc_glo(nbp_lon + 1, nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72
-  real :: v10m_nc_glo(nbp_lon + 1, nbp_lat)  ! dim 97x73
-  integer :: rcode
-  integer :: ncidu1, varidu1, ncidv1, varidv1
+  REAL :: u10m_nc_glo(nbp_lon + 1, nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72
+  REAL :: v10m_nc_glo(nbp_lon + 1, nbp_lat)  ! dim 97x73
+  INTEGER :: rcode
+  INTEGER :: ncidu1, varidu1, ncidv1, varidv1
   save ncidu1, varidu1, ncidv1, varidv1
   !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
-  integer :: start(4), count(4), status
-  integer :: i, j, ig
+  INTEGER :: start(4), count(4), status
+  INTEGER :: i, j, ig
 
   !$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)
@@ -107,12 +106,12 @@
 ! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
 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
     do i = 2, iim - 1
-      if(abs(x(i, l))>1.e10) then
+      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
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90	(revision 5116)
@@ -8,9 +8,9 @@
        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(:)
@@ -97,5 +97,5 @@
     !-------------------------------------------------------------------
 
-    if (rain_effect) then
+    if (rain_effect) THEN
        taur = mom_flux_rain(u, rain)
     else
@@ -106,6 +106,6 @@
     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, &
@@ -122,5 +122,5 @@
     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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/config_ocean_skin_m.F90	(revision 5116)
@@ -30,6 +30,6 @@
 
 #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
 
@@ -45,13 +45,13 @@
     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)
     end if
 #else
-    write(unit = *, nml = config_ocean_skin_nml)
+    WRITE(unit = *, nml = config_ocean_skin_nml)
     print *, "Enter namelist config_ocean_skin_nml."
     read(unit = *, nml = config_ocean_skin_nml)
-    write(unit = *, nml = config_ocean_skin_nml)
+    WRITE(unit = *, nml = config_ocean_skin_nml)
 #endif
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/esat_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/esat_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/esat_m.F90	(revision 5116)
@@ -18,5 +18,5 @@
          * exp(17.502 * (T - 273.15) / (T - 32.18))
 
-  end function esat
+  END FUNCTION esat
 
 end module esat_m
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/fv_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/fv_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/fv_m.F90	(revision 5116)
@@ -30,5 +30,5 @@
     !---------------------------------------------------------------------
 
-    if (rain > 0.) then
+    if (rain > 0.) THEN
        rc = 0.4 ! mm
        z_mm = z * 1000. ! mm and <0
@@ -42,5 +42,5 @@
     endif
 
-  end function fV
+  END FUNCTION fV
 
 end module fv_m
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/microlayer_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/microlayer_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/microlayer_m.F90	(revision 5116)
@@ -10,6 +10,6 @@
     ! 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(:)
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/mom_flux_rain_m.F90	(revision 5116)
@@ -20,5 +20,5 @@
     ! as in paragraph 3.a, maybe adequate if u is the wind at 10 m)
 
-  end function mom_flux_rain
+  END FUNCTION mom_flux_rain
   
 end module mom_flux_rain_m
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/near_surface_m.F90	(revision 5116)
@@ -13,8 +13,8 @@
     ! 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)
@@ -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)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/phiw_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/phiw_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/phiw_m.F90	(revision 5116)
@@ -13,5 +13,5 @@
     !----------------------------------------------
 
-    if (zL < 0.) then
+    if (zL < 0.) THEN
        Phiw = (1. - 16. * zL)**(- 0.5)
     else
@@ -20,5 +20,5 @@
     end if
 
-  end function Phiw
+  END FUNCTION Phiw
 
 end module Phiw_m
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/sens_heat_rain_m.F90	(revision 5116)
@@ -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
@@ -66,5 +66,5 @@
     sens_heat_rain =  rain * alfac * cpw * (t_int - t + (q_int - q) * xlv / cpa)
 
-  end function sens_heat_rain
+  END FUNCTION sens_heat_rain
   
 end module sens_heat_rain_m
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/therm_expans_m.F90	(revision 5116)
@@ -15,5 +15,5 @@
     therm_expans = 2.1e-5 * (t - 269.95)**0.79
 
-  end function therm_expans
+  END FUNCTION therm_expans
 
 end module therm_expans_m
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/miecalc_aer.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/miecalc_aer.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/miecalc_aer.F90	(revision 5116)
@@ -21,5 +21,5 @@
   USE dimphy
   USE lmdz_yomcst  , ONLY: RG, RPI
-  USE lmdz_phys_para, only: gather, scatter, bcast
+  USE lmdz_phys_para, ONLY: gather, scatter, bcast
   USE lmdz_grid_phy, ONLY: klon_glo
   USE lmdz_phys_mpi_data, ONLY:  is_mpi_root
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 5116)
@@ -50,5 +50,5 @@
           ALLOCATE(m_aer_emiss_vol(nErupt, nAerErupt))
           m_aer_emiss_vol = 0. ; m_sulf_emiss_vol = 0.
-          IF (ok_qemiss) then
+          IF (ok_qemiss) THEN
             ALLOCATE(m_H2O_emiss_vol(nErupt))
             ALLOCATE(m_H2O_emiss_vol_daily(nErupt))
@@ -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
@@ -154,5 +154,5 @@
     !============= Print params =============
     IF (is_master) THEN
-      IF (nErupt > 0) then
+      IF (nErupt > 0) THEN
         if (flag_emit == 1 .OR. flag_emit == 4) THEN
           WRITE(lunout, *) 'IN STRATAER nErupt: ', nErupt
@@ -172,5 +172,5 @@
             WRITE(lunout, *) 'IN STRATAEREMISS : m_sulf_emiss_vol', m_sulf_emiss_vol
             WRITE(lunout, *) 'IN STRATAER : m_aer_emiss_vol', m_aer_emiss_vol
-            IF (ok_qemiss) then
+            IF (ok_qemiss) THEN
               WRITE(lunout, *) 'IN STRATAEREMISS : m_H2O_emiss_vol', m_H2O_emiss_vol
             ENDIF
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/stratemit.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/stratemit.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/stratemit.F90	(revision 5116)
@@ -95,5 +95,5 @@
           CALL STRATDISTRIB(altLMDz,altemiss,sigma_alt,f_lay_emiss)
           
-          IF (flag_emit==3) then
+          IF (flag_emit==3) THEN
              theta=(sin(theta_max/180.*RPI)-sin(theta_min/180.*RPI))/ &
    (sin(xlat_max_sai/180.*RPI)-sin(xlat_min_sai/180.*RPI))
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5116)
@@ -93,8 +93,8 @@
 !      ***   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 
-!              H2SO4-H2O flat surface, only on the first timestep
+!              H2SO4-H2O flat surface, ONLY on the first timestep
                radwet = 1.e-2*RRSI(IK)*f_r_wet(ilon,ilev)
              endif
@@ -787,5 +787,5 @@
 
 
-    end function psh2so4
+    END FUNCTION psh2so4
 !-----------------------------------------------------------------------
     real function ndsh2so4(T) result(ndsh2so4_out)
@@ -794,5 +794,5 @@
       IMPLICIT NONE
       real, intent(in) :: T
-      real :: presat
+      REAL :: presat
 
 !     Boltzmann constant ( 1.38065e-23 J/K = m2⋅kg/(s2⋅K) )
@@ -806,5 +806,5 @@
 
 
-     end function ndsh2so4
+     END FUNCTION ndsh2so4
 !-----------------------------------------------------------------------
      real function psh2o(T) result(psh2o_out)
@@ -814,5 +814,5 @@
       real, intent(in) :: T
 
-      if(T>229.) then
+      IF(T>229.) THEN
 !        Preining et al., 1981 (from Kulmala et al., 1998)
 !        saturation vapor pressure (N/m2 = 1 Pa = 1 kg/(m·s2))
@@ -833,5 +833,5 @@
       
 
-     end function psh2o
+     END FUNCTION psh2o
 !-----------------------------------------------------------------------
      real function density(T,so4mfrac) result(density_out)
@@ -867,5 +867,5 @@
         c6=-7.458060e-4, &
         c7= 2.581390e-4
-      real :: a,b,c,so4m2,so4m3,so4m4,so4m5,so4m6
+      REAL :: a,b,c,so4m2,so4m3,so4m4,so4m5,so4m6
       
       so4m2=so4mfrac*so4mfrac
@@ -884,5 +884,5 @@
 
 
-     end function density
+     END FUNCTION density
 !-----------------------------------------------------------------------
      real function surftension(T,so4frac) result(surftension_out)
@@ -893,5 +893,5 @@
       IMPLICIT NONE
       real,intent(in) :: T, so4frac
-      real :: a,b,so4mfrac,so4m2,so4m3,so4m4,so4m5,so4sig
+      REAL :: a,b,so4mfrac,so4m2,so4m3,so4m4,so4m5,so4sig
       real, parameter :: &
        a1= 0.11864, &
@@ -924,5 +924,5 @@
 
 
-     end function surftension
+     END FUNCTION surftension
 !-----------------------------------------------------------------------
      real function wph2so4(pph2o,T) result(wph2so4_out)
@@ -944,5 +944,5 @@
       real, intent(in) :: pph2o, T 
       
-      real :: aw, rh, y1, y2, sulfmolal
+      REAL :: aw, rh, y1, y2, sulfmolal
   
 !       psh2o(T): equilibrium H2O pressure over pure liquid water (Pa)
@@ -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
@@ -999,5 +999,5 @@
 
 
-     end function wph2so4
+     END FUNCTION wph2so4
 !-----------------------------------------------------------------------
      real function solh2so4(T,xa) result(solh2so4_out)
@@ -1007,5 +1007,5 @@
       real, intent(in) :: T, xa       ! T(K)  xa(H2SO4 mass fraction)
       
-      real :: xw, a12,b12, cacta, presat
+      REAL :: xw, a12,b12, cacta, presat
       
       xw=1.0-xa
@@ -1021,5 +1021,5 @@
 
 
-     end function solh2so4
+     END FUNCTION solh2so4
 !-----------------------------------------------------------------------      
      real function rpmvh2so4(T,ws) result(rpmvh2so4_out)
@@ -1035,5 +1035,5 @@
    -0.2315332,1.60074E-03,-2.5827835E-06/)
       
-      real :: w
+      REAL :: w
 
         w=ws*0.01
@@ -1044,5 +1044,5 @@
         
 
-     end function rpmvh2so4
+     END FUNCTION rpmvh2so4
 !-----------------------------------------------------------------------
      real function rmvh2o(T) result(rmvh2o_out)
@@ -1058,5 +1058,5 @@
        
 
-     end function rmvh2o
+     END FUNCTION rmvh2o
 
 END MODULE sulfate_aer_mod
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/traccoag_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/traccoag_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/traccoag_mod.F90	(revision 5116)
@@ -20,5 +20,5 @@
     USE lmdz_grid_phy
     USE lmdz_phys_mpi_data, ONLY: is_mpi_root
-    USE lmdz_phys_para, only: gather, scatter
+    USE lmdz_phys_para, ONLY: gather, scatter
     USE phys_cal_mod, ONLY: year_len, year_cur, mth_cur, day_cur, hour
     USE sulfate_aer_mod
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/aaam_bud.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/aaam_bud.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/aaam_bud.F90	(revision 5116)
@@ -330,10 +330,10 @@
 
 
-  ! write(*,*) 'AAM',rsec,
-  ! write(*,*) 'AAM',rjour+rsec/86400.,
+  ! WRITE(*,*) 'AAM',rsec,
+  ! WRITE(*,*) 'AAM',rjour+rsec/86400.,
   ! c      raam(3)/hadday,oaam(3)/hadday,
   ! c      tmou(3)/hadley,tsso(3)/hadley,tbls(3)/hadley
 
-  ! write(iam,100)rjour+rsec/86400.,
+  ! WRITE(iam,100)rjour+rsec/86400.,
   ! c      raam(1)/hadday,oaam(1)/hadday,
   ! c      tmou(1)/hadley,tsso(1)/hadley,tbls(1)/hadley,
@@ -344,12 +344,12 @@
 100 FORMAT (F12.5, 15(1X,F12.5))
 
-  ! write(iam+1,*)((zs(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ps(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ub(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((vb(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ssou(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((ssov(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((blsu(i,j),i=1,nbp_lon),j=1,nbp_lat)
-  ! write(iam+1,*)((blsv(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((zs(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((ps(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((ub(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((vb(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((ssou(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((ssov(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((blsu(i,j),i=1,nbp_lon),j=1,nbp_lat)
+  ! WRITE(iam+1,*)((blsv(i,j),i=1,nbp_lon),j=1,nbp_lat)
 
   aam = raam(3)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90	(revision 5116)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90	(revision 5116)
@@ -290,5 +290,5 @@
           PRINT*,'l    T     dT       Q     dQ    '
           DO k = 1, klev
-             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+             WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
           ENDDO
           CALL print_debug_phys(i,debug_level,text)
@@ -304,10 +304,10 @@
       DO j = 1, jqbad
         i=jqadrs(j)
-          if(prt_level>=debug_level) THEN
+          IF(prt_level>=debug_level) THEN
            PRINT*,'WARNING  : EAU POUR LE POINT i lon lat =',&
                   i,longitude_deg(i),latitude_deg(i),text
            PRINT*,'l    T     dT       Q     dQ    '
            DO k = 1, klev
-              write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+              WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
            ENDDO
           ENDIF
@@ -367,5 +367,5 @@
         jbad = jbad + 1
         jadrs(jbad) = i
-!         if(prt_level.ge.debug_level) THEN
+!         IF(prt_level.ge.debug_level) THEN
 !         PRINT*,'cas2 i k t_seri zdt',i,k,t_seri(i,k),zdt(i,k)
 !        endif
@@ -375,5 +375,5 @@
         jqadrs(jqbad) = i
         kqadrs(jqbad) = k
-!        if(prt_level.ge.debug_level) THEN
+!        IF(prt_level.ge.debug_level) THEN
 !         PRINT*,'cas2 i k q_seri zdq',i,k,q_seri(i,k),zdq(i,k)
 !        endif
@@ -385,12 +385,12 @@
          i=jadrs(j)
          k=kadrs(j)
-         if(prt_level>=debug_level) THEN
+         IF(prt_level>=debug_level) THEN
           PRINT*,'PLANTAGE2 POUR LE POINT i itap lon lat txt jbad zdt t',&
                  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
-             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+             WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
           ENDDO
           CALL print_debug_phys(i,debug_level,text)
@@ -407,8 +407,8 @@
                  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
-            write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+            WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
           ENDDO
           CALL print_debug_phys(i,debug_level,text)
@@ -801,14 +801,14 @@
 
   IF (prt_level >= 3) THEN
-    write(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error,"  H", bilh_error
+    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)
   ENDIF
   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)
+    WRITE(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1)
   ENDIF
   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)
-    write(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1),d_h_qbs_col(1)
+    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)
+    WRITE(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1),d_h_qbs_col(1)
   ENDIF
 
@@ -816,16 +816,16 @@
   CASE("vdf") specific_diag
     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)
+      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)
     ENDIF
   CASE("lsc") specific_diag
     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)
+      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)
     ENDIF
   CASE("convection") specific_diag
     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)
+      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)
     ENDIF
   END SELECT specific_diag
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/add_wake_tend.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/add_wake_tend.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/add_wake_tend.F90	(revision 5116)
@@ -30,5 +30,5 @@
 
 
-     IF (prt_level >= 5) then
+     IF (prt_level >= 5) THEN
         write (*,*) "In add_wake_tend, after ",text
         CALL flush
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_5wv.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_5wv.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/aeropt_5wv.F90	(revision 5116)
@@ -10,5 +10,5 @@
   USE DIMPHY
   USE aero_mod
-  USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer
+  USE phys_local_var_mod, ONLY: od550aer,od865aer,ec550aer,od550lt1aer
   USE pres2lev_mod
   USE lmdz_abort_physic, ONLY: abort_physic
@@ -725,5 +725,5 @@
     ENDIF
 
-    IF (soluble) then
+    IF (soluble) THEN
       used_tau(spsol)=.TRUE.
     ELSE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/albsno.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/albsno.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/albsno.F90	(revision 5116)
@@ -35,5 +35,5 @@
 !****************************************************************************************
 
-  if (albsno0>=0.) then
+  if (albsno0>=0.) THEN
      init(:)=albsno0
      decay(:)=0.
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.F90	(revision 5116)
@@ -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,5 +97,5 @@
        !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 (iflag_coupl==0) THEN
           if (debut.and.prt_level>9) &
                WRITE(lunout,*)'ALE et ALP imposes'
@@ -114,6 +114,6 @@
           ! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
           !             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
-          !         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
-          !         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
+          !         WRITE(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
+          !         WRITE(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
           !         enddo
 
@@ -130,5 +130,5 @@
                    www(i)=max(www(i),-omega(i,k)*RD*t_seri(i,k) &
                         /(RG*paprs(i,k)) *zw2(i,k)*zw2(i,k))
-                   ! if (paprs(i,k)>pbase(i)) then
+                   ! if (paprs(i,k)>pbase(i)) THEN
                    ! calcul approche de la vitesse verticale en m/s
                    !  www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k))
@@ -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
@@ -166,5 +166,5 @@
                      +alp_bl(i)  *(1.+3.*www(i)/( sqrt(ale_bl(i))  +0.1) )
                 !    ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
-                !             if (alp(i)<0.) then
+                !             if (alp(i)<0.) THEN
                 !                PRINT*,'ALP ',alp(i),alp_wake(i) &
                 !                     ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
@@ -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_th.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90	(revision 5116)
@@ -101,5 +101,5 @@
 !!
 !!   Control of the multiplication of no-trigger probabilities between calls 
-!! to the convection scheme. If multiply_proba_notrig is .FALSE., then
+!! to the convection scheme. If multiply_proba_notrig is .FALSE., THEN
 !! proba_notrig is set to 1 at each CALL to alpale_th, so that only the last CALL
 !! plays a role in the triggering of convection. If it is .TRUE., then propa_notrig
@@ -127,6 +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 ', &
@@ -140,5 +139,5 @@
                 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 ( ale_bl_trig(i) < abs(cin(i))+1.e-10 ) THEN
                    tau_trig(i)=tau_trig_shallow
                 else
@@ -155,13 +154,12 @@
 
              !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
-             IF (iflag_trig_bl==1) then
-
+             IF (iflag_trig_bl==1) THEN
                 !----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,12 +176,11 @@
                 enddo
 
-             ELSE IF (iflag_trig_bl>=2) then
-
+             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
@@ -210,15 +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
@@ -240,6 +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 ', &
@@ -264,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
@@ -280,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))
@@ -299,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
@@ -326,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/atm2geo.F90	(revision 5116)
@@ -5,5 +5,5 @@
   USE dimphy
   USE lmdz_phys_para
-  USE lmdz_grid_phy, only: grid_type, unstructured, regular_lonlat
+  USE lmdz_grid_phy, ONLY: grid_type, unstructured, regular_lonlat
   USE lmdz_abort_physic, ONLY: abort_physic
   IMPLICIT NONE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90	(revision 5116)
@@ -12,5 +12,5 @@
   ! physiq.f pour des sorties directes de beta
 
-  USE phys_cal_mod, only: year_len
+  USE phys_cal_mod, ONLY: year_len
   USE lmdz_print_control, ONLY: prt_level
 
@@ -43,6 +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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_STDlev.h	(revision 5116)
@@ -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
@@ -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)
@@ -209,5 +209,5 @@
       DO n=1, nlevSTD3
        DO k=1, nlevSTD
-        if(rlevSTD3(n).EQ.rlevSTD(k)) THEN
+        IF(rlevSTD3(n).EQ.rlevSTD(k)) THEN
          twriteSTD3(:,n)=tlevSTD(:,k)
          qwriteSTD3(:,n)=qlevSTD(:,k)
@@ -223,5 +223,5 @@
       DO n=1, nlevSTD8
        DO k=1, nlevSTD
-        if(rlevSTD8(n).EQ.rlevSTD(k)) THEN
+        IF(rlevSTD8(n).EQ.rlevSTD(k)) THEN
          tnondefSTD8(:,n)=tnondef(:,k,2)
          twriteSTD8(:,n)=tsumSTD(:,k,2)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/calcul_fluxs_mod.F90	(revision 5116)
@@ -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"
@@ -124,5 +124,5 @@
 !!$  WRITE(*,*)'test calcul_flux, surface ', nisurf
 !!PB test
-!!$    if (nisurf == is_oce) then
+!!$    if (nisurf == is_oce) THEN
 !!$      snow = 0.
 !!$      qsol = max_eau_sol
@@ -244,5 +244,5 @@
 ! en cas de fonte de neige
 
-!    if (fonte_neige) then
+!    if (fonte_neige) THEN
 !      bilan_f = radsol(i) + fluxsens(i) - (zx_sl(i) * evap (i)) - &
 !     &          dif_grnd(i) * (tsurf_new(i) - t_grnd) - &
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/call_ini_replay.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/call_ini_replay.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/call_ini_replay.F90	(revision 5116)
@@ -1,4 +1,4 @@
    SUBROUTINE call_ini_replay
    stop 'In call_ini_replay : You should run replay_equip.sh before runing replay[13]d'
-   return
+   RETURN
    end
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/call_param_replay.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/call_param_replay.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/call_param_replay.F90	(revision 5116)
@@ -2,4 +2,4 @@
    integer,intent(in) :: ngrid,nlay
    stop 'In call_param_replay : You should run replay_equip.sh before runing replay[13]d'
-   return
+   RETURN
    end
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90	(revision 5116)
@@ -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
@@ -211,5 +211,5 @@
 !               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
+               if (logexpr2(i,k)) THEN
 #ifdef ISO
                 qprec(i,k)=q_seri(i,k)
@@ -229,18 +229,18 @@
             enddo
          enddo
-         if(nbptspb>0) PRINT*,'Number of points with q_seri(i,k)<=0 ',nbptspb
+         IF(nbptspb>0) PRINT*,'Number of points with q_seri(i,k)<=0 ',nbptspb
 
 
          new_thermcell=iflag_thermals>=15.and.iflag_thermals<=18
 #ifdef ISO
-      if (.not.new_thermcell) then
+      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, &
              'calltherm 174',ntiso,klon,klev)
-      endif !if (iso_eau.gt.0) then
+      endif !if (iso_eau.gt.0) THEN
 #endif    
 #endif
@@ -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'
@@ -342,5 +342,5 @@
 ! 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
@@ -401,11 +401,11 @@
             xt_seri(:,:,:) = xt_seri(:,:,:) + d_xt_the(:,:,:)
 #ifdef ISOVERIF
-!      write(*,*) 'calltherm 350 tmp: ajout d_xt_the'
-      if (iso_HDO.gt.0) then
+!      WRITE(*,*) 'calltherm 350 tmp: ajout d_xt_the'
+      if (iso_HDO.gt.0) THEN
 !      i=479
 !      k=4
-!      write(*,*) 'xt_seri(iso_hdo,i,k),q_seri(i,k)=', &
+!      WRITE(*,*) 'xt_seri(iso_hdo,i,k),q_seri(i,k)=', &
 !     &   xt_seri(iso_hdo,i,k),q_seri(i,k)
-!      write(*,*) 'd_xt_the(iso_hdo,i,k),d_q_the(i,k)=', &
+!      WRITE(*,*) 'd_xt_the(iso_hdo,i,k),d_q_the(i,k)=', &
 !     &   d_xt_the(iso_hdo,i,k),d_q_the(i,k)
       CALL iso_verif_aberrant_enc_vect2D( &
@@ -415,13 +415,13 @@
 #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
             fm_therm(i,klev+1)=0.
             ale_bl(i)=ale_bl(i)+ale(i)/REAL(nsplit_thermals)
-!            write(22,*)'ALE CALLTHERM',ale_bl(i),ale(i)
+!            WRITE(22,*)'ALE CALLTHERM',ale_bl(i),ale(i)
             alp_bl(i)=alp_bl(i)+alp(i)/REAL(nsplit_thermals)
-!            write(23,*)'ALP CALLTHERM',alp_bl(i),alp(i)
-        if(prt_level>=10) PRINT*,'calltherm i alp_bl alp ale_bl ale',i,alp_bl(i),alp(i),ale_bl(i),ale(i)
+!            WRITE(23,*)'ALP CALLTHERM',alp_bl(i),alp(i)
+        IF(prt_level>=10) PRINT*,'calltherm i alp_bl alp ale_bl ale',i,alp_bl(i),alp(i),ale_bl(i),ale(i)
        ENDDO
 
@@ -433,5 +433,5 @@
             DO i = 1, klon
                logexpr2(i,k)=.not.q_seri(i,k)>=0.
-               if (logexpr2(i,k)) then
+               if (logexpr2(i,k)) THEN
                 q_seri(i,k)=1.e-15
                 nbptspb=nbptspb+1
@@ -441,5 +441,5 @@
                 enddo
 #endif
-!                if (prt_level.ge.10) then
+!                if (prt_level.ge.10) THEN
 !                  PRINT*,'WARN eau<0 apres therm i=',i,'  k=',k  &
 !    &         ,' dq,q',d_q_the(i,k),q_seri(i,k),  &
@@ -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, &
@@ -466,5 +466,5 @@
                if (logexpr2(i,k)) nbptspb=nbptspb+1
 !              if ((t_seri(i,k).lt.50.) .or.  &
-!    &              (t_seri(i,k).gt.370.)) then
+!    &              (t_seri(i,k).gt.370.)) THEN
 !                 PRINT*,'WARN temp apres therm i=',i,'  k=',k  &
 !    &         ,' t_seri',t_seri(i,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)
@@ -520,5 +520,5 @@
                    clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
                    if (clwcon0(i,k)<0. .or.   &
-               (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) then
+               (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) THEN
                       clwcon0(i,k)=0.
                    endif
@@ -530,5 +530,5 @@
                    clwcon0(i,k)=zqla(i,k)  
                    if (clwcon0(i,k)<0. .or.   &
-               (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) then
+               (fm_therm(i,k+1)+detrc_therm(i,k))<1.e-6) THEN
                    clwcon0(i,k)=0. 
                    endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cdrag_mod.F90	(revision 5116)
@@ -313,5 +313,5 @@
          cdm(i)=cdmm(i)
          cdh(i)=cdhh(i)
-         write(*,*) "clc_core cd ch",cdmm(i),cdhh(i)
+         WRITE(*,*) "clc_core cd ch",cdmm(i),cdhh(i)
 
 !------------------                 Pour ECUME                 --------------------
@@ -336,5 +336,5 @@
          cdh(i)=cdhh(i)
    
-         write(*,*) "ecume cd ch",cdmm(i),cdhh(i)
+         WRITE(*,*) "ecume cd ch",cdmm(i),cdhh(i)
 
 !------------------                 Pour COARE CNRM                 --------------------
@@ -359,5 +359,5 @@
          cdm(i)=cdmm(i)
          cdh(i)=cdhh(i)
-         write(*,*) "coare CNRM cd ch",cdmm(i),cdhh(i)
+         WRITE(*,*) "coare CNRM cd ch",cdmm(i),cdhh(i)
 
 !------------------                 Pour COARE Maison                 --------------------
@@ -366,5 +366,5 @@
            pblh(i) = 1500.
          ENDIF
-         write(*,*) "debug size",size(coeffs)
+         WRITE(*,*) "debug size",size(coeffs)
          CALL coare_cp(sqrt(zdu2),t1(i)-tsurf(i),q1(i)-qsurf(i),&
                t1(i),q1(i),&
@@ -377,5 +377,5 @@
          cdm(i)=cdmm(i)
          cdh(i)=cdhh(i)
-         write(*,*) "coare cd ch",cdmm(i),cdhh(i)
+         WRITE(*,*) "coare cd ch",cdmm(i),cdhh(i)
        ELSE
 !------------------                 Pour La param LMDZ (ocean)              --------------------
@@ -446,5 +446,5 @@
              cdmm(i)=MIN(cdmm(i),cdmmax)
              cdhh(i)=MIN(cdhh(i),cdhmax)
-!             write(*,*) "LMDZ cd ch",cdmm(i),cdhh(i)
+!             WRITE(*,*) "LMDZ cd ch",cdmm(i),cdhh(i)
            END IF
          ELSE                          
@@ -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/cfmip_point_locations.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cfmip_point_locations.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cfmip_point_locations.F90	(revision 5116)
@@ -97,9 +97,9 @@
      lonGCM(ip)=lon(ipt(ip))
      latGCM(ip)=io_lat(jpt(ip))
-     if(jpt(ip)>=2.AND.jpt(ip)<=nbp_lat-1) THEN
+     IF(jpt(ip)>=2.AND.jpt(ip)<=nbp_lat-1) THEN
       tabijGCM(ip)=1+(jpt(ip)-2)*nbp_lon+ipt(ip)
-     else if(jpt(ip)==1) THEN
+     else IF(jpt(ip)==1) THEN
       tabijGCM(ip)=1
-     else if(jpt(ip)==nbp_lat) THEN
+     else IF(jpt(ip)==nbp_lat) THEN
       tabijGCM(ip)=klon_glo
      else 
@@ -109,5 +109,5 @@
     ENDDO
     DO ip=1, npCFMIP
-     if(lonGCM(ip)==io_lon(1)) lonGCM(ip)=360.+lonGCM(ip)
+     IF(lonGCM(ip)==io_lon(1)) lonGCM(ip)=360.+lonGCM(ip)
     ENDDO
    DO i=1, npCFMIP
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90	(revision 5116)
@@ -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 
@@ -89,5 +89,5 @@
 
 
-  if ( dt > 0. ) then
+  if ( dt > 0. ) THEN
      ch_n10 = 0.018 * cd_n10_rt                !!!!!!! si regime stable calcul du ch
 !     z_0h = 10. * exp(-k/ch_n10)
@@ -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/clift.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/clift.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/clift.F90	(revision 5116)
@@ -42,6 +42,6 @@
 
   include "YOMCST.h"
-  real :: p,t,rr,rs,plcl,dplcldt,dplcldq,cpd,cpv,cl,cpvmcl,eps,alv0,a,b
-  real :: rh,chi,alv
+  REAL :: p,t,rr,rs,plcl,dplcldt,dplcldq,cpd,cpv,cl,cpvmcl,eps,alv0,a,b
+  REAL :: rh,chi,alv
 
   cpd = rcpd
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/clouds_gno.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/clouds_gno.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/clouds_gno.F90	(revision 5116)
@@ -217,5 +217,5 @@
           ! -- test numerical convergence:
 
-          ! if (beta(i).lt.1.e-10) then
+          ! if (beta(i).lt.1.e-10) THEN
           ! PRINT*,'avant test ',i,k,lconv(i),u(i),v(i),beta(i)
           ! stop
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cmp_seri_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cmp_seri_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cmp_seri_mod.F90	(revision 5116)
@@ -34,5 +34,5 @@
     !======================================================================
 
-    if (first) then
+    if (first) THEN
        ALLOCATE(u_prev(klon,klev))
        ALLOCATE(v_prev(klon,klev))
@@ -78,5 +78,5 @@
 
     dt_seri(:,:)=t_seri(:,:)-t_prev(:,:)
-    IF (any(t_seri/=t_prev)) then
+    IF (any(t_seri/=t_prev)) THEN
        if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** t_seri has changed',minval(dt_seri),maxval(dt_seri)
@@ -88,5 +88,5 @@
 
     dq_seri(:,:)=q_seri(:,:)-q_prev(:,:)
-    IF (any(q_seri/=q_prev)) then
+    IF (any(q_seri/=q_prev)) THEN
        if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** q_seri has changed',minval(dq_seri),maxval(dq_seri)
@@ -98,5 +98,5 @@
 
     dql_seri(:,:)=ql_seri(:,:)-ql_prev(:,:)
-    IF (any(ql_seri/=ql_prev)) then
+    IF (any(ql_seri/=ql_prev)) THEN
        if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** ql_seri has changed',minval(dql_seri),maxval(dql_seri)
@@ -108,5 +108,5 @@
 
     dqs_seri(:,:)=qs_seri(:,:)-qs_prev(:,:)
-    IF (any(qs_seri/=qs_prev)) then
+    IF (any(qs_seri/=qs_prev)) THEN
        if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** qs_seri has changed',minval(dqs_seri),maxval(dqs_seri)
@@ -118,5 +118,5 @@
 
     du_seri(:,:)=u_seri(:,:)-u_prev(:,:)
-    IF (any(u_seri/=u_prev)) then
+    IF (any(u_seri/=u_prev)) THEN
        if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** u_seri has changed',minval(du_seri),maxval(du_seri)
@@ -128,5 +128,5 @@
 
     dv_seri(:,:)=v_seri(:,:)-v_prev(:,:)
-    IF (any(v_seri/=v_prev)) then
+    IF (any(v_seri/=v_prev)) THEN
        if ( .not. any_differ ) write (*,*) "In cmp_seri, after ",text
        write (*,*) '*** v_seri has changed',minval(dv_seri),maxval(dv_seri)
@@ -137,9 +137,9 @@
     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
-             write(*,'(i3,6e14.6)')k, t_seri(i,k)-t_prev(i,k), u_seri(i,k)-u_prev(i,k), &
+             WRITE(*,'(i3,6e14.6)')k, t_seri(i,k)-t_prev(i,k), u_seri(i,k)-u_prev(i,k), &
                   v_seri(i,k)-v_prev(i,k), ql_seri(i,k)-ql_prev(i,k),&
                   qs_seri(i,k)-qs_prev(i,k), q_seri(i,k)-q_prev(i,k)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/coare30_flux_cnrm_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/coare30_flux_cnrm_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/coare30_flux_cnrm_mod.F90	(revision 5116)
@@ -483,9 +483,9 @@
 
   IF (ABS(PCDN(J))>1.E-2) THEN   !!!! secure COARE3.0 CODE
-    write(*,*) 'pb PCDN in COARE30: ',PCDN(J)
-    write(*,*) 'point: ',J,"/",SIZE(PTA)
-    write(*,*) 'roughness: ', ZO(J)
-    write(*,*) 'ustar: ',ZUSR(J)
-    write(*,*) 'wind: ',ZDUWG(J)
+    WRITE(*,*) 'pb PCDN in COARE30: ',PCDN(J)
+    WRITE(*,*) 'point: ',J,"/",SIZE(PTA)
+    WRITE(*,*) 'roughness: ', ZO(J)
+    WRITE(*,*) 'ustar: ',ZUSR(J)
+    WRITE(*,*) 'wind: ',ZDUWG(J)
     CALL abort_physic('COARE30',': PCDN too large -> no convergence',1)
   ELSE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90	(revision 5116)
@@ -10,7 +10,7 @@
     real, intent(in) :: zet
 
-    real :: x, psik, psic, f, c
-
-    if(zet<0) then
+    REAL :: x, psik, psic, f, c
+
+    IF(zet<0) THEN
       x=(1.-(15.*zet))**.5
       psik=2.*log((1.+x)/2)
@@ -24,5 +24,5 @@
     endif
 
-  end function psit_30
+  END FUNCTION psit_30
 
   real function psiuo(zet)
@@ -30,7 +30,7 @@
     real, intent(in) :: zet
 
-    real :: x, psik, psic, f, c
-
-    if (zet<0) then
+    REAL :: x, psik, psic, f, c
+
+    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.)
@@ -44,5 +44,5 @@
   endif
 
-end function psiuo
+END FUNCTION psiuo
 
 
@@ -153,5 +153,5 @@
   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
@@ -161,5 +161,5 @@
   L10=zu/zetu
 
-  ! if (zetu .GT. 50) then
+  ! if (zetu .GT. 50) THEN
   !    nits=1
   ! endif
@@ -171,8 +171,8 @@
 
   ! 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
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/coef_diff_turb_mod.F90	(revision 5116)
@@ -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/conema3.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/conema3.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/conema3.F90	(revision 5116)
@@ -258,8 +258,8 @@
 
 
-    ! sb3d      write(*,1792) (em_work1(m),m=1,klev)
+    ! sb3d      WRITE(*,1792) (em_work1(m),m=1,klev)
 1792 FORMAT ('sig avant convect ', /, 10(1X,E13.5))
 
-    ! sb d      write(*,1793) (em_work2(m),m=1,klev)
+    ! sb d      WRITE(*,1793) (em_work2(m),m=1,klev)
 1793 FORMAT ('w avant convect ', /, 10(1X,E13.5))
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/conemav.F90	(revision 5116)
@@ -120,8 +120,8 @@
   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)
+  ! WRITE(*,'(96i1)') (iflag(i),i=2,klon-1)
   ! endif
   DO k = 1, klev
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5116)
@@ -2831,7 +2831,7 @@
     WRITE(lunout, *) ' buf_siz_pol= ', buf_siz_pol
     !rajout Olivier Torres
-    write(lunout, *) 'choix_bulk = ', choix_bulk
-    write(lunout, *) 'nit_bulk = ', nit_bulk
-    write(lunout, *) 'kz0 = ', kz0
+    WRITE(lunout, *) 'choix_bulk = ', choix_bulk
+    WRITE(lunout, *) 'nit_bulk = ', nit_bulk
+    WRITE(lunout, *) 'kz0 = ', kz0
 
     !$OMP END MASTER
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90	(revision 5116)
@@ -509,5 +509,5 @@
         ! 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
@@ -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)
@@ -632,10 +632,10 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
@@ -659,9 +659,9 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/convect3.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/convect3.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/convect3.F90	(revision 5116)
@@ -455,10 +455,10 @@
 
   ! test sb:
-  ! @      write(*,*) '++++++++++++++++++++++++++++++++++++++++'
-  ! @      write(*,*) 'plcl,dpbas,tvpbas,tvbas,tvp(icb),tvp(icb1)
+  ! @      WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++'
+  ! @      WRITE(*,*) 'plcl,dpbas,tvpbas,tvbas,tvp(icb),tvp(icb1)
   ! @     :             ,tv(icb),tv(icb1)'
-  ! @      write(*,*) plcl,dpbase,tvpbase,tvbase,tvp(icb)
+  ! @      WRITE(*,*) plcl,dpbase,tvpbase,tvbase,tvp(icb)
   ! @     L          ,tvp(icb+1),tv(icb),tv(icb+1)
-  ! @      write(*,*) '++++++++++++++++++++++++++++++++++++++++'
+  ! @      WRITE(*,*) '++++++++++++++++++++++++++++++++++++++++'
   ! fin test sb
   buoybase = tvpbase - tvbase
@@ -480,12 +480,12 @@
   ! sb3d      print *,'ICB ',icb
   ! test sb:
-  ! @      write(*,*) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'
-  ! @      write(*,*) 'icb,icbs,inb,buoybase:'
-  ! @      write(*,*) icb,icb+1,inb,buoybase
-  ! @      write(*,*) 'k,tvp,tv,tp,buoy,ep: '
+  ! @      WRITE(*,*) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'
+  ! @      WRITE(*,*) 'icb,icbs,inb,buoybase:'
+  ! @      WRITE(*,*) icb,icb+1,inb,buoybase
+  ! @      WRITE(*,*) 'k,tvp,tv,tp,buoy,ep: '
   ! @      do k=1,nl
-  ! @      write(*,*) k,tvp(k),tv(k),tp(k),buoy(k),ep(k)
+  ! @      WRITE(*,*) k,tvp(k),tv(k),tp(k),buoy(k),ep(k)
   ! @      enddo
-  ! @      write(*,*) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'
+  ! @      WRITE(*,*) '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@'
   ! fin test sb
 
@@ -629,8 +629,8 @@
     ! sb3d         print *,'buoy,dlnp,dcape,cape',buoy(i-1),dlnp,dcape,cape
     ! test sb:
-    ! @       write(*,*) '############################################'
-    ! @         write(*,*) 'cape,rrd,buoy,deltap,p,pbase,ph:'
+    ! @       WRITE(*,*) '############################################'
+    ! @         WRITE(*,*) 'cape,rrd,buoy,deltap,p,pbase,ph:'
     ! @     :     ,cape,rd,buoy(i-1),deltap,p(i-1),pbase,ph(i)
-    ! @       write(*,*) '############################################'
+    ! @       WRITE(*,*) '############################################'
 
     ! fin test sb
@@ -658,9 +658,9 @@
 
     ! --------- test sb:
-    ! write(*,*) '############################################'
-    ! write(*,*) 'k,amu,buoy(k-1),deltap,w,beta,fac,cape,w0(k)'
-    ! write(*,*) i,amu,buoy(i-1),deltap
+    ! WRITE(*,*) '############################################'
+    ! WRITE(*,*) 'k,amu,buoy(k-1),deltap,w,beta,fac,cape,w0(k)'
+    ! WRITE(*,*) i,amu,buoy(i-1),deltap
     ! :           ,w,beta,fac,cape,w0(i)
-    ! write(*,*) '############################################'
+    ! WRITE(*,*) '############################################'
     ! ---------
 
@@ -841,8 +841,8 @@
   ! **********************************************************
   ! --- test sb:
-  ! @       write(*,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
-  ! @       write(*,*) 'inb,m(inb),ment(inb,inb),sigij(inb,inb):'
-  ! @       write(*,*) inb,m(inb),ment(inb,inb),sigij(inb,inb)
-  ! @       write(*,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+  ! @       WRITE(*,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+  ! @       WRITE(*,*) 'inb,m(inb),ment(inb,inb),sigij(inb,inb):'
+  ! @       WRITE(*,*) inb,m(inb),ment(inb,inb),sigij(inb,inb)
+  ! @       WRITE(*,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
   ! ---
 
@@ -1175,11 +1175,11 @@
 
   ! test sb:
-  ! @      write(*,*) '--------------------------------------------'
-  ! @      write(*,*) 'inb,ft,hp,h,t,rr,qent,ment,water,waterp,wt,mp,b'
-  ! @      write(*,*) inb,ft(inb),hp(inb),h(inb)
+  ! @      WRITE(*,*) '--------------------------------------------'
+  ! @      WRITE(*,*) 'inb,ft,hp,h,t,rr,qent,ment,water,waterp,wt,mp,b'
+  ! @      WRITE(*,*) inb,ft(inb),hp(inb),h(inb)
   ! @     :   ,t(inb),rr(inb),qent(inb,inb)
   ! @     :   ,ment(inb,inb),water(inb)
   ! @     :   ,water(inb+1),wt(inb),mp(inb),b(inb)
-  ! @      write(*,*) '--------------------------------------------'
+  ! @      WRITE(*,*) '--------------------------------------------'
   ! fin test sb:
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cpl_mod.F90	(revision 5116)
@@ -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"
@@ -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
@@ -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
 
@@ -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), &
@@ -869,5 +869,5 @@
             knon, knindex)
 
-! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)!
+! cpl_fder2D(:,:,1) not used, ONLY cpl_fder(:,:,2)!
        CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), &
             knon, knindex)
@@ -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)
@@ -1234,5 +1234,5 @@
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
     USE time_phylmdz_mod, ONLY: start_time, itau_phy
-    USE config_ocean_skin_m, only: activate_ocean_skin
+    USE config_ocean_skin_m, ONLY: activate_ocean_skin
     USE lmdz_mpi
     USE lmdz_abort_physic, ONLY: abort_physic
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_limit_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_limit_unstruct_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_limit_unstruct_mod.F90	(revision 5116)
@@ -55,5 +55,5 @@
   USE create_limit_unstruct_mod, ONLY: create_limit_unstruct
   USE phyaqua_mod, ONLY: iniaqua
-  USE phys_cal_mod, only: year_len
+  USE phys_cal_mod, ONLY: year_len
   USE lmdz_phys_para, ONLY: is_omp_master
   USE lmdz_ioipsl_getin_p, ONLY: getin_p
@@ -84,5 +84,5 @@
                 CALL MPI_Finalize(ierr)
                 abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' 
-                write(lunout,*) abort_message
+                WRITE(lunout,*) abort_message
                 STOP 0
 !                CALL abort_physic(modname,abort_message,0)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_unstruct_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/create_etat0_unstruct_mod.F90	(revision 5116)
@@ -305,5 +305,5 @@
     CALL pbl_surface_init( fder, snsrf, qsurf, tsoil )
 
-    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
+    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) THEN
      delta_tsurf = 0.
      beta_aridity = 0.
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/create_limit_unstruct_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/create_limit_unstruct_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/create_limit_unstruct_mod.F90	(revision 5116)
@@ -179,6 +179,6 @@
   
   SUBROUTINE time_interpolation(ndays,field_in,calendar,field_out)
-  USE lmdz_libmath_pch, only: pchsp_95, pchfe_95
-  USE lmdz_arth, only: arth
+  USE lmdz_libmath_pch, ONLY: pchsp_95, pchfe_95
+  USE lmdz_arth, ONLY: arth
   USE dimphy, ONLY: klon
   USE ioipsl,             ONLY: ioget_year_len
@@ -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)
@@ -221,5 +221,5 @@
    END DO
    
-   IF (n_extrap /= 0) then
+   IF (n_extrap /= 0) THEN
      WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
    ENDIF 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90	(revision 5116)
@@ -207,5 +207,5 @@
   ! @         do 190 i=1,len
   ! @          if((hm(i,k).lt.work(i)).and.
-  ! @      &      (hm(i,k).lt.hm(i,k-1)))then
+  ! @      &      (hm(i,k).lt.hm(i,k-1)))THEN
   ! @            work(i)=hm(i,k)
   ! @            ihmin(i)=k
@@ -215,5 +215,5 @@
   ! @       do 210 i=1,len
   ! @         ihmin(i)=min(ihmin(i),nlm)
-  ! @         if(ihmin(i).le.minorig)then
+  ! @         IF(ihmin(i).le.minorig)THEN
   ! @           iflag(i)=6
   ! @         endif
@@ -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
@@ -468,5 +468,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112 * exp(17.67 * tc / denom)
     ! ori          else
@@ -489,5 +489,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112 * exp(17.67 * tc / denom)
     ! ori          else
@@ -565,5 +565,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112 * exp(17.67 * tc / denom)
     ! ori          else
@@ -586,5 +586,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112 * exp(17.67 * tc / denom)
     ! ori          else
@@ -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
@@ -691,5 +691,5 @@
   ! oct3         iflag(i)=4 ! pour version vectorisee
   ! oct3c convect3         iflag(i)=0
-  ! oct3cccc         return
+  ! oct3cccc         RETURN
   ! oct3       endif
   ! oct3
@@ -794,5 +794,5 @@
   ! 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)
@@ -848,5 +848,5 @@
   ! - vertical profile of buoyancy computed here (use of buoybase)
   ! - the determination of inb is different
-  ! - no inb1, only inb in output
+  ! - no inb1, ONLY inb in output
   ! ---------------------------------------------------------------------
 
@@ -908,5 +908,5 @@
   DO k = minorig + 1, nl
     DO i = 1, ncum
-      ! ori	    if(k.ge.(icb(i)+1))then
+      ! ori	    IF(k.ge.(icb(i)+1))THEN
       IF (k>=(icbs(i) + 1)) THEN ! convect3
         tg = t(i, k)
@@ -929,5 +929,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0) ! convect3
-        ! ori	       if(tc.ge.0.0)then
+        ! ori	       IF(tc.ge.0.0)THEN
         es = 6.112 * exp(17.67 * tc / denom)
         ! ori	       else
@@ -948,5 +948,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0) ! convect3
-        ! ori	       if(tc.ge.0.0)then
+        ! ori	       IF(tc.ge.0.0)THEN
         es = 6.112 * exp(17.67 * tc / denom)
         ! ori	       else
@@ -992,7 +992,7 @@
       ep(i, k) = amin1(ep(i, k), epmax)
       sigp(i, k) = spfac
-      ! ori          if(k.ge.(nk(i)+1))then
+      ! ori          IF(k.ge.(nk(i)+1))THEN
       ! ori            tca=tp(i,k)-t0
-      ! ori            if(tca.ge.0.0)then
+      ! ori            IF(tca.ge.0.0)THEN
       ! ori              elacrit=elcrit
       ! ori            else
@@ -1018,5 +1018,5 @@
   ! ori      do 340 k=minorig+1,nl
   ! ori        do 330 i=1,ncum
-  ! ori        if(k.ge.(icb(i)+1))then
+  ! ori        IF(k.ge.(icb(i)+1))THEN
   ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
   ! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
@@ -1095,10 +1095,10 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
@@ -1122,9 +1122,9 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
@@ -1152,11 +1152,11 @@
   ! ori      do 530 k=minorig+1,nl-1
   ! 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(cape(i).lt.0.0)lcape(i)=.FALSE.
+  ! 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)
   ! ori            cape(i)=cape(i)+by
-  ! ori            if(by.ge.0.0)inb1(i)=k+1
-  ! ori            if(cape(i).gt.0.0)then
+  ! ori            IF(by.ge.0.0)inb1(i)=k+1
+  ! ori            IF(cape(i).gt.0.0)THEN
   ! ori              inb(i)=k+1
   ! ori              capem(i)=cape(i)
@@ -1277,5 +1277,5 @@
   END DO
 
-  !      if(inb.lt.(nl-1))then
+  !      IF(inb.lt.(nl-1))THEN
   !         do 85 i=inb+1,nl-1
   !            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
@@ -1551,6 +1551,6 @@
     ! 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)
@@ -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,5 +1586,5 @@
   ! 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
@@ -1760,5 +1760,5 @@
     ! 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
+    ! :     .and. csum(il,i).lt.m(il,i) ) THEN
     ! traent(il,i,i,j)=tra(il,nk(il),j)
     ! endif
@@ -1987,5 +1987,5 @@
         ! jyg1
         ! cc        sigt=1.0
-        ! cc        if(i.ge.icb)sigt=sigp(i)
+        ! cc        IF(i.ge.icb)sigt=sigp(i)
         ! prise en compte de la variation progressive de sigt dans
         ! les couches icb et icb-1:
@@ -2365,5 +2365,5 @@
   ! do j=1,ntra
   ! do il=1,ncum
-  ! if (cvflag_grav) then
+  ! if (cvflag_grav) THEN
   ! ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
   ! :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
@@ -2402,7 +2402,6 @@
   ! do j=2,nl
   ! do il=1,ncum
-  ! if (j.le.inb(il)) then
-
-  ! if (cvflag_grav) then
+  ! if (j.le.inb(il)) THEN
+  ! if (cvflag_grav) THEN
   ! ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
   ! :                *(traent(il,j,1,k)-tra(il,1,k))
@@ -2521,8 +2520,8 @@
     ! do k=1,ntra
     ! do il=1,ncum
-    ! if (i.le.inb(il)) then
+    ! if (i.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
     ! :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
@@ -2572,8 +2571,8 @@
     ! do k=1,i-1
     ! do il=1,ncum
-    ! if (i.le.inb(il)) then
+    ! if (i.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     ! :        *(traent(il,k,i,j)-tra(il,i,j))
@@ -2615,8 +2614,8 @@
     ! 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)
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     ! :         *(traent(il,k,i,j)-tra(il,i,j))
@@ -2687,9 +2686,9 @@
     ! do j=1,ntra
     ! do il=1,ncum
-    ! if (i.le.inb(il)) then
+    ! if (i.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
 
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
     ! :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
@@ -2846,5 +2845,5 @@
       DO il = 1, ncum
         ! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il))
-        ! then
+        ! THEN
         IF (i<=inb(il) .AND. k<=inb(il)) THEN
           upwd(il, i) = upwd(il, i) + m(il, k) + up1(il, k, i)
@@ -3278,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))
@@ -3301,32 +3300,31 @@
     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
       enddo
     enddo !do k=minorig+1,n
-    !     write(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
+    !     WRITE(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
     do i = 1, ncum
       do k = 1, nl
-        if (abs(hp_bak(i, k) - hp(i, k))>0.01) then
-          write(*, *) 'i,k=', i, k
-          write(*, *) 'coef_epmax_cape=', coef_epmax_cape
-          write(*, *) 'epmax_diag(i)=', epmax_diag(i)
-          write(*, *) 'ep(i,k)=', ep(i, k)
-          write(*, *) 'hp(i,k)=', hp(i, k)
-          write(*, *) 'hp_bak(i,k)=', hp_bak(i, k)
-          write(*, *) 'h(i,k)=', h(i, k)
-          write(*, *) 'nk(i)=', nk(i)
-          write(*, *) 'h(i,nk(i))=', h(i, nk(i))
-          write(*, *) 'lv(i,k)=', lv(i, k)
-          write(*, *) 't(i,k)=', t(i, k)
-          write(*, *) 'clw(i,k)=', clw(i, k)
-          write(*, *) 'cpd,cpv=', cpd, cpv
+        if (abs(hp_bak(i, k) - hp(i, k))>0.01) THEN
+          WRITE(*, *) 'i,k=', i, k
+          WRITE(*, *) 'coef_epmax_cape=', coef_epmax_cape
+          WRITE(*, *) 'epmax_diag(i)=', epmax_diag(i)
+          WRITE(*, *) 'ep(i,k)=', ep(i, k)
+          WRITE(*, *) 'hp(i,k)=', hp(i, k)
+          WRITE(*, *) 'hp_bak(i,k)=', hp_bak(i, k)
+          WRITE(*, *) 'h(i,k)=', h(i, k)
+          WRITE(*, *) 'nk(i)=', nk(i)
+          WRITE(*, *) 'h(i,nk(i))=', h(i, nk(i))
+          WRITE(*, *) 'lv(i,k)=', lv(i, k)
+          WRITE(*, *) 't(i,k)=', t(i, k)
+          WRITE(*, *) 'clw(i,k)=', clw(i, k)
+          WRITE(*, *) 'cpd,cpv=', cpd, cpv
           CALL abort_physic(modname, abort_message, 1)
         endif
       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/cv3_inicp.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90	(revision 5116)
@@ -62,5 +62,5 @@
   ! read(57,*) iflag_mix, scut
   ! read(57,*)
-  ! if(iflag_mix .gt. 0) then
+  ! IF(iflag_mix .gt. 0) THEN
   ! read(57,*) qqa1, qqa2
   ! read(57,*)
@@ -94,5 +94,5 @@
       aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff)
       mu = mu + pdf*ff*df
-      ! c              write(*,*) pdf,  Qmix(ff), aire, ff
+      ! c              WRITE(*,*) pdf,  Qmix(ff), aire, ff
       ff = ff + df
     END DO
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inip.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inip.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inip.F90	(revision 5116)
@@ -89,5 +89,5 @@
   ! c$$$        read(57,*) iflag_mix, scut
   ! c$$$        read(57,*)
-  ! c$$$        if(iflag_mix .gt. 0) then
+  ! c$$$        IF(iflag_mix .gt. 0) THEN
   ! c$$$	      read(57,*) qqa1, qqa2
   ! c$$$              read(57,*)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90	(revision 5116)
@@ -578,5 +578,5 @@
 
 ! PRINT*,'icb dans cv3_feed '
-! write(*,'(64i2)') icb(2:len-1)
+! WRITE(*,'(64i2)') icb(2:len-1)
 ! CALL dump2d(64,43,'plcl dans cv3_feed ',plcl(2:len-1))
 
@@ -726,5 +726,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -747,5 +747,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0)                               ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -824,5 +824,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0)                                   ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -845,5 +845,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0)                                   ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -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
@@ -950,5 +950,5 @@
 ! oct3         iflag(i)=4 ! pour version vectorisee
 ! oct3c convect3         iflag(i)=0
-! oct3cccc         return
+! oct3cccc         RETURN
 ! oct3       endif
 ! oct3
@@ -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)
@@ -1153,5 +1153,5 @@
 !   - vertical profile of buoyancy computed here (use of buoybase)
 !   - the determination of inb is different
-!   - no inb1, only inb in output
+!   - no inb1, ONLY inb in output
 ! ---------------------------------------------------------------------
 
@@ -1326,5 +1326,5 @@
       DO j = 1,4
         DO i = 1, ncum
-! ori	    if(k.ge.(icb(i)+1))then
+! ori	    IF(k.ge.(icb(i)+1))THEN
           IF (k>=(icbs(i)+1)) THEN                                ! convect3
             tg = tp(i, k)
@@ -1434,5 +1434,5 @@
       DO j = 1,4
         DO i = 1, ncum
-! ori	    if(k.ge.(icb(i)+1))then
+! ori	    IF(k.ge.(icb(i)+1))THEN
           IF (k>=(icbs(i)+1)) THEN                                ! convect3
             tg = tp(i, k)
@@ -1548,5 +1548,5 @@
   DO k = minorig + 1, nl
     DO i = 1, ncum
-! ori	    if(k.ge.(icb(i)+1))then
+! ori	    IF(k.ge.(icb(i)+1))THEN
       IF (k>=(icbs(i)+1)) THEN                                ! convect3
         tg = t(i, k)
@@ -1569,5 +1569,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0)                               ! convect3
-! ori	       if(tc.ge.0.0)then
+! ori	       IF(tc.ge.0.0)THEN
         es = 6.112*exp(17.67*tc/denom)
 ! ori	       else
@@ -1588,5 +1588,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0)                               ! convect3
-! ori	       if(tc.ge.0.0)then
+! ori	       IF(tc.ge.0.0)THEN
         es = 6.112*exp(17.67*tc/denom)
 ! ori	       else
@@ -1765,5 +1765,5 @@
 ! ori      do 340 k=minorig+1,nl
 ! ori        do 330 i=1,ncum
-! ori        if(k.ge.(icb(i)+1))then
+! ori        IF(k.ge.(icb(i)+1))THEN
 ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
 ! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
@@ -1889,10 +1889,10 @@
 !    do 530 k=minorig+1,nl-1
 !     do 520 i=1,ncum
-!      if(k.ge.(icb(i)+1))then
+!      IF(k.ge.(icb(i)+1))THEN
 !       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
 !       byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
 !       cape(i)=cape(i)+by
-!       if(by.ge.0.0)inb1(i)=k+1
-!       if(cape(i).gt.0.0)then
+!       IF(by.ge.0.0)inb1(i)=k+1
+!       IF(cape(i).gt.0.0)THEN
 !        inb(i)=k+1
 !        capem(i)=cape(i)
@@ -1916,9 +1916,9 @@
 !    do 530 k=minorig+1,nl-1
 !     do 520 i=1,ncum
-!      if(k.ge.(icb(i)+1))then
+!      IF(k.ge.(icb(i)+1))THEN
 !       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
 !       cape(i)=cape(i)+by
-!       if(by.ge.0.0)inb1(i)=k+1
-!       if(cape(i).gt.0.0)then
+!       IF(by.ge.0.0)inb1(i)=k+1
+!       IF(cape(i).gt.0.0)THEN
 !        inb(i)=k+1
 !        capem(i)=cape(i)
@@ -1946,11 +1946,11 @@
 ! ori      do 530 k=minorig+1,nl-1
 ! 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(cape(i).lt.0.0)lcape(i)=.FALSE.
+! 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)
 ! ori            cape(i)=cape(i)+by
-! ori            if(by.ge.0.0)inb1(i)=k+1
-! ori            if(cape(i).gt.0.0)then
+! ori            IF(by.ge.0.0)inb1(i)=k+1
+! ori            IF(cape(i).gt.0.0)THEN
 ! ori              inb(i)=k+1
 ! ori              capem(i)=cape(i)
@@ -2125,5 +2125,5 @@
   END DO
 
-!!      if(inb.lt.(nl-1))then
+!!      IF(inb.lt.(nl-1))THEN
 !!         do 85 i=inb+1,nl-1
 !!            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
@@ -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
@@ -2663,5 +2663,5 @@
 !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!     :     .and. csum(il,i).lt.m(il,i) ) THEN
 !AC!         traent(il,i,i,j)=tra(il,nk(il),j)
 !AC!        endif
@@ -2849,5 +2849,5 @@
   DO il = 1, ncum
 !!          lwork(il)=.TRUE.
-!!          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
+!!          IF(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
 !jyg<
 !!    lwork(il) = ep(il, inb(il)) >= 0.0001
@@ -3043,5 +3043,5 @@
 !JYG1
 ! cc        sigt=1.0
-! cc        if(i.ge.icb)sigt=sigp(i)
+! cc        IF(i.ge.icb)sigt=sigp(i)
 ! prise en compte de la variation progressive de sigt dans
 ! les couches icb et icb-1:
@@ -3076,5 +3076,5 @@
 !   c6=prec(il,i+1)+bfac*wdtrain(il) &
 !       -50.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il,i+1)
-!   if(c6.gt.0.0)then
+!   IF(c6.gt.0.0)THEN
 !   revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
 
@@ -3160,5 +3160,5 @@
 !           ice(il,i)=ice(il,i)-fondue(il,i)
             
-!           if((water(il,i)+ice(il,i)).lt.1.e-30)then
+!           if((water(il,i)+ice(il,i)).lt.1.e-30)THEN
 !             faci(il,i)=0.
 !           else
@@ -3327,5 +3327,5 @@
 
 
-! c      if(p(il,i).gt.p(il,icb(il)))then
+! c      IF(p(il,i).gt.p(il,icb(il)))THEN
 ! c       mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
 ! c      endif
@@ -3406,12 +3406,12 @@
 !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
+!AC!         IF(mplus(il))THEN
 !AC!          trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
 !AC!     :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
 !AC!          trap(il,i,j)=trap(il,i,j)/mp(il,i)
 !AC!         else ! if (mplus(il))
-!AC!          if(mp(il,i+1).gt.1.0e-16)then
+!AC!          IF(mp(il,i+1).gt.1.0e-16)THEN
 !AC!           trap(il,i,j)=trap(il,i+1,j)
 !AC!          endif
@@ -3794,6 +3794,6 @@
 !AC!     do j=1,ntra
 !AC!      do il=1,ncum
-!AC!       if (iflag(il) .le. 1) then
-!AC!       if (cvflag_grav) then
+!AC!       if (iflag(il) .le. 1) THEN
+!AC!       if (cvflag_grav) THEN
 !AC!        ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
 !AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
@@ -3822,7 +3822,7 @@
 !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
+!AC!          if (cvflag_grav) THEN
 !AC!           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
 !AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
@@ -4170,8 +4170,8 @@
 !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)
-!AC!         if (cvflag_grav) then
+!AC!         if (cvflag_grav) THEN
 !AC!           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
 !AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
@@ -4228,8 +4228,8 @@
 !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)
-!AC!          if (cvflag_grav) then
+!AC!          if (cvflag_grav) THEN
 !AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
 !AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
@@ -4277,8 +4277,8 @@
 !AC!        do il=1,ncum
 !AC!         if (i.le.inb(il) .and. k.le.inb(il)
-!AC!     $                .and. iflag(il) .le. 1) then
+!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)
-!AC!          if (cvflag_grav) then
+!AC!          if (cvflag_grav) THEN
 !AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
 !AC!     :         *(traent(il,k,i,j)-tra(il,i,j))
@@ -4345,9 +4345,9 @@
 !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)
 !AC!
-!AC!         if (cvflag_grav) then
+!AC!         if (cvflag_grav) THEN
 !AC!          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
 !AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
@@ -4419,5 +4419,5 @@
 !AC!       do il=1,ncum
 !AC!        IF (iflag(il) .le. 1) THEN
-!AC!	IF (cvflag_grav) then
+!AC!	IF (cvflag_grav) THEN
 !AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
 !AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
@@ -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
@@ -5168,11 +5168,10 @@
       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
         ! necessaires au calcul de la cape dans la nouvelle physique
         
-!        write(*,*) 'cv3_routines check 4303'
+!        WRITE(*,*) 'cv3_routines check 4303'
         do i=1,ncum
         do k=1,nd
@@ -5184,16 +5183,16 @@
         enddo !do i=1,ncum
 
-!        write(*,*) 'cv3_routines check 4311'
-!        write(*,*) 'nl=',nl
+!        WRITE(*,*) 'cv3_routines check 4311'
+!        WRITE(*,*) 'nl=',nl
         CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
           pbase, p, ph, tv, buoy, &
           sig_loc, w0_loc, cape, m_loc,iflag_loc)
 
-!        write(*,*) 'cv3_routines check 4316'
-!        write(*,*) 'ep(1,:)=',ep(1,:)
+!        WRITE(*,*) 'cv3_routines check 4316'
+!        WRITE(*,*) 'ep(1,:)=',ep(1,:)
         do i=1,ncum
            epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
            epmax_diag(i)=amax1(epmax_diag(i),0.0)
-!           write(*,*) 'i,icb,inb,cape,epmax_diag=', &
+!           WRITE(*,*) 'i,icb,inb,cape,epmax_diag=', &
 !                i,icb(i),inb(i),cape(i),epmax_diag(i)
            do k=1,nl
@@ -5203,7 +5202,7 @@
            enddo
         enddo
- !       write(*,*) 'ep(1,:)=',ep(1,:)
-
-      !write(*,*) 'cv3_routines check 4326'
+ !       WRITE(*,*) 'ep(1,:)=',ep(1,:)
+
+      !WRITE(*,*) 'cv3_routines check 4326'
 ! On recalcule hp:
 !      do k=1,nl
@@ -5222,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)
@@ -5239,30 +5238,30 @@
 
   ENDIF !IF (cvflag_ice) THEN     
-      !write(*,*) 'cv3_routines check 4345'
+      !WRITE(*,*) 'cv3_routines check 4345'
 !      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. &
-!            (ep(i,k)-ep_bak(i,k).lt.1e-4))) then
-!           write(*,*) 'i,k=',i,k
-!           write(*,*) 'coef_epmax_cape=',coef_epmax_cape
-!           write(*,*) 'epmax_diag(i)=',epmax_diag(i)
-!           write(*,*) 'ep(i,k)=',ep(i,k)
-!           write(*,*) 'ep_bak(i,k)=',ep_bak(i,k)
-!           write(*,*) 'hp(i,k)=',hp(i,k)
-!           write(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
-!           write(*,*) 'h(i,k)=',h(i,k)
-!           write(*,*) 'nk(i)=',nk(i)
-!           write(*,*) 'h(i,nk(i))=',h(i,nk(i))
-!           write(*,*) 'lv(i,k)=',lv(i,k)
-!           write(*,*) 't(i,k)=',t(i,k)
-!           write(*,*) 'clw(i,k)=',clw(i,k)
-!           write(*,*) 'cpd,cpv=',cpd,cpv
+!            (ep(i,k)-ep_bak(i,k).lt.1e-4))) THEN
+!           WRITE(*,*) 'i,k=',i,k
+!           WRITE(*,*) 'coef_epmax_cape=',coef_epmax_cape
+!           WRITE(*,*) 'epmax_diag(i)=',epmax_diag(i)
+!           WRITE(*,*) 'ep(i,k)=',ep(i,k)
+!           WRITE(*,*) 'ep_bak(i,k)=',ep_bak(i,k)
+!           WRITE(*,*) 'hp(i,k)=',hp(i,k)
+!           WRITE(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
+!           WRITE(*,*) 'h(i,k)=',h(i,k)
+!           WRITE(*,*) 'nk(i)=',nk(i)
+!           WRITE(*,*) 'h(i,nk(i))=',h(i,nk(i))
+!           WRITE(*,*) 'lv(i,k)=',lv(i,k)
+!           WRITE(*,*) 't(i,k)=',t(i,k)
+!           WRITE(*,*) 'clw(i,k)=',clw(i,k)
+!           WRITE(*,*) 'cpd,cpv=',cpd,cpv
 !           stop
 !        endif
 !       enddo !do k=1,nl
 !      enddo !do i=1,ncum  
-      endif !if (coef_epmax_cape.gt.1e-12) then
-      !write(*,*) 'cv3_routines check 4367'
+      endif !if (coef_epmax_cape.gt.1e-12) THEN
+      !WRITE(*,*) 'cv3_routines check 4367'
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_compress.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_compress.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3a_compress.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90	(revision 5116)
@@ -147,5 +147,5 @@
   END DO
 
-  ! if(prt.level.GE.20) PRINT*,'cv3p1_param apres 100'
+  ! IF(prt.level.GE.20) PRINT*,'cv3p1_param apres 100'
   ! compute icbmax:
 
@@ -154,5 +154,5 @@
     icbmax = max(icbmax, icb(il))
   END DO
-  ! if(prt.level.GE.20) PRINT*,'cv3p1_param apres 200'
+  ! IF(prt.level.GE.20) PRINT*,'cv3p1_param apres 200'
 
   ! update sig and w0 below cloud base:
@@ -493,5 +493,5 @@
         il)+1))/(ph(il,icb(il)+1)-ph(il,icb(il)+2))
       ! IM beg
-    END IF !(icb(il.le.inb(il))) then
+    END IF !(icb(il.le.inb(il))) THEN
     ! IM end
   END DO
@@ -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
@@ -585,5 +585,5 @@
     IF (cbmflim(il)>1.E-6) THEN
       ! ATTENTION TEST CR
-      ! if (cbmfmax(il).lt.1.e-12) then
+      ! if (cbmfmax(il).lt.1.e-12) THEN
       cbmf(il) = min(cbmf1(il), cbmfmax(il))
       ! else
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90	(revision 5116)
@@ -159,5 +159,5 @@
   END DO
 
-  ! if(prt.level.GE.20) PRINT*,'cv3p2_closure apres 100'
+  ! IF(prt.level.GE.20) PRINT*,'cv3p2_closure apres 100'
   ! compute icbmax:
 
@@ -166,5 +166,5 @@
     icbmax = max(icbmax, icb(il))
   END DO
-  ! if(prt.level.GE.20) PRINT*,'cv3p2_closure apres 200'
+  ! IF(prt.level.GE.20) PRINT*,'cv3p2_closure apres 200'
 
   ! update sig and w0 below cloud base:
@@ -561,5 +561,5 @@
                                                (ph(il,icb(il)+1)-ph(il,icb(il)+2))
       ! IM beg
-    END IF !(icb(il.le.inb(il))) then
+    END IF !(icb(il.le.inb(il))) THEN
     ! IM end
   END DO
@@ -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
@@ -664,5 +664,5 @@
     IF (cbmflim(il)>1.E-6) THEN
       ! ATTENTION TEST CR
-      ! if (cbmfmax(il).lt.1.e-12) then
+      ! if (cbmfmax(il).lt.1.e-12) THEN
       cbmfalpb(il) = min(cbmfalp(il), cbmfmax(il))
       ! else
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90	(revision 5116)
@@ -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.
@@ -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/cv_routines.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cv_routines.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cv_routines.F90	(revision 5116)
@@ -592,5 +592,5 @@
         ! 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
@@ -663,10 +663,10 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
@@ -690,9 +690,9 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90	(revision 5116)
@@ -750,5 +750,5 @@
 ! PRINT*, 'IFLAG1 avant cv3_feed'
 ! PRINT*,'len,nd',len,nd
-! write(*,'(64i1)') iflag1(2:len-1)
+! WRITE(*,'(64i1)') iflag1(2:len-1)
 
         if (prt_level >= 9) &
@@ -763,5 +763,5 @@
 ! PRINT*, 'IFLAG1 apres cv3_feed'
 ! PRINT*,'len,nd',len,nd
-! write(*,'(64i1)') iflag1(2:len-1)
+! WRITE(*,'(64i1)') iflag1(2:len-1)
 
   IF (iflag_con==4) THEN
@@ -813,5 +813,5 @@
 ! PRINT*, 'IFLAG1 apres cv3_triger'
 ! PRINT*,'len,nd',len,nd
-! write(*,'(64i1)') iflag1(2:len-1)
+! WRITE(*,'(64i1)') iflag1(2:len-1)
 
 ! CALL dump2d(iim,jjm-1,sig1(2)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90	(revision 5116)
@@ -133,5 +133,5 @@
 
 !  scavON=.TRUE.
-!  if(scavON) then
+!  IF(scavON) THEN
 !   ccntrAA_coef     = 1.
 !   ccntrENV_coef    = 1.
@@ -207,5 +207,5 @@
   DO j=1,klev
    DO i=1,klon
-    if(ev(i,j)<1.e-16) then
+    IF(ev(i,j)<1.e-16) THEN
      evap(i,j)=0.
     else
@@ -217,6 +217,6 @@
   DO j=1,klev
    DO i=1,klon
-   if(j<klev) then
-    if(epIN(i,j)<1.e-32) then
+   IF(j<klev) THEN
+    IF(epIN(i,j)<1.e-32) THEN
      ep(i,j)=0.
     else
@@ -226,25 +226,25 @@
     ep(i,j)=epmax
    endif
-    if(mpIN(i,j)<1.e-32) then
+    IF(mpIN(i,j)<1.e-32) THEN
      mp(i,j)=0.
     else
      mp(i,j)=mpIN(i,j)
     endif
-    if(pmflxsIN(i,j)<1.e-32) then
+    IF(pmflxsIN(i,j)<1.e-32) THEN
      pmflxs(i,j)=0.
     else
      pmflxs(i,j)=pmflxsIN(i,j)
     endif
-    if(pmflxrIN(i,j)<1.e-32) then
+    IF(pmflxrIN(i,j)<1.e-32) THEN
      pmflxr(i,j)=0.
     else
      pmflxr(i,j)=pmflxrIN(i,j)
     endif
-    if(wdtrainA(i,j)<1.e-32) then
+    IF(wdtrainA(i,j)<1.e-32) THEN
      Pa(i,j)=0.
     else
      Pa(i,j)=wdtrainA(i,j)
     endif
-    if(wdtrainM(i,j)<1.e-32) then
+    IF(wdtrainM(i,j)<1.e-32) THEN
      Pm(i,j)=0.
     else
@@ -285,5 +285,5 @@
      DO j=k-1,1,-1
         DO i=1,klon
-           if(mp(i,j+1)>1.e-10) then
+           IF(mp(i,j+1)>1.e-10) THEN
               zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1)) !det ~ mk(j)=mk(j+1)*mp(i,j)/mp(i,j+1)
            ENDif
@@ -302,5 +302,5 @@
      DO j=1,klev-1
         DO i=1,klon
-        if(mp(i,j+1)>1.e-10) then
+        IF(mp(i,j+1)>1.e-10) THEN
           qTrdi(i,j+1,it)=qTrdi(i,j+1,it)+(zmd(i,j+1,k)/mp(i,j+1))*tr(i,k,it)
         else
@@ -397,6 +397,6 @@
   DO j=1,klev
      DO i=1,klon
-        if(j>=icb(i).and.j<=inb(i)) then
-          if(clw(i,j)>1.e-16) 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)
           else
@@ -413,7 +413,7 @@
       DO k=1,j-1
         DO i=1,klon
-        if(k>=icb(i).and.k<=inb(i).and.&
-           j<=inb(i)) then
-            if(elij(i,k,j)>1.e-16) then
+        IF(k>=icb(i).and.k<=inb(i).and.&
+           j<=inb(i)) THEN
+            IF(elij(i,k,j)>1.e-16) THEN
              qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_coef*tr(i,1,it)&
                          *(1.-sij(i,k,j))  +ccntrENV_coef&
@@ -431,5 +431,5 @@
      DO j=1,klev
         DO i=1,klon
-          if(Mint(i,j)>1.e-16) then
+          IF(Mint(i,j)>1.e-16) THEN
            qMel(i,j,it)=qpmMint(i,j,it)/Mint(i,j)
           else
@@ -442,5 +442,5 @@
    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))&
@@ -448,5 +448,5 @@
              
      elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then! entrainement
-       if(j==1) then
+       IF(j==1) THEN
         kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
                  (-mp(i,2)-imp(i,j)/RG*dxpres(i,j))&
@@ -467,7 +467,7 @@
     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
+     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
@@ -477,5 +477,5 @@
      endif 
 
-      if(NO_precip(i,j)) then
+      IF(NO_precip(i,j)) THEN
        qPr(i,j,it)=0.
       else
@@ -489,13 +489,13 @@
 ! calcul de qd et qp
 !!jyg  (20130119) correction pour le sommet du nuage
-!!     if(j.ge.inb(i)) then       !au-dessus du nuage, sommet inclu
-     if(j>inb(i)) then       !au-dessus du nuage
+!!     IF(j.ge.inb(i)) then       !au-dessus du nuage, sommet inclu
+     IF(j>inb(i)) then       !au-dessus du nuage
        qDi(i,j,it)=tr(i,j,it)   ! pas de descente => environnement = descente insaturee
        qPr(i,j,it)=0.
 
 !  vvv premiere couche du modele ou mp(1)=0  ! det tout le temps  vvv
-     elseif(j==1) then
-      if(mp(i,2)>1.e-10) then !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
-       if(NO_precip(i,j)) then !pas de precip en (i)
+     elseif(j==1) THEN
+      IF(mp(i,2)>1.e-10) then !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
+       IF(NO_precip(i,j)) then !pas de precip en (i)
         qDi(i,j,it)=qDi(i,j+1,it)
         qPr(i,j,it)=0.
@@ -516,5 +516,5 @@
       else !mp(2) nul -> plus de descente insaturee -> pluie agit sur environnement
         qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
+        IF(NO_precip(i,j)) THEN
          qPr(i,j,it)=0.
         else
@@ -530,6 +530,6 @@
      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(NO_precip(i,j)) 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)
           qPr(i,j,it)=0.
@@ -548,6 +548,6 @@
          endif !precip
 !------------------------------------------------------------- entrainement 
-      elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then
-         if(NO_precip(i,j)) 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))
           qPr(i,j,it)=0.
@@ -569,5 +569,5 @@
       else  !mp nul
         qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
+        IF(NO_precip(i,j)) THEN
          qPr(i,j,it)=0.
         else
@@ -586,6 +586,6 @@
 !  DO j=klev,1,-1
 !   DO i=1,klon
-!     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,&
+!     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),&
 !          'zmfdam+zmfpsi',zmfdam(i,j,it)+zmfphi2(i,j,it),'qpmMint',qpmMint(i,j,it),&
@@ -614,47 +614,47 @@
                -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
 
-        if(NO_precip(i,k)) then
+        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
 !------------------------------------------------------------- premiere couche 
    elseif(k==1) then  !                                      mp(1)=0.
-      if(mp(i,2)>1.e-10) then  !detrainement
+      IF(mp(i,2)>1.e-10) then  !detrainement
          uscavtrac= (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it)) !&
 !                   + 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),&
 !                   'mp',mp(i,k)
       else   ! mp(2) = 0 = mp(1) pas de descente insaturee, rien ne se passe s'il ne pleut pas, sinon pluie->env
-        if(NO_precip(i,1)) then
+        IF(NO_precip(i,1)) THEN
           uscavtrac=0.
         else
           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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_noscav.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_scav.F90	(revision 5116)
@@ -489,6 +489,6 @@
            ! calcul de qd et qp
            !!jyg  (20130119) correction pour le sommet du nuage
-           !!     if(j.GE.inb(i)) THEN       !au-dessus du nuage, sommet inclu
-           if(j>inb(i)) THEN       !au-dessus du nuage
+           !!     IF(j.GE.inb(i)) THEN       !au-dessus du nuage, sommet inclu
+           IF(j>inb(i)) THEN       !au-dessus du nuage
               qDi(i,j,it)=tr(i,j,it)   ! pas de descente => environnement = descente insaturee
               qPr(i,j,it)=0.
@@ -496,6 +496,6 @@
               !  vvv premiere couche du modele ou mp(1)=0  ! det tout le temps  vvv
            ELSEIF(j==1) THEN
-              if(mp(i,2)>1.e-10) THEN !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
-                 if(NO_precip(i,j)) THEN !pas de precip en (i)
+              IF(mp(i,2)>1.e-10) THEN !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
+                 IF(NO_precip(i,j)) THEN !pas de precip en (i)
                     qDi(i,j,it)=qDi(i,j+1,it)
                     qPr(i,j,it)=0.
@@ -516,5 +516,5 @@
               ELSE !mp(2) nul -> plus de descente insaturee -> pluie agit sur environnement
                  qDi(i,j,it)=tr(i,j,it) ! orig 0.
-                 if(NO_precip(i,j)) THEN
+                 IF(NO_precip(i,j)) THEN
                     qPr(i,j,it)=0.
                  ELSE
@@ -530,6 +530,6 @@
            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(NO_precip(i,j)) 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)
                     qPr(i,j,it)=0.
@@ -549,5 +549,5 @@
                  !------------------------------------------------------------- entrainement 
               ELSEIF(mp(i,j)>mp(i,j+1).AND.mp(i,j)>1.e-10) THEN
-                 if(NO_precip(i,j)) 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))
                     qPr(i,j,it)=0.
@@ -569,5 +569,5 @@
               ELSE  !mp nul
                  qDi(i,j,it)=tr(i,j,it) ! orig 0.
-                 if(NO_precip(i,j)) THEN
+                 IF(NO_precip(i,j)) THEN
                     qPr(i,j,it)=0.
                  ELSE
@@ -586,6 +586,6 @@
   !  DO j=klev,1,-1
   !   DO i=1,klon
-  !     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,&
+  !     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),&
   !          'zmfdam+zmfpsi',zmfdam(i,j,it)+zmfphi2(i,j,it),'qpmMint',qpmMint(i,j,it),&
@@ -617,11 +617,11 @@
              -zmfdam(i,k,it)*ccntrAA_3d(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),&
@@ -631,20 +631,20 @@
               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
 
-              if(NO_precip(i,k)) THEN
+              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
 
@@ -653,19 +653,19 @@
            !------------------------------------------------------------- premiere couche 
         ELSEIF(k==1) THEN  !                                      mp(1)=0.
-           if(mp(i,2)>1.e-10) THEN  !detrainement
+           IF(mp(i,2)>1.e-10) THEN  !detrainement
               uscavtrac= (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it)) !&
               !                   + 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),&
               !                   'mp',mp(i,k)
            ELSE   ! mp(2) = 0 = mp(1) pas de descente insaturee, rien ne se passe s'il ne pleut pas, sinon pluie->env
-              if(NO_precip(i,1)) THEN
+              IF(NO_precip(i,1)) THEN
                  uscavtrac=0.
               ELSE
                  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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_spl.F90	(revision 5116)
@@ -175,5 +175,5 @@
 
 !  scavON=.TRUE.
-!  if(scavON) then
+!  IF(scavON) THEN
 !   ccntrAA_coef     = 1.
 !   ccntrENV_coef    = 1.
@@ -251,5 +251,5 @@
   DO j=1,klev
    DO i=1,klon
-    if(ev(i,j)<1.e-16) then
+    IF(ev(i,j)<1.e-16) THEN
      evap(i,j)=0.
     else
@@ -261,6 +261,6 @@
   DO j=1,klev
    DO i=1,klon
-   if(j<klev) then
-    if(epIN(i,j)<1.e-32) then
+   IF(j<klev) THEN
+    IF(epIN(i,j)<1.e-32) THEN
      ep(i,j)=0.
     else
@@ -270,25 +270,25 @@
     ep(i,j)=epmax
    endif
-    if(mpIN(i,j)<1.e-32) then
+    IF(mpIN(i,j)<1.e-32) THEN
      mp(i,j)=0.
     else
      mp(i,j)=mpIN(i,j)
     endif
-    if(pmflxsIN(i,j)<1.e-32) then
+    IF(pmflxsIN(i,j)<1.e-32) THEN
      pmflxs(i,j)=0.
     else
      pmflxs(i,j)=pmflxsIN(i,j)
     endif
-    if(pmflxrIN(i,j)<1.e-32) then
+    IF(pmflxrIN(i,j)<1.e-32) THEN
      pmflxr(i,j)=0.
     else
      pmflxr(i,j)=pmflxrIN(i,j)
     endif
-    if(wdtrainA(i,j)<1.e-32) then
+    IF(wdtrainA(i,j)<1.e-32) THEN
      Pa(i,j)=0.
     else
      Pa(i,j)=wdtrainA(i,j)
     endif
-    if(wdtrainM(i,j)<1.e-32) then
+    IF(wdtrainM(i,j)<1.e-32) THEN
      Pm(i,j)=0.
     else
@@ -415,5 +415,5 @@
      DO j=k-1,1,-1
         DO i=1,klon
-           if(mp(i,j+1)>1.e-10) then
+           IF(mp(i,j+1)>1.e-10) THEN
               zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1)) !det ~ mk(j)=mk(j+1)*mp(i,j)/mp(i,j+1)
            ENDif
@@ -432,5 +432,5 @@
      DO j=1,klev-1
         DO i=1,klon
-        if(mp(i,j+1)>1.e-10) then
+        IF(mp(i,j+1)>1.e-10) THEN
           qTrdi(i,j+1,it)=qTrdi(i,j+1,it)+(zmd(i,j+1,k)/mp(i,j+1))*tr(i,k,it)
         else
@@ -526,6 +526,6 @@
   DO j=1,klev
      DO i=1,klon
-        if(j>=icb(i).and.j<=inb(i)) then
-          if(clw(i,j)>1.e-16) 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)
            qPa(i,j,it)=ccntrAA_coef3d(i,j)*tr(i,1,it)/clw(i,j)
@@ -543,7 +543,7 @@
       DO k=1,j-1
         DO i=1,klon
-        if(k>=icb(i).and.k<=inb(i).and.&
-           j<=inb(i)) then
-            if(elij(i,k,j)>1.e-16) then
+        IF(k>=icb(i).and.k<=inb(i).and.&
+           j<=inb(i)) THEN
+            IF(elij(i,k,j)>1.e-16) THEN
 !JE             qMeltmp(i,j,it)=((1-ep(i,k))*ccntrAA_coef*tr(i,1,it)&
 !JE                         *(1.-sij(i,k,j))  +ccntrENV_coef&
@@ -564,5 +564,5 @@
      DO j=1,klev
         DO i=1,klon
-          if(Mint(i,j)>1.e-16) then
+          IF(Mint(i,j)>1.e-16) THEN
            qMel(i,j,it)=qpmMint(i,j,it)/Mint(i,j)
           else
@@ -575,5 +575,5 @@
    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))&
@@ -581,5 +581,5 @@
              
      elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then! entrainement
-       if(j==1) then
+       IF(j==1) THEN
         kappa(i,j)=((pmflxr(i,j+1)+pmflxs(i,j+1)+Pa(i,j)+Pm(i,j))*&
                  (-mp(i,2)-imp(i,j)/RG*dxpres(i,j))&
@@ -600,7 +600,7 @@
     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
+     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
@@ -610,5 +610,5 @@
      endif 
 
-      if(NO_precip(i,j)) then
+      IF(NO_precip(i,j)) THEN
        qPr(i,j,it)=0.
       else
@@ -622,13 +622,13 @@
 ! calcul de qd et qp
 !!jyg  (20130119) correction pour le sommet du nuage
-!!     if(j.ge.inb(i)) then       !au-dessus du nuage, sommet inclu
-     if(j>inb(i)) then       !au-dessus du nuage
+!!     IF(j.ge.inb(i)) then       !au-dessus du nuage, sommet inclu
+     IF(j>inb(i)) then       !au-dessus du nuage
        qDi(i,j,it)=tr(i,j,it)   ! pas de descente => environnement = descente insaturee
        qPr(i,j,it)=0.
 
 !  vvv premiere couche du modele ou mp(1)=0  ! det tout le temps  vvv
-     elseif(j==1) then
-      if(mp(i,2)>1.e-10) then !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
-       if(NO_precip(i,j)) then !pas de precip en (i)
+     elseif(j==1) THEN
+      IF(mp(i,2)>1.e-10) then !mp(2) non nul -> detrainement (car mp(1) = 0) !ent pas possible
+       IF(NO_precip(i,j)) then !pas de precip en (i)
         qDi(i,j,it)=qDi(i,j+1,it)
         qPr(i,j,it)=0.
@@ -649,5 +649,5 @@
       else !mp(2) nul -> plus de descente insaturee -> pluie agit sur environnement
         qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
+        IF(NO_precip(i,j)) THEN
          qPr(i,j,it)=0.
         else
@@ -663,6 +663,6 @@
      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(NO_precip(i,j)) 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)
           qPr(i,j,it)=0.
@@ -681,6 +681,6 @@
          endif !precip
 !------------------------------------------------------------- entrainement 
-      elseif(mp(i,j)>mp(i,j+1).and.mp(i,j)>1.e-10) then
-         if(NO_precip(i,j)) 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))
           qPr(i,j,it)=0.
@@ -702,5 +702,5 @@
       else  !mp nul
         qDi(i,j,it)=tr(i,j,it) ! orig 0.
-        if(NO_precip(i,j)) then
+        IF(NO_precip(i,j)) THEN
          qPr(i,j,it)=0.
         else
@@ -719,6 +719,6 @@
 !  DO j=klev,1,-1
 !   DO i=1,klon
-!     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,&
+!     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),&
 !          'zmfdam+zmfpsi',zmfdam(i,j,it)+zmfphi2(i,j,it),'qpmMint',qpmMint(i,j,it),&
@@ -750,34 +750,34 @@
                -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
 
-        if(NO_precip(i,k)) then
+        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
 
@@ -786,19 +786,19 @@
 !------------------------------------------------------------- premiere couche 
    elseif(k==1) then  !                                      mp(1)=0.
-      if(mp(i,2)>1.e-10) then  !detrainement
+      IF(mp(i,2)>1.e-10) then  !detrainement
          uscavtrac= (-0.+mp(i,2))*(qDi(i,k,it)-tr(i,k,it)) !&
 !                   + 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),&
 !                   'mp',mp(i,k)
       else   ! mp(2) = 0 = mp(1) pas de descente insaturee, rien ne se passe s'il ne pleut pas, sinon pluie->env
-        if(NO_precip(i,1)) then
+        IF(NO_precip(i,1)) THEN
           uscavtrac=0.
         else
           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/cvltrorig.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltrorig.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/cvltrorig.F90	(revision 5116)
@@ -79,5 +79,5 @@
      DO j=k-1,1,-1
         DO i=1,klon
-           if(mp(i,j+1)/=0) then
+           IF(mp(i,j+1)/=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/dyn1d/1D_interp_cases.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 5116)
@@ -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) 
@@ -160,5 +160,5 @@
 !! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!if (forc_w==1) then
+!if (forc_w==1) THEN
 !          d_q_adv(l,1)=d_q_adv(l,1)-d_q_dyn_z(l)
 !          d_t_adv(l)=d_t_adv(l)-d_t_dyn_z(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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 5116)
@@ -12,13 +12,12 @@
 
       PRINT*,'FORCING ,forcing_SCM',forcing_SCM
-      if (forcing_SCM) then
-
-         write(*,*),'avant CALL read_SCM'
+      if (forcing_SCM) THEN
+         WRITE(*,*),'avant CALL read_SCM'
          CALL read_SCM_cas
-         write(*,*) 'Forcing read' 
+         WRITE(*,*) 'Forcing read'
 	 PRINT*,'PS ps_cas',ps_cas
 
 !Time interpolation for initial conditions using interpolation routine
-         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+         WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1
         CALL interp_case_time_std(daytime,day1,annee_ref                                       &
 !    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
@@ -50,5 +49,5 @@
 
 ! vertical interpolation using interpolation routine:
-!      write(*,*)'avant interp vert', t_prof
+!      WRITE(*,*)'avant interp vert', t_prof
       CALL interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas                                              &
      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
@@ -77,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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h	(revision 5116)
@@ -2,31 +2,31 @@
 ! $Id: compar1d.h 2010-08-04 17:02:56Z lahellec $
 
-      integer :: forcing_type
-      integer :: tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo
-      real :: nudge_u,nudge_v,nudge_w,nudge_t,nudge_q
-      integer :: iflag_nudge
-      real :: nat_surf
-      real :: tsurf
-      real :: beta_surf
-      real :: rugos
-      real :: rugosh
-      real :: xqsol(1:2)
-      real :: qsurf
-      real :: psurf
-      real :: zsurf
-      real :: albedo
-      real :: snowmass
+      INTEGER :: forcing_type
+      INTEGER :: tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo
+      REAL :: nudge_u,nudge_v,nudge_w,nudge_t,nudge_q
+      INTEGER :: iflag_nudge
+      REAL :: nat_surf
+      REAL :: tsurf
+      REAL :: beta_surf
+      REAL :: rugos
+      REAL :: rugosh
+      REAL :: xqsol(1:2)
+      REAL :: qsurf
+      REAL :: psurf
+      REAL :: zsurf
+      REAL :: albedo
+      REAL :: snowmass
 
-      real :: time
-      real :: time_ini
-      real :: xlat 
-      real :: xlon 
-      real :: airefi
-      real :: wtsurf 
-      real :: wqsurf 
-      real :: restart_runoff 
-      real :: xagesno 
-      real :: qsolinp 
-      real :: zpicinp 
+      REAL :: time
+      REAL :: time_ini
+      REAL :: xlat
+      REAL :: xlon
+      REAL :: airefi
+      REAL :: wtsurf
+      REAL :: wqsurf
+      REAL :: restart_runoff
+      REAL :: xagesno
+      REAL :: qsolinp
+      REAL :: zpicinp
 
       logical :: restart
@@ -41,6 +41,6 @@
 ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
 
-      integer :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
-      integer :: forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar
+      INTEGER :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
+      INTEGER :: forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar
       real    :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_qv
       real    :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/date_cas.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/date_cas.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/date_cas.h	(revision 5116)
@@ -1,8 +1,8 @@
-      integer :: year_ini_cas    ! initial year of the case
-      integer :: mth_ini_cas     ! initial month of the case
-      integer :: day_deb         ! initial day of the case
-      real :: heure_ini_cas      ! start time of the case
-      real :: pdt_cas            ! forcing_frequency
-      real :: day_ju_ini_cas     ! julian day of initial day of the case
+      INTEGER :: year_ini_cas    ! initial year of the case
+      INTEGER :: mth_ini_cas     ! initial month of the case
+      INTEGER :: day_deb         ! initial day of the case
+      REAL :: heure_ini_cas      ! start time of the case
+      REAL :: pdt_cas            ! forcing_frequency
+      REAL :: day_ju_ini_cas     ! julian day of initial day of the case
 
       common /date_cas/year_ini_cas,mth_ini_cas,day_deb,heure_ini_cas,pdt_cas,day_ju_ini_cas
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h	(revision 5116)
@@ -4,5 +4,5 @@
       real   :: a_guide 
       logical :: ok_invertp 
-      integer :: forc_trb
+      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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5116)
@@ -42,6 +42,6 @@
     temp = kelvin
     pres = millibar * 100.0
-    !      write(*,*)'kelvin,millibar=',kelvin,millibar
-    !      write(*,*)'temp,pres=',temp,pres
+    !      WRITE(*,*)'kelvin,millibar=',kelvin,millibar
+    !      WRITE(*,*)'temp,pres=',temp,pres
 
     IF (temp <= rtt) THEN
@@ -642,59 +642,59 @@
     CALL getin('nudging_t', nudging_t)
 
-    write(lunout, *)' +++++++++++++++++++++++++++++++++++++++'
-    write(lunout, *)' Configuration des parametres du gcm1D: '
-    write(lunout, *)' +++++++++++++++++++++++++++++++++++++++'
-    write(lunout, *)' restart = ', restart
-    write(lunout, *)' forcing_type = ', forcing_type
-    write(lunout, *)' time_ini = ', time_ini
-    write(lunout, *)' rlat = ', xlat
-    write(lunout, *)' rlon = ', xlon
-    write(lunout, *)' airephy = ', airefi
-    write(lunout, *)' nat_surf = ', nat_surf
-    write(lunout, *)' tsurf = ', tsurf
-    write(lunout, *)' psurf = ', psurf
-    write(lunout, *)' zsurf = ', zsurf
-    write(lunout, *)' rugos = ', rugos
-    write(lunout, *)' snowmass=', snowmass
-    write(lunout, *)' wtsurf = ', wtsurf
-    write(lunout, *)' wqsurf = ', wqsurf
-    write(lunout, *)' albedo = ', albedo
-    write(lunout, *)' xagesno = ', xagesno
-    write(lunout, *)' restart_runoff = ', restart_runoff
-    write(lunout, *)' qsolinp = ', qsolinp
-    write(lunout, *)' zpicinp = ', zpicinp
-    write(lunout, *)' nudge_tsoil = ', nudge_tsoil
-    write(lunout, *)' isoil_nudge = ', isoil_nudge
-    write(lunout, *)' Tsoil_nudge = ', Tsoil_nudge
-    write(lunout, *)' tau_soil_nudge = ', tau_soil_nudge
-    write(lunout, *)' tadv =      ', tadv
-    write(lunout, *)' tadvv =     ', tadvv
-    write(lunout, *)' tadvh =     ', tadvh
-    write(lunout, *)' thadv =     ', thadv
-    write(lunout, *)' thadvv =    ', thadvv
-    write(lunout, *)' thadvh =    ', thadvh
-    write(lunout, *)' qadv =      ', qadv
-    write(lunout, *)' qadvv =     ', qadvv
-    write(lunout, *)' qadvh =     ', qadvh
-    write(lunout, *)' trad =      ', trad
-    write(lunout, *)' forc_omega = ', forc_omega
-    write(lunout, *)' forc_w     = ', forc_w
-    write(lunout, *)' forc_geo   = ', forc_geo
-    write(lunout, *)' forc_ustar = ', forc_ustar
-    write(lunout, *)' nudging_u  = ', nudging_u
-    write(lunout, *)' nudging_v  = ', nudging_v
-    write(lunout, *)' nudging_t  = ', nudging_t
-    write(lunout, *)' nudging_qv  = ', nudging_qv
+    WRITE(lunout, *)' +++++++++++++++++++++++++++++++++++++++'
+    WRITE(lunout, *)' Configuration des parametres du gcm1D: '
+    WRITE(lunout, *)' +++++++++++++++++++++++++++++++++++++++'
+    WRITE(lunout, *)' restart = ', restart
+    WRITE(lunout, *)' forcing_type = ', forcing_type
+    WRITE(lunout, *)' time_ini = ', time_ini
+    WRITE(lunout, *)' rlat = ', xlat
+    WRITE(lunout, *)' rlon = ', xlon
+    WRITE(lunout, *)' airephy = ', airefi
+    WRITE(lunout, *)' nat_surf = ', nat_surf
+    WRITE(lunout, *)' tsurf = ', tsurf
+    WRITE(lunout, *)' psurf = ', psurf
+    WRITE(lunout, *)' zsurf = ', zsurf
+    WRITE(lunout, *)' rugos = ', rugos
+    WRITE(lunout, *)' snowmass=', snowmass
+    WRITE(lunout, *)' wtsurf = ', wtsurf
+    WRITE(lunout, *)' wqsurf = ', wqsurf
+    WRITE(lunout, *)' albedo = ', albedo
+    WRITE(lunout, *)' xagesno = ', xagesno
+    WRITE(lunout, *)' restart_runoff = ', restart_runoff
+    WRITE(lunout, *)' qsolinp = ', qsolinp
+    WRITE(lunout, *)' zpicinp = ', zpicinp
+    WRITE(lunout, *)' nudge_tsoil = ', nudge_tsoil
+    WRITE(lunout, *)' isoil_nudge = ', isoil_nudge
+    WRITE(lunout, *)' Tsoil_nudge = ', Tsoil_nudge
+    WRITE(lunout, *)' tau_soil_nudge = ', tau_soil_nudge
+    WRITE(lunout, *)' tadv =      ', tadv
+    WRITE(lunout, *)' tadvv =     ', tadvv
+    WRITE(lunout, *)' tadvh =     ', tadvh
+    WRITE(lunout, *)' thadv =     ', thadv
+    WRITE(lunout, *)' thadvv =    ', thadvv
+    WRITE(lunout, *)' thadvh =    ', thadvh
+    WRITE(lunout, *)' qadv =      ', qadv
+    WRITE(lunout, *)' qadvv =     ', qadvv
+    WRITE(lunout, *)' qadvh =     ', qadvh
+    WRITE(lunout, *)' trad =      ', trad
+    WRITE(lunout, *)' forc_omega = ', forc_omega
+    WRITE(lunout, *)' forc_w     = ', forc_w
+    WRITE(lunout, *)' forc_geo   = ', forc_geo
+    WRITE(lunout, *)' forc_ustar = ', forc_ustar
+    WRITE(lunout, *)' nudging_u  = ', nudging_u
+    WRITE(lunout, *)' nudging_v  = ', nudging_v
+    WRITE(lunout, *)' nudging_t  = ', nudging_t
+    WRITE(lunout, *)' nudging_qv  = ', nudging_qv
     IF (forcing_type ==40) THEN
-      write(lunout, *) '--- Forcing type GCSS Old --- with:'
-      write(lunout, *)'imp_fcg', imp_fcg_gcssold
-      write(lunout, *)'ts_fcg', ts_fcg_gcssold
-      write(lunout, *)'tp_fcg', Tp_fcg_gcssold
-      write(lunout, *)'tp_ini', Tp_ini_gcssold
-      write(lunout, *)'xturb_fcg', xTurb_fcg_gcssold
+      WRITE(lunout, *) '--- Forcing type GCSS Old --- with:'
+      WRITE(lunout, *)'imp_fcg', imp_fcg_gcssold
+      WRITE(lunout, *)'ts_fcg', ts_fcg_gcssold
+      WRITE(lunout, *)'tp_fcg', Tp_fcg_gcssold
+      WRITE(lunout, *)'tp_ini', Tp_ini_gcssold
+      WRITE(lunout, *)'xturb_fcg', xTurb_fcg_gcssold
     ENDIF
 
-    write(lunout, *)' +++++++++++++++++++++++++++++++++++++++'
-    write(lunout, *)
+    WRITE(lunout, *)' +++++++++++++++++++++++++++++++++++++++'
+    WRITE(lunout, *)
 
   END SUBROUTINE conf_unicol
@@ -729,10 +729,10 @@
     CHARACTER*(*) fichnom
     !Al1 plev tronque pour .nc mais plev(klev+1):=0
-    real :: plev(klon, klev + 1), play (klon, klev), phi(klon, klev)
-    real :: presnivs(klon, klev)
-    real :: ucov(klon, klev), vcov(klon, klev), temp(klon, klev)
-    real :: q(klon, klev, nqtot), omega2(klon, klev)
-    !      real :: ug(klev),vg(klev),fcoriolis
-    real :: phis(klon)
+    REAL :: plev(klon, klev + 1), play (klon, klev), phi(klon, klev)
+    REAL :: presnivs(klon, klev)
+    REAL :: ucov(klon, klev), vcov(klon, klev), temp(klon, klev)
+    REAL :: q(klon, klev, nqtot), omega2(klon, klev)
+    !      REAL :: ug(klev),vg(klev),fcoriolis
+    REAL :: phis(klon)
 
     !   Variables locales pour NetCDF:
@@ -751,5 +751,5 @@
     !!      nmq(2)="cond"
     !!      do iq=3,nqtot
-    !!        write(nmq(iq),'("tra",i1)') iq-2
+    !!        WRITE(nmq(iq),'("tra",i1)') iq-2
     !!      enddo
     DO iq = 1, nqtot
@@ -862,11 +862,11 @@
     CHARACTER*(*) fichnom
     !Al1 plev tronque pour .nc mais plev(klev+1):=0
-    real :: plev(klon, klev), play (klon, klev), phi(klon, klev)
-    real :: presnivs(klon, klev)
-    real :: ucov(klon, klev), vcov(klon, klev), temp(klon, klev)
-    real :: q(klon, klev, nqtot)
-    real :: omega2(klon, klev), rho(klon, klev + 1)
-    !      real :: ug(klev),vg(klev),fcoriolis
-    real :: phis(klon)
+    REAL :: plev(klon, klev), play (klon, klev), phi(klon, klev)
+    REAL :: presnivs(klon, klev)
+    REAL :: ucov(klon, klev), vcov(klon, klev), temp(klon, klev)
+    REAL :: q(klon, klev, nqtot)
+    REAL :: omega2(klon, klev), rho(klon, klev + 1)
+    !      REAL :: ug(klev),vg(klev),fcoriolis
+    REAL :: phis(klon)
 
     !   Variables locales pour NetCDF:
@@ -1031,9 +1031,9 @@
     !         ierr    = severity of situation ( = 0 normal )
 
-    character(len = *) modname
+    CHARACTER(LEN = *) modname
     integer ierr
-    character(len = *) message
-
-    write(*, *) 'in abort_gcm'
+    CHARACTER(LEN = *) message
+
+    WRITE(*, *) 'in abort_gcm'
     CALL histclo
     !     CALL histclo(2)
@@ -1041,13 +1041,13 @@
     !     CALL histclo(4)
     !     CALL histclo(5)
-    write(*, *) 'out of histclo'
-    write(*, *) 'Stopping in ', modname
-    write(*, *) 'Reason = ', message
+    WRITE(*, *) 'out of histclo'
+    WRITE(*, *) 'Stopping in ', modname
+    WRITE(*, *) 'Reason = ', message
     CALL getin_dump
 
-    if (ierr == 0) then
-      write(*, *) 'Everything is cool'
+    if (ierr == 0) THEN
+      WRITE(*, *) 'Everything is cool'
     else
-      write(*, *) 'Houston, we have a problem ', ierr
+      WRITE(*, *) 'Houston, we have a problem ', ierr
     endif
     STOP
@@ -1296,5 +1296,5 @@
 
     do l = 1, llm
-      if(l==1) then
+      IF(l==1) THEN
         !si omgup pour la couche 1, alors tendance nulle
         omgdown = max(omega(2), 0.0)
@@ -1308,5 +1308,5 @@
         d_v_va(l) = -omgdown * (v(l) - v(l + 1)) / (play(l) - play(l + 1))
 
-      elseif(l==llm) then
+      elseif(l==llm) THEN
         omgup = min(omega(l), 0.0)
         alpha = rkappa * temp(l) * (1. + q(l, 1) * rv / rd) / (play(l) * (1. + q(l, 1)))
@@ -1415,5 +1415,5 @@
     d_t_va(llm) = -omup * dtdp(llm)!+omup*cor(llm)
 
-    !      if(abs(rlat(1))>10.) then
+    !      IF(abs(rlat(1))>10.) THEN
     !     Calculate the tendency due agestrophic motions
     !      du_age = fcoriolis*(v-vg)
@@ -1715,6 +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
@@ -1722,8 +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
@@ -1731,9 +1729,9 @@
           enddo
 
-          if (k1==0 .or. k2==0) then
-            write(*, *) 'PB! k1, k2 = ', k1, k2
-            write(*, *) 'l,play(l) = ', l, play(l) / 100
+          if (k1==0 .or. k2==0) THEN
+            WRITE(*, *) 'PB! k1, k2 = ', k1, k2
+            WRITE(*, *) 'l,play(l) = ', l, play(l) / 100
             do k = 1, nlev_cas - 1
-              write(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
+              WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
             enddo
           endif
@@ -1742,5 +1740,5 @@
           t_mod_cas(l) = t_prof_cas(k2) - frac * (t_prof_cas(k2) - t_prof_cas(k1))
           theta_mod_cas(l) = th_prof_cas(k2) - frac * (th_prof_cas(k2) - th_prof_cas(k1))
-          if(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
+          IF(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
           thv_mod_cas(l) = thv_prof_cas(k2) - frac * (thv_prof_cas(k2) - thv_prof_cas(k1))
           thl_mod_cas(l) = thl_prof_cas(k2) - frac * (thl_prof_cas(k2) - thl_prof_cas(k1))
@@ -1780,5 +1778,5 @@
           t_mod_cas(l) = frac1 * t_prof_cas(k1) - frac2 * t_prof_cas(k2)
           theta_mod_cas(l) = frac1 * th_prof_cas(k1) - frac2 * th_prof_cas(k2)
-          if(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
+          IF(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
           thv_mod_cas(l) = frac1 * thv_prof_cas(k1) - frac2 * thv_prof_cas(k2)
           thl_mod_cas(l) = frac1 * thl_prof_cas(k1) - frac2 * thl_prof_cas(k2)
@@ -1851,5 +1849,5 @@
     enddo ! l
 
-    return
+    RETURN
   end
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90	(revision 5116)
@@ -164,5 +164,5 @@
     !*** on remplit les champs before avec les champs after du pas   ***
     !*** precedent en format gcm                                     ***
-    if(pas>pasprev)then
+    IF(pas>pasprev)THEN
       do i = 1, klev
         htbef(i) = htaft(i)
@@ -193,5 +193,5 @@
               &, ts_fcg, ts_subr, imp_fcg, Turb_fcg)
 
-      if(Tp_fcg) then
+      IF(Tp_fcg) THEN
         !     (le forcage est donne en temperature potentielle)
         do i = 1, nblvlm
@@ -199,5 +199,5 @@
         enddo
       endif ! Tp_fcg
-      if(Turb_fcg) then
+      IF(Turb_fcg) THEN
         do i = 1, nblvlm
           hThTurb_mes(i) = hThTurb_mes(i) * (hplaym(i) / 1000.)**rkappa
@@ -208,9 +208,9 @@
       PRINT*, 'hq_mes ', (hq_mes(i), i = 1, nblvlm)
       PRINT*, 'hw_mes ', (hw_mes(i), i = 1, nblvlm)
-      if(imp_fcg) then
+      IF(imp_fcg) THEN
         PRINT*, 'hu_mes ', (hu_mes(i), i = 1, nblvlm)
         PRINT*, 'hv_mes ', (hv_mes(i), i = 1, nblvlm)
       endif
-      if(Turb_fcg) then
+      IF(Turb_fcg) THEN
         PRINT*, 'hThTurb_mes ', (hThTurb_mes(i), i = 1, nblvlm)
         PRINT*, 'hqTurb_mes ', (hqTurb_mes(i), i = 1, nblvlm)
@@ -220,13 +220,13 @@
       !*** 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)
           hwaft(k) = hw_mes(jm(k) + 1)
-          if(imp_fcg) then
+          IF(imp_fcg) THEN
             huaft(k) = hu_mes(jm(k) + 1)
             hvaft(k) = hv_mes(jm(k) + 1)
           endif ! imp_fcg
-          if(Turb_fcg) then
+          IF(Turb_fcg) THEN
             hThTurbaft(k) = hThTurb_mes(jm(k) + 1)
             hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
@@ -236,9 +236,9 @@
           hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
           hwaft(k) = coef1(k) * hw_mes(jm(k)) + coef2(k) * hw_mes(jm(k) + 1)
-          if(imp_fcg) then
+          IF(imp_fcg) THEN
             huaft(k) = coef1(k) * hu_mes(jm(k)) + coef2(k) * hu_mes(jm(k) + 1)
             hvaft(k) = coef1(k) * hv_mes(jm(k)) + coef2(k) * hv_mes(jm(k) + 1)
           endif ! imp_fcg
-          if(Turb_fcg) then
+          IF(Turb_fcg) THEN
             hThTurbaft(k) = coef1(k) * hThTurb_mes(jm(k))                            &
                     & + coef2(k) * hThTurb_mes(jm(k) + 1)
@@ -256,5 +256,5 @@
     !*** si on atteint le pas max des donnees experimentales ,on     ***
     !*** on conserve les derniers champs calcules                    ***
-    if(temps>=pasmax)then
+    IF(temps>=pasmax)THEN
       do ll = 1, klev
         ht(ll) = htaft(ll)
@@ -274,9 +274,9 @@
         hq(j) = ((timeaft - time) * hqbef(j) + (time - timebef) * hqaft(j)) / dt
         hw(j) = ((timeaft - time) * hwbef(j) + (time - timebef) * hwaft(j)) / dt
-        if(imp_fcg) then
+        IF(imp_fcg) THEN
           hu(j) = ((timeaft - time) * hubef(j) + (time - timebef) * huaft(j)) / dt
           hv(j) = ((timeaft - time) * hvbef(j) + (time - timebef) * hvaft(j)) / dt
         endif ! imp_fcg
-        if(Turb_fcg) then
+        IF(Turb_fcg) THEN
           hThTurb(j) = ((timeaft - time) * hThTurbbef(j)                           &
                   & + (time - timebef) * hThTurbaft(j)) / dt
@@ -316,5 +316,5 @@
     !===================================================================
 
-    write(*, '(a)') 'OPEN ' // file_forctl
+    WRITE(*, '(a)') 'OPEN ' // file_forctl
     open(97, FILE = file_forctl, FORM = 'FORMATTED')
 
@@ -359,5 +359,5 @@
     close(98)
 
-    write(*, '(a)') 'OPEN ' // file_fordat
+    WRITE(*, '(a)') 'OPEN ' // file_fordat
     open(99, FILE = file_fordat, FORM = 'UNFORMATTED', ACCESS = 'DIRECT', RECL = 8)
     icomp1 = nblvlm * 4
@@ -375,5 +375,5 @@
     !   (otherwise this is the potential temperature )
     !------------------------------------------------------------------------
-    if(Tp_fcg) then
+    IF(Tp_fcg) THEN
       do i = 1, nblvlm
         ht_mes(i) = ht_mes(i) * (hplaym(i) / 1000.)**rkappa
@@ -383,10 +383,10 @@
     PRINT*, 'hq_mes ', (hq_mes(i), i = 1, nblvlm)
     PRINT*, 'hw_mes ', (hw_mes(i), i = 1, nblvlm)
-    if(imp_fcg) then
+    IF(imp_fcg) THEN
       PRINT*, 'hu_mes ', (hu_mes(i), i = 1, nblvlm)
       PRINT*, 'hv_mes ', (hv_mes(i), i = 1, nblvlm)
       PRINT*, 't', ts_subr
     endif ! imp_fcg
-    if(Turb_fcg) then
+    IF(Turb_fcg) THEN
       PRINT*, 'hThTurb_mes ', (hThTurb_mes(i), i = 1, nblvlm)
       PRINT*, 'hqTurb ', (hqTurb_mes(i), i = 1, nblvlm)
@@ -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
@@ -403,9 +403,9 @@
         hqaft(k) = hq_mes(jm(k) + 1)
         hwaft(k) = hw_mes(jm(k) + 1)
-        if(imp_fcg) then
+        IF(imp_fcg) THEN
           huaft(k) = hu_mes(jm(k) + 1)
           hvaft(k) = hv_mes(jm(k) + 1)
         endif ! imp_fcg
-        if(Turb_fcg) then
+        IF(Turb_fcg) THEN
           hThTurbaft(k) = hThTurb_mes(jm(k) + 1)
           hqTurbaft(k) = hqTurb_mes(jm(k) + 1)
@@ -415,9 +415,9 @@
         hqaft(k) = coef1(k) * hq_mes(jm(k)) + coef2(k) * hq_mes(jm(k) + 1)
         hwaft(k) = coef1(k) * hw_mes(jm(k)) + coef2(k) * hw_mes(jm(k) + 1)
-        if(imp_fcg) then
+        IF(imp_fcg) THEN
           huaft(k) = coef1(k) * hu_mes(jm(k)) + coef2(k) * hu_mes(jm(k) + 1)
           hvaft(k) = coef1(k) * hv_mes(jm(k)) + coef2(k) * hv_mes(jm(k) + 1)
         endif ! imp_fcg
-        if(Turb_fcg) then
+        IF(Turb_fcg) THEN
           hThTurbaft(k) = coef1(k) * hThTurb_mes(jm(k))                        &
                   & + coef2(k) * hThTurb_mes(jm(k) + 1)
@@ -433,9 +433,9 @@
       hq(k) = hqaft(k)
       hw(k) = hwaft(k)
-      if(imp_fcg) then
+      IF(imp_fcg) THEN
         hu(k) = huaft(k)
         hv(k) = hvaft(k)
       endif ! imp_fcg
-      if(Turb_fcg) then
+      IF(Turb_fcg) THEN
         hThTurb(k) = hThTurbaft(k)
         hqTurb(k) = hqTurbaft(k)
@@ -486,5 +486,5 @@
     enddo
 
-    return
+    RETURN
   end
 
@@ -548,16 +548,16 @@
     !---------------------------------------------------------
 
-    write(*, *) ' '
-    write(*, *) 'TESTS com1_phys_gcss et com2_phys_gcss dans copie.F'
-    write(*, *) '--------------------------------------'
-    write(*, *) 'GCM: nb niveaux:', klev, ' et pression, coeffs:'
+    WRITE(*, *) ' '
+    WRITE(*, *) 'TESTS com1_phys_gcss et com2_phys_gcss dans copie.F'
+    WRITE(*, *) '--------------------------------------'
+    WRITE(*, *) 'GCM: nb niveaux:', klev, ' et pression, coeffs:'
     do k = 1, klev
-      write(*, *) play(k), coef1(k), coef2(k)
-    enddo
-    write(*, *) 'MESO-NH: nb niveaux:', nblvlm, ' et pression:'
+      WRITE(*, *) play(k), coef1(k), coef2(k)
+    enddo
+    WRITE(*, *) 'MESO-NH: nb niveaux:', nblvlm, ' et pression:'
     do k = 1, nblvlm
-      write(*, *) playm(k), hplaym(k)
-    enddo
-    write(*, *) ' '
+      WRITE(*, *) playm(k), hplaym(k)
+    enddo
+    WRITE(*, *) ' '
 
   end
@@ -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.
@@ -662,5 +662,5 @@
     enddo
 
-    if(turb_fcg) then
+    IF(turb_fcg) THEN
       do k = 1, nl
         icomp = icomp + 1
@@ -674,6 +674,5 @@
     print *, ' apres lecture hthtur, hqtur'
 
-    if(imp_fcg) then
-
+    IF(imp_fcg) THEN
       do k = 1, nl
         icomp = icomp + 1
@@ -692,5 +691,5 @@
     enddo
 
-    if(ts_fcg) then
+    IF(ts_fcg) THEN
       icomp = icomp + 1
       read(itape, rec = icomp)ts
@@ -730,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))
@@ -750,5 +749,5 @@
     enddo
 
-    !c      if (play(klev) .le. playm(nblvlm)) then
+    !c      if (play(klev) .le. playm(nblvlm)) THEN
     !c         mlz=nblvlm-1
     !c         JM(klev)=mlz
@@ -773,5 +772,5 @@
     PRINT*, (coef2(k), k = 1, klev)
 
-    return
+    RETURN
   end
   SUBROUTINE GETSCH(STR, DEL, TRM, NTH, SST, NCH)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90	(revision 5116)
@@ -8,5 +8,5 @@
   SUBROUTINE old_lmdz1d
 
-    USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar, getin
+    USE ioipsl, ONLY: ju2ymds, ymds2ju, ioconf_calendar, getin
     USE phys_state_var_mod, ONLY: phys_state_var_init, phys_state_var_end, &
             clwcon, detr_therm, &
@@ -68,37 +68,37 @@
 
     integer, parameter :: ngrid = 1
-    real :: zcufi = 1.
-    real :: zcvfi = 1.
-
-    !-      real :: nat_surf
+    REAL :: zcufi = 1.
+    REAL :: zcvfi = 1.
+
+    !-      REAL :: nat_surf
     !-      logical :: ok_flux_surf
-    !-      real :: fsens
-    !-      real :: flat
-    !-      real :: tsurf
-    !-      real :: rugos
-    !-      real :: qsol(1:2)
-    !-      real :: qsurf
-    !-      real :: psurf
-    !-      real :: zsurf
-    !-      real :: albedo
+    !-      REAL :: fsens
+    !-      REAL :: flat
+    !-      REAL :: tsurf
+    !-      REAL :: rugos
+    !-      REAL :: qsol(1:2)
+    !-      REAL :: qsurf
+    !-      REAL :: psurf
+    !-      REAL :: zsurf
+    !-      REAL :: albedo
     !-
-    !-      real :: time     = 0.
-    !-      real :: time_ini
-    !-      real :: xlat
-    !-      real :: xlon
-    !-      real :: wtsurf
-    !-      real :: wqsurf
-    !-      real :: restart_runoff
-    !-      real :: xagesno
-    !-      real :: qsolinp
-    !-      real :: zpicinp
+    !-      REAL :: time     = 0.
+    !-      REAL :: time_ini
+    !-      REAL :: xlat
+    !-      REAL :: xlon
+    !-      REAL :: wtsurf
+    !-      REAL :: wqsurf
+    !-      REAL :: restart_runoff
+    !-      REAL :: xagesno
+    !-      REAL :: qsolinp
+    !-      REAL :: zpicinp
     !-
-    real :: fnday
-    real :: day, daytime
-    real :: day1
-    real :: heure
-    integer :: jour
-    integer :: mois
-    integer :: an
+    REAL :: fnday
+    REAL :: day, daytime
+    REAL :: day1
+    REAL :: heure
+    INTEGER :: jour
+    INTEGER :: mois
+    INTEGER :: an
 
     !---------------------------------------------------------------------
@@ -106,5 +106,5 @@
     !---------------------------------------------------------------------
 
-    integer :: kmax = llm
+    INTEGER :: kmax = llm
     integer llm700, nq1, nq2
     INTEGER, PARAMETER :: nlev_max = 1000, nqmx = 1000
@@ -117,5 +117,5 @@
     real  qprof(nlev_max, nqmx)
 
-    !        integer :: forcing_type
+    !        INTEGER :: forcing_type
     logical :: forcing_les = .FALSE.
     logical :: forcing_armcu = .FALSE.
@@ -136,5 +136,5 @@
     logical :: forcing_case2 = .FALSE.
     logical :: forcing_SCM = .FALSE.
-    integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
+    INTEGER :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
     !                                                            (cf read_tsurf1d.F)
 
@@ -159,20 +159,20 @@
     !  Declarations related to nudging
     !---------------------------------------------------------------------
-    integer :: nudge_max
+    INTEGER :: nudge_max
     parameter (nudge_max = 9)
-    integer :: inudge_RHT = 1
-    integer :: inudge_UV = 2
+    INTEGER :: inudge_RHT = 1
+    INTEGER :: inudge_UV = 2
     logical :: nudge(nudge_max)
-    real :: t_targ(llm)
-    real :: rh_targ(llm)
-    real :: u_targ(llm)
-    real :: v_targ(llm)
+    REAL :: t_targ(llm)
+    REAL :: rh_targ(llm)
+    REAL :: u_targ(llm)
+    REAL :: v_targ(llm)
 
     !---------------------------------------------------------------------
     !  Declarations related to vertical discretization:
     !---------------------------------------------------------------------
-    real :: pzero = 1.e5
-    real :: play (llm), zlay (llm), sig_s(llm), plev(llm + 1)
-    real :: playd(llm), zlayd(llm), ap_amma(llm + 1), bp_amma(llm + 1)
+    REAL :: pzero = 1.e5
+    REAL :: play (llm), zlay (llm), sig_s(llm), plev(llm + 1)
+    REAL :: playd(llm), zlayd(llm), ap_amma(llm + 1), bp_amma(llm + 1)
 
     !---------------------------------------------------------------------
@@ -180,19 +180,19 @@
     !---------------------------------------------------------------------
 
-    real :: phi(llm)
-    real :: teta(llm), tetal(llm), temp(llm), u(llm), v(llm), w(llm)
+    REAL :: phi(llm)
+    REAL :: teta(llm), tetal(llm), temp(llm), u(llm), v(llm), w(llm)
     REAL rot(1, llm) ! relative vorticity, in s-1
-    real :: rlat_rad(1), rlon_rad(1)
-    real :: omega(llm + 1), omega2(llm), rho(llm + 1)
-    real :: ug(llm), vg(llm), fcoriolis
-    real :: sfdt, cfdt
-    real :: du_phys(llm), dv_phys(llm), dt_phys(llm)
-    real :: dt_dyn(llm)
-    real :: dt_cooling(llm), d_t_adv(llm), d_t_nudge(llm)
-    real :: d_u_nudge(llm), d_v_nudge(llm)
-    real :: du_adv(llm), dv_adv(llm)
-    real :: du_age(llm), dv_age(llm)
-    real :: alpha
-    real :: ttt
+    REAL :: rlat_rad(1), rlon_rad(1)
+    REAL :: omega(llm + 1), omega2(llm), rho(llm + 1)
+    REAL :: ug(llm), vg(llm), fcoriolis
+    REAL :: sfdt, cfdt
+    REAL :: du_phys(llm), dv_phys(llm), dt_phys(llm)
+    REAL :: dt_dyn(llm)
+    REAL :: dt_cooling(llm), d_t_adv(llm), d_t_nudge(llm)
+    REAL :: d_u_nudge(llm), d_v_nudge(llm)
+    REAL :: du_adv(llm), dv_adv(llm)
+    REAL :: du_age(llm), dv_age(llm)
+    REAL :: alpha
+    REAL :: ttt
 
     REAL, ALLOCATABLE, DIMENSION(:, :) :: q
@@ -206,8 +206,8 @@
     !  Initialization of surface variables
     !---------------------------------------------------------------------
-    real :: run_off_lic_0(1)
-    real :: fder(1), snsrf(1, nbsrf), qsurfsrf(1, nbsrf)
-    real :: tsoil(1, nsoilmx, nbsrf)
-    !     real :: agesno(1,nbsrf)
+    REAL :: run_off_lic_0(1)
+    REAL :: fder(1), snsrf(1, nbsrf), qsurfsrf(1, nbsrf)
+    REAL :: tsoil(1, nsoilmx, nbsrf)
+    !     REAL :: agesno(1,nbsrf)
 
     !---------------------------------------------------------------------
@@ -215,6 +215,6 @@
     !---------------------------------------------------------------------
     logical :: ok_writedem = .TRUE.
-    real :: sollw_in = 0.
-    real :: solsw_in = 0.
+    REAL :: sollw_in = 0.
+    REAL :: solsw_in = 0.
 
     !---------------------------------------------------------------------
@@ -223,6 +223,6 @@
     logical :: firstcall = .TRUE.
     logical :: lastcall = .FALSE.
-    real :: phis(1) = 0.0
-    real :: dpsrf(1)
+    REAL :: phis(1) = 0.0
+    REAL :: dpsrf(1)
 
     !---------------------------------------------------------------------
@@ -243,10 +243,10 @@
     !  Fichiers et d'autres variables
     !---------------------------------------------------------------------
-    integer :: k, l, i, it = 1, mxcalc
-    integer :: nsrf
+    INTEGER :: k, l, i, it = 1, mxcalc
+    INTEGER :: nsrf
     integer jcode
     INTEGER read_climoz
 
-    integer :: it_end ! iteration number of the last call
+    INTEGER :: it_end ! iteration number of the last call
     !Al1
     integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
@@ -293,5 +293,5 @@
     close(1)
     !Al1
-    write(*, *) 'lmdz1d.def lu => unicol.def'
+    WRITE(*, *) 'lmdz1d.def lu => unicol.def'
 
     ! forcing_type defines the way the SCM is forced:
@@ -484,17 +484,17 @@
 
     !      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
+      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
+    else if (calend == 'earth_365d') THEN
       CALL ioconf_calendar('noleap')
-      write(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-    else if (calend == 'earth_366d') then
+      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
+    else if (calend == 'earth_366d') THEN
       CALL ioconf_calendar('all_leap')
-      write(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
-    else if (calend == 'gregorian') then
+      WRITE(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
+    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
-      write(*, *)'CALENDRIER CHOISI: Gregorien'
+      WRITE(*, *)'CALENDRIER CHOISI: Gregorien'
     else
       write (*, *) 'ERROR : unknown calendar ', calend
@@ -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
@@ -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 :'
@@ -640,5 +640,5 @@
     !!      surf_Planck = 0.
     !!      surf_Conv   = 0.
-    !!      write(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
+    !!      WRITE(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
     !!! a mettre dans le lmdz1d.def ou autre
     !!
@@ -692,8 +692,8 @@
     IF (forcing_type == 59) THEN
       ! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
-      write(*, *) '***********************'
+      WRITE(*, *) '***********************'
       do l = 1, llm
-        write(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
-        if (trouve_700 .and. play(l)<=70000) then
+        WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
+        if (trouve_700 .and. play(l)<=70000) THEN
           llm700 = l
           print *, 'llm700,play=', llm700, play(l) / 100.
@@ -701,5 +701,5 @@
         endif
       enddo
-      write(*, *) '***********************'
+      WRITE(*, *) '***********************'
     ENDIF
 
@@ -710,5 +710,5 @@
     INCLUDE "old_1D_read_forc_cases.h"
 
-  IF (forcing_GCM2SCM) then
+  IF (forcing_GCM2SCM) THEN
   write (*, *) 'forcing_GCM2SCM not yet implemented'
   stop 'in initialization'
@@ -773,6 +773,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)
@@ -813,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.
@@ -857,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)
@@ -937,5 +936,5 @@
                 CALL getin('iflag_physiq', iflag_physiq)
 
-                if (.not.restart) then
+                if (.not.restart) THEN
                 iflag_pbl = 5
                 CALL phyredem ("startphy.nc")
@@ -978,5 +977,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, &
@@ -1007,7 +1006,7 @@
         END IF
         !Al1 ================  end restart =================================
-        IF (ecrit_slab_oc==1) then
+        IF (ecrit_slab_oc==1) THEN
         open(97, file = 'div_slab.dat', STATUS = 'UNKNOWN')
-                elseif (ecrit_slab_oc==0) then
+                elseif (ecrit_slab_oc==0) THEN
                 open(97, file = 'div_slab.dat', STATUS = 'OLD')
                 END IF
@@ -1016,8 +1015,8 @@
                 !    Initialize target profile for RHT nudging if needed
                 !---------------------------------------------------------------------
-                IF (nudge(inudge_RHT)) then
+                IF (nudge(inudge_RHT)) THEN
         CALL nudge_RHT_init(plev, play, temp, q(:, 1), t_targ, rh_targ)
                 END IF
-                IF (nudge(inudge_UV)) then
+                IF (nudge(inudge_UV)) THEN
                 CALL nudge_UV_init(plev, play, u, v, u_targ, v_targ)
                 END IF
@@ -1034,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
@@ -1058,5 +1057,5 @@
                 INCLUDE "old_1D_interp_cases.h"
 
-                IF (forcing_GCM2SCM) then
+                IF (forcing_GCM2SCM) THEN
         write (*, *) 'forcing_GCM2SCM not yet implemented'
         stop 'in time loop'
@@ -1076,17 +1075,17 @@
                 ! 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', &
+                WRITE(*, *) 'firstcall,lastcall,phis', &
                 firstcall, lastcall, phis
                 end if
-                IF (prt_level>=5) then
-        write(*, '(a10,2a4,4a13)') 'BEFOR1 IT=', 'it', 'l', &
+                IF (prt_level>=5) THEN
+        WRITE(*, '(a10,2a4,4a13)') 'BEFOR1 IT=', 'it', 'l', &
         'presniv', 'plev', 'play', 'phi'
-        write(*, '(a10,2i4,4f13.2)') ('BEFOR1 IT= ', it, l, &
+        WRITE(*, '(a10,2i4,4f13.2)') ('BEFOR1 IT= ', it, l, &
         presnivs(l), plev(l), play(l), phi(l), l = 1, llm)
-                write(*, '(a11,2a4,a11,6a8)') 'BEFOR2', 'it', 'l', &
+                WRITE(*, '(a11,2a4,a11,6a8)') 'BEFOR2', 'it', 'l', &
                 'presniv', 'u', 'v', 'temp', 'q1', 'q2', 'omega2'
-        write(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ', it, l, &
+        WRITE(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ', it, l, &
         presnivs(l), u(l), v(l), temp(l), q(l, 1), q(l, 2), omega2(l), l = 1, llm)
                 END IF
@@ -1105,19 +1104,19 @@
                 ! Listing output for debug
                 !---------------------------------------------------------------------
-                IF (prt_level>=5) then
-        write(*, '(a11,2a4,4a13)') 'AFTER1 IT=', 'it', 'l', &
+                IF (prt_level>=5) THEN
+        WRITE(*, '(a11,2a4,4a13)') 'AFTER1 IT=', 'it', 'l', &
         'presniv', 'plev', 'play', 'phi'
-        write(*, '(a11,2i4,4f13.2)') ('AFTER1 it= ', it, l, &
+        WRITE(*, '(a11,2i4,4f13.2)') ('AFTER1 it= ', it, l, &
         presnivs(l), plev(l), play(l), phi(l), l = 1, llm)
-                write(*, '(a11,2a4,a11,6a8)') 'AFTER2', 'it', 'l', &
+                WRITE(*, '(a11,2a4,a11,6a8)') 'AFTER2', 'it', 'l', &
                 'presniv', 'u', 'v', 'temp', 'q1', 'q2', 'omega2'
-                write(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ', it, l, &
+                WRITE(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ', it, l, &
                 presnivs(l), u(l), v(l), temp(l), q(l, 1), q(l, 2), omega2(l), l = 1, llm)
-        write(*, '(a11,2a4,a11,5a8)') 'AFTER3', 'it', 'l', &
+        WRITE(*, '(a11,2a4,a11,5a8)') 'AFTER3', 'it', 'l', &
         'presniv', 'du_phys', 'dv_phys', 'dt_phys', 'dq1', 'dq2'
-        write(*, '(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ', it, l, &
+        WRITE(*, '(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ', it, l, &
         presnivs(l), 86400 * du_phys(l), 86400 * dv_phys(l), &
         86400 * dt_phys(l), 86400 * dq(l, 1), dq(l, 2), l = 1, llm)
-                write(*, *) 'dpsrf', dpsrf
+                WRITE(*, *) 'dpsrf', dpsrf
                 END IF
                 !---------------------------------------------------------------------
@@ -1126,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
@@ -1135,14 +1134,14 @@
 
                 IF (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
-                .or.forcing_amma .or. forcing_type==101) then
+                .or.forcing_amma .or. forcing_type==101) THEN
                 fcoriolis = 0.0 ; ug = 0. ; vg = 0.
                 END IF
 
-                IF(forcing_rico) then
+                IF(forcing_rico) THEN
                 dt_cooling = 0.
                 END IF
 
                 !CRio:Attention modif sp??cifique cas de Caroline
-IF (forcing_type==-1) then
+IF (forcing_type==-1) THEN
         fcoriolis = 0.
         !Nudging
@@ -1150,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
@@ -1161,5 +1160,5 @@
         END IF
                 !RC
-                IF (forcing_sandu) then
+                IF (forcing_sandu) THEN
                 ug(1:llm) = u_mod(1:llm)
                 vg(1:llm) = v_mod(1:llm)
@@ -1198,9 +1197,9 @@
         d_u_nudge(:) = 0.
         d_v_nudge(:) = 0.
-        IF (nudge(inudge_RHT)) then
+        IF (nudge(inudge_RHT)) THEN
         CALL nudge_RHT(timestep, plev, play, t_targ, rh_targ, temp, q(:, 1), &
         d_t_nudge, d_q_nudge(:, 1))
         END IF
-        IF (nudge(inudge_UV)) then
+        IF (nudge(inudge_UV)) THEN
         CALL nudge_UV(timestep, plev, play, u_targ, v_targ, u, v, &
         d_u_nudge, d_v_nudge)
@@ -1218,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
@@ -1243,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
@@ -1259,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) ', &
@@ -1316,5 +1315,5 @@
                 !   Air temperature :
                 !---------------------------------------------------------------------
-                IF (lastcall) then
+                IF (lastcall) THEN
                 PRINT*, 'Pas de temps final ', it
                 CALL ju2ymds(daytime, an, mois, jour, heure)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90	(revision 5116)
@@ -4,5 +4,5 @@
 CONTAINS
   SUBROUTINE scm
-    USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar, getin
+    USE ioipsl, ONLY: ju2ymds, ymds2ju, ioconf_calendar, getin
     USE phys_state_var_mod, ONLY: phys_state_var_init, phys_state_var_end, &
             clwcon, detr_therm, &
@@ -65,13 +65,13 @@
 
     integer, parameter :: ngrid = 1
-    real :: zcufi = 1.
-    real :: zcvfi = 1.
-    real :: fnday
-    real :: day, daytime
-    real :: day1
-    real :: heure
-    integer :: jour
-    integer :: mois
-    integer :: an
+    REAL :: zcufi = 1.
+    REAL :: zcvfi = 1.
+    REAL :: fnday
+    REAL :: day, daytime
+    REAL :: day1
+    REAL :: heure
+    INTEGER :: jour
+    INTEGER :: mois
+    INTEGER :: an
 
     !---------------------------------------------------------------------
@@ -79,5 +79,5 @@
     !---------------------------------------------------------------------
 
-    integer :: kmax = llm
+    INTEGER :: kmax = llm
     integer llm700, nq1, nq2
     INTEGER, PARAMETER :: nlev_max = 1000, nqmx = 1000
@@ -90,5 +90,5 @@
     real  qprof(nlev_max, nqmx)
 
-    !        integer :: forcing_type
+    !        INTEGER :: forcing_type
     logical :: forcing_les = .FALSE.
     logical :: forcing_armcu = .FALSE.
@@ -125,20 +125,20 @@
     !  Declarations related to nudging
     !---------------------------------------------------------------------
-    integer :: nudge_max
+    INTEGER :: nudge_max
     parameter (nudge_max = 9)
-    integer :: inudge_RHT = 1
-    integer :: inudge_UV = 2
+    INTEGER :: inudge_RHT = 1
+    INTEGER :: inudge_UV = 2
     logical :: nudge(nudge_max)
-    real :: t_targ(llm)
-    real :: rh_targ(llm)
-    real :: u_targ(llm)
-    real :: v_targ(llm)
+    REAL :: t_targ(llm)
+    REAL :: rh_targ(llm)
+    REAL :: u_targ(llm)
+    REAL :: v_targ(llm)
 
     !---------------------------------------------------------------------
     !  Declarations related to vertical discretization:
     !---------------------------------------------------------------------
-    real :: pzero = 1.e5
-    real :: play (llm), zlay (llm), sig_s(llm), plev(llm + 1)
-    real :: playd(llm), zlayd(llm), ap_amma(llm + 1), bp_amma(llm + 1)
+    REAL :: pzero = 1.e5
+    REAL :: play (llm), zlay (llm), sig_s(llm), plev(llm + 1)
+    REAL :: playd(llm), zlayd(llm), ap_amma(llm + 1), bp_amma(llm + 1)
 
     !---------------------------------------------------------------------
@@ -146,20 +146,20 @@
     !---------------------------------------------------------------------
 
-    real :: phi(llm)
-    real :: teta(llm), tetal(llm), temp(llm), u(llm), v(llm), w(llm)
+    REAL :: phi(llm)
+    REAL :: teta(llm), tetal(llm), temp(llm), u(llm), v(llm), w(llm)
     REAL rot(1, llm) ! relative vorticity, in s-1
-    real :: rlat_rad(1), rlon_rad(1)
-    real :: omega(llm), omega2(llm), rho(llm + 1)
-    real :: ug(llm), vg(llm), fcoriolis
-    real :: sfdt, cfdt
-    real :: du_phys(llm), dv_phys(llm), dt_phys(llm)
-    real :: w_adv(llm), z_adv(llm)
-    real :: d_t_vert_adv(llm), d_u_vert_adv(llm), d_v_vert_adv(llm)
-    real :: dt_cooling(llm), d_t_adv(llm), d_t_nudge(llm)
-    real :: d_u_nudge(llm), d_v_nudge(llm)
-    !      real :: d_u_adv(llm),d_v_adv(llm)
-    real :: d_u_age(llm), d_v_age(llm)
-    real :: alpha
-    real :: ttt
+    REAL :: rlat_rad(1), rlon_rad(1)
+    REAL :: omega(llm), omega2(llm), rho(llm + 1)
+    REAL :: ug(llm), vg(llm), fcoriolis
+    REAL :: sfdt, cfdt
+    REAL :: du_phys(llm), dv_phys(llm), dt_phys(llm)
+    REAL :: w_adv(llm), z_adv(llm)
+    REAL :: d_t_vert_adv(llm), d_u_vert_adv(llm), d_v_vert_adv(llm)
+    REAL :: dt_cooling(llm), d_t_adv(llm), d_t_nudge(llm)
+    REAL :: d_u_nudge(llm), d_v_nudge(llm)
+    !      REAL :: d_u_adv(llm),d_v_adv(llm)
+    REAL :: d_u_age(llm), d_v_age(llm)
+    REAL :: alpha
+    REAL :: ttt
 
     REAL, ALLOCATABLE, DIMENSION(:, :) :: q
@@ -173,8 +173,8 @@
     !  Initialization of surface variables
     !---------------------------------------------------------------------
-    real :: run_off_lic_0(1)
-    real :: fder(1), snsrf(1, nbsrf), qsurfsrf(1, nbsrf)
-    real :: tsoil(1, nsoilmx, nbsrf)
-    !     real :: agesno(1,nbsrf)
+    REAL :: run_off_lic_0(1)
+    REAL :: fder(1), snsrf(1, nbsrf), qsurfsrf(1, nbsrf)
+    REAL :: tsoil(1, nsoilmx, nbsrf)
+    !     REAL :: agesno(1,nbsrf)
 
     !---------------------------------------------------------------------
@@ -182,6 +182,6 @@
     !---------------------------------------------------------------------
     logical :: ok_writedem = .TRUE.
-    real :: sollw_in = 0.
-    real :: solsw_in = 0.
+    REAL :: sollw_in = 0.
+    REAL :: solsw_in = 0.
 
     !---------------------------------------------------------------------
@@ -190,6 +190,6 @@
     logical :: firstcall = .TRUE.
     logical :: lastcall = .FALSE.
-    real :: phis(1) = 0.0
-    real :: dpsrf(1)
+    REAL :: phis(1) = 0.0
+    REAL :: dpsrf(1)
 
     !---------------------------------------------------------------------
@@ -210,10 +210,10 @@
     !  Fichiers et d'autres variables
     !---------------------------------------------------------------------
-    integer :: k, l, i, it = 1, mxcalc
-    integer :: nsrf
+    INTEGER :: k, l, i, it = 1, mxcalc
+    INTEGER :: nsrf
     integer jcode
     INTEGER read_climoz
 
-    integer :: it_end ! iteration number of the last call
+    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
@@ -263,5 +263,5 @@
     ! --------------------------------------------------------------------
     close(1)
-    write(*, *) 'lmdz1d.def lu => unicol.def'
+    WRITE(*, *) 'lmdz1d.def lu => unicol.def'
 
     forcing_SCM = .TRUE.
@@ -315,17 +315,17 @@
 
     !      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
+      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
+    else if (calend == 'earth_365d') THEN
       CALL ioconf_calendar('noleap')
-      write(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
-    else if (calend == 'earth_366d') then
+      WRITE(*, *)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
+    else if (calend == 'earth_366d') THEN
       CALL ioconf_calendar('all_leap')
-      write(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
-    else if (calend == 'gregorian') then
+      WRITE(*, *)'CALENDRIER CHOISI: Terrestre bissextile'
+    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
-      write(*, *)'CALENDRIER CHOISI: Gregorien'
+      WRITE(*, *)'CALENDRIER CHOISI: Gregorien'
     else
       write (*, *) 'ERROR : unknown calendar ', calend
@@ -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
@@ -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 :'
@@ -458,8 +458,8 @@
     IF (forcing_type == 59) THEN
       ! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
-      write(*, *) '***********************'
+      WRITE(*, *) '***********************'
       do l = 1, llm
-        write(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
-        if (trouve_700 .and. play(l)<=70000) then
+        WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
+        if (trouve_700 .and. play(l)<=70000) THEN
           llm700 = l
           print *, 'llm700,play=', llm700, play(l) / 100.
@@ -467,5 +467,5 @@
         endif
       enddo
-      write(*, *) '***********************'
+      WRITE(*, *) '***********************'
     ENDIF
 
@@ -477,5 +477,5 @@
   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'
@@ -536,6 +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)
@@ -575,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.
@@ -694,5 +693,5 @@
                 CALL getin('iflag_physiq', iflag_physiq)
 
-                if (.not.restart) then
+                if (.not.restart) THEN
         iflag_pbl = 5
         CALL phyredem ("startphy.nc")
@@ -736,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, &
@@ -765,7 +764,7 @@
                 endif
                 !======================  end restart =================================
-                IF (ecrit_slab_oc==1) then
+                IF (ecrit_slab_oc==1) THEN
         open(97, file = 'div_slab.dat', STATUS = 'UNKNOWN')
-                elseif (ecrit_slab_oc==0) then
+                elseif (ecrit_slab_oc==0) THEN
                 open(97, file = 'div_slab.dat', STATUS = 'OLD')
                 endif
@@ -783,5 +782,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
@@ -843,17 +842,17 @@
                 ! 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', &
+                        WRITE(*, *) 'firstcall,lastcall,phis', &
                 firstcall, lastcall, phis
                 end if
-                        if (prt_level>=5) then
-                write(*, '(a10,2a4,4a13)') 'BEFOR1 IT=', 'it', 'l', &
+                        if (prt_level>=5) THEN
+                WRITE(*, '(a10,2a4,4a13)') 'BEFOR1 IT=', 'it', 'l', &
                 'presniv', 'plev','play', 'phi'
-                write(*, '(a10,2i4,4f13.2)') ('BEFOR1 IT= ', it, l, &
+                WRITE(*, '(a10,2i4,4f13.2)') ('BEFOR1 IT= ', it, l, &
                 presnivs(l), plev(l), play(l), phi(l), l = 1, llm)
-                        write(*, '(a11,2a4,a11,6a8)') 'BEFOR2', 'it', 'l', &
+                        WRITE(*, '(a11,2a4,a11,6a8)') 'BEFOR2', 'it', 'l', &
                         'presniv', 'u','v', 'temp', 'q1', 'q2', 'omega2'
-                        write(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ', it, l, &
+                        WRITE(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ', it, l, &
                 presnivs(l), u(l), v(l), temp(l), q(l, 1), q(l, 2), omega2(l), l = 1, llm)
                         endif
@@ -872,19 +871,19 @@
                         ! Listing output for debug
                         !---------------------------------------------------------------------
-                        if (prt_level>=5) then
-                        write(*, '(a11,2a4,4a13)') 'AFTER1 IT=', 'it', 'l', &
+                        if (prt_level>=5) THEN
+                        WRITE(*, '(a11,2a4,4a13)') 'AFTER1 IT=', 'it', 'l', &
                         'presniv', 'plev','play', 'phi'
-                        write(*, '(a11,2i4,4f13.2)') ('AFTER1 it= ', it, l, &
+                        WRITE(*, '(a11,2i4,4f13.2)') ('AFTER1 it= ', it, l, &
                 presnivs(l), plev(l), play(l), phi(l), l = 1, llm)
-                        write(*, '(a11,2a4,a11,6a8)') 'AFTER2', 'it', 'l', &
+                        WRITE(*, '(a11,2a4,a11,6a8)') 'AFTER2', 'it', 'l', &
                         'presniv', 'u','v', 'temp', 'q1', 'q2', 'omega2'
-                        write(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ', it, l, &
+                        WRITE(*, '(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ', it, l, &
                         presnivs(l), u(l), v(l), temp(l), q(l, 1), q(l, 2), omega2(l), l = 1, llm)
-                        write(*, '(a11,2a4,a11,5a8)') 'AFTER3', 'it', 'l', &
+                        WRITE(*, '(a11,2a4,a11,5a8)') 'AFTER3', 'it', 'l', &
         'presniv', 'du_phys','dv_phys', 'dt_phys', 'dq1', 'dq2'
-        write(*, '(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ', it, l, &
+        WRITE(*, '(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ', it, l, &
         presnivs(l), 86400*du_phys(l), 86400*dv_phys(l), &
         86400*dt_phys(l), 86400*dq(l, 1), dq(l, 2), l = 1, llm)
-                write(*, *) 'dpsrf', dpsrf
+                WRITE(*, *) 'dpsrf', dpsrf
                 endif
                 !---------------------------------------------------------------------
@@ -1018,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) ', &
@@ -1073,5 +1072,5 @@
                 !   Air temperature :
                 !---------------------------------------------------------------------
-                if (lastcall) then
+                if (lastcall) THEN
                 PRINT*, 'Pas de temps final ', it
                 CALL ju2ymds(daytime, 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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90	(revision 5116)
@@ -65,7 +65,7 @@
       ierr = nf90_open(fich_amma,nf90_nowrite,nid)
       PRINT*,'fich_amma,nf90_nowrite,nid ',fich_amma,nf90_nowrite,nid
-      if (ierr/=nf90_noerr) then
-         write(*,*) 'ERROR: GROS Pb opening forcings nc file '
-         write(*,*) nf90_strerror(ierr)
+      if (ierr/=nf90_noerr) THEN
+         WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
+         WRITE(*,*) nf90_strerror(ierr)
          stop ""
       endif
@@ -196,6 +196,6 @@
 
        ierr=nf90_inq_varid(nid,"zz",var3didin(1))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'lev'
          endif
@@ -203,60 +203,60 @@
 
       ierr=nf90_inq_varid(nid,"temp",var3didin(2))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'temp'
          endif
 
       ierr=nf90_inq_varid(nid,"qv",var3didin(3))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'qv'
          endif
 
       ierr=nf90_inq_varid(nid,"u",var3didin(4))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'u'
          endif
 
       ierr=nf90_inq_varid(nid,"v",var3didin(5))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'v'
          endif
 
       ierr=nf90_inq_varid(nid,"dw",var3didin(6))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'dw'
          endif
 
       ierr=nf90_inq_varid(nid,"dt",var3didin(7))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'dt'
          endif
 
       ierr=nf90_inq_varid(nid,"dq",var3didin(8))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'dq'
          endif
       
       ierr=nf90_inq_varid(nid,"sens",var3didin(9))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'sens'
          endif
 
       ierr=nf90_inq_varid(nid,"flat",var3didin(10))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'flat'
          endif
 
       ierr=nf90_inq_varid(nid,"pp",var3didin(11))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
       endif
 
@@ -265,79 +265,79 @@
  
          ierr = nf90_get_var(nid,var3didin(1),zz)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture z ok',zz
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture z ok',zz
 
          ierr = nf90_get_var(nid,var3didin(2),temp)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture th ok',temp
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture th ok',temp
 
          ierr = nf90_get_var(nid,var3didin(3),qv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture qv ok',qv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture qv ok',qv
  
          ierr = nf90_get_var(nid,var3didin(4),u)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture u ok',u
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture u ok',u
 
          ierr = nf90_get_var(nid,var3didin(5),v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture v ok',v
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture v ok',v
 
          ierr = nf90_get_var(nid,var3didin(6),dw)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture w ok',dw
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture w ok',dw
 
          ierr = nf90_get_var(nid,var3didin(7),dt)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dt ok',dt
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dt ok',dt
 
          ierr = nf90_get_var(nid,var3didin(8),dq)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dq ok',dq
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dq ok',dq
 
          ierr = nf90_get_var(nid,var3didin(9),sens)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture sens ok',sens
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture sens ok',sens
 
          ierr = nf90_get_var(nid,var3didin(10),flat)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture flat ok',flat
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture flat ok',flat
 
          ierr = nf90_get_var(nid,var3didin(11),pp)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture pp ok',pp
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture pp ok',pp
 
 
@@ -381,17 +381,17 @@
 
 
-        if (forcing_type==6) then
+        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,6 +424,6 @@
        time_amma2=(it_amma2-1)*dt_amma
 
-       if (it_amma1 > nt_amma) then
-        write(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
+       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.
         stop
@@ -452,5 +452,5 @@
         enddo
 
-        return
+        RETURN
         END
 
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90	(revision 5116)
@@ -95,7 +95,7 @@
       ierr = nf90_open(fich_cas,nf90_nowrite,nid)
       PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-      if (ierr/=nf90_noerr) then
-         write(*,*) 'ERROR: GROS Pb opening forcings nc file '
-         write(*,*) nf90_strerror(ierr)
+      if (ierr/=nf90_noerr) THEN
+         WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
+         WRITE(*,*) nf90_strerror(ierr)
          stop ""
       endif
@@ -289,12 +289,12 @@
 
        ierr=nf90_inq_varid(nid,"zz",var3didin(1))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'lev'
          endif
 
       ierr=nf90_inq_varid(nid,"pp",var3didin(2))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'plev'
          endif
@@ -302,30 +302,30 @@
 
       ierr=nf90_inq_varid(nid,"temp",var3didin(3))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'temp'
          endif
 
       ierr=nf90_inq_varid(nid,"qv",var3didin(4))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'qv'
          endif
 
       ierr=nf90_inq_varid(nid,"rh",var3didin(5))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'rh'
          endif
 
       ierr=nf90_inq_varid(nid,"theta",var3didin(6))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'theta'
          endif
 
       ierr=nf90_inq_varid(nid,"rv",var3didin(7))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'rv'
          endif
@@ -333,468 +333,468 @@
 
       ierr=nf90_inq_varid(nid,"u",var3didin(8))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'u'
          endif
 
       ierr=nf90_inq_varid(nid,"v",var3didin(9))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'v'
          endif
 
        ierr=nf90_inq_varid(nid,"ug",var3didin(10))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'ug'
          endif
 
       ierr=nf90_inq_varid(nid,"vg",var3didin(11))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vg'
          endif
 
       ierr=nf90_inq_varid(nid,"w",var3didin(12))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'w'
          endif
 
       ierr=nf90_inq_varid(nid,"advu",var3didin(13))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'advu'
          endif
 
       ierr=nf90_inq_varid(nid,"hu",var3didin(14))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hu'
          endif
 
        ierr=nf90_inq_varid(nid,"vu",var3didin(15))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vu'
          endif
 
        ierr=nf90_inq_varid(nid,"advv",var3didin(16))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'advv'
          endif
 
       ierr=nf90_inq_varid(nid,"hv",var3didin(17))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hv'
          endif
 
        ierr=nf90_inq_varid(nid,"vv",var3didin(18))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vv'
          endif
 
       ierr=nf90_inq_varid(nid,"advT",var3didin(19))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'advT'
          endif
 
       ierr=nf90_inq_varid(nid,"hT",var3didin(20))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hT'
          endif
 
       ierr=nf90_inq_varid(nid,"vT",var3didin(21))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vT'
          endif
 
       ierr=nf90_inq_varid(nid,"advq",var3didin(22))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'advq'
          endif
 
       ierr=nf90_inq_varid(nid,"hq",var3didin(23))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hq'
          endif
 
       ierr=nf90_inq_varid(nid,"vq",var3didin(24))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vq'
          endif
 
       ierr=nf90_inq_varid(nid,"advth",var3didin(25))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'advth'
          endif
 
       ierr=nf90_inq_varid(nid,"hth",var3didin(26))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hth'
          endif
 
       ierr=nf90_inq_varid(nid,"vth",var3didin(27))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vth'
          endif
 
       ierr=nf90_inq_varid(nid,"advr",var3didin(28))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'advr'
          endif
 
       ierr=nf90_inq_varid(nid,"hr",var3didin(29))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hr'
          endif
 
       ierr=nf90_inq_varid(nid,"vr",var3didin(30))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vr'
          endif
 
       ierr=nf90_inq_varid(nid,"radT",var3didin(31))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'radT'
          endif
 
       ierr=nf90_inq_varid(nid,"sens",var3didin(32))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'sens'
          endif
 
       ierr=nf90_inq_varid(nid,"flat",var3didin(33))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'flat'
          endif
 
       ierr=nf90_inq_varid(nid,"ts",var3didin(34))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'ts'
          endif
 
       ierr=nf90_inq_varid(nid,"ustar",var3didin(35))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'ustar'
          endif
 
       ierr=nf90_inq_varid(nid,"uw",var3didin(36))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'uw'
          endif
 
       ierr=nf90_inq_varid(nid,"vw",var3didin(37))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vw'
          endif
 
       ierr=nf90_inq_varid(nid,"q1",var3didin(38))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'q1'
          endif
 
       ierr=nf90_inq_varid(nid,"q2",var3didin(39))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'q2'
          endif
 
          ierr = nf90_get_var(nid,var3didin(1),zz)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture z ok',zz
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture z ok',zz
 
          ierr = nf90_get_var(nid,var3didin(2),pp)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture pp ok',pp
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture pp ok',pp
 
 
          ierr = nf90_get_var(nid,var3didin(3),temp)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture T ok',temp
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture T ok',temp
 
          ierr = nf90_get_var(nid,var3didin(4),qv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture qv ok',qv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture qv ok',qv
 
          ierr = nf90_get_var(nid,var3didin(5),rh)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture rh ok',rh
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture rh ok',rh
 
          ierr = nf90_get_var(nid,var3didin(6),theta)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture theta ok',theta
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture theta ok',theta
 
          ierr = nf90_get_var(nid,var3didin(7),rv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture rv ok',rv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture rv ok',rv
 
          ierr = nf90_get_var(nid,var3didin(8),u)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture u ok',u
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture u ok',u
 
          ierr = nf90_get_var(nid,var3didin(9),v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture v ok',v
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture v ok',v
 
          ierr = nf90_get_var(nid,var3didin(10),ug)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ug ok',ug
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture ug ok',ug
 
          ierr = nf90_get_var(nid,var3didin(11),vg)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vg ok',vg
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vg ok',vg
 
          ierr = nf90_get_var(nid,var3didin(12),w)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture w ok',w
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture w ok',w
 
          ierr = nf90_get_var(nid,var3didin(13),du)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture du ok',du
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture du ok',du
 
          ierr = nf90_get_var(nid,var3didin(14),hu)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hu ok',hu
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hu ok',hu
 
          ierr = nf90_get_var(nid,var3didin(15),vu)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vu ok',vu
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vu ok',vu
 
          ierr = nf90_get_var(nid,var3didin(16),dv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dv ok',dv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dv ok',dv
 
          ierr = nf90_get_var(nid,var3didin(17),hv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hv ok',hv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hv ok',hv
 
          ierr = nf90_get_var(nid,var3didin(18),vv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vv ok',vv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vv ok',vv
 
          ierr = nf90_get_var(nid,var3didin(19),dt)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dt ok',dt
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dt ok',dt
 
          ierr = nf90_get_var(nid,var3didin(20),ht)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ht ok',ht
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture ht ok',ht
 
          ierr = nf90_get_var(nid,var3didin(21),vt)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vt ok',vt
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vt ok',vt
 
          ierr = nf90_get_var(nid,var3didin(22),dq)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dq ok',dq
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dq ok',dq
 
          ierr = nf90_get_var(nid,var3didin(23),hq)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hq ok',hq
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hq ok',hq
 
          ierr = nf90_get_var(nid,var3didin(24),vq)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vq ok',vq
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vq ok',vq
 
          ierr = nf90_get_var(nid,var3didin(25),dth)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dth ok',dth
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dth ok',dth
 
          ierr = nf90_get_var(nid,var3didin(26),hth)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hth ok',hth
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hth ok',hth
 
          ierr = nf90_get_var(nid,var3didin(27),vth)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vth ok',vth
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vth ok',vth
 
          ierr = nf90_get_var(nid,var3didin(28),dr)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dr ok',dr
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dr ok',dr
 
          ierr = nf90_get_var(nid,var3didin(29),hr)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hr ok',hr
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hr ok',hr
 
          ierr = nf90_get_var(nid,var3didin(30),vr)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vr ok',vr
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vr ok',vr
 
          ierr = nf90_get_var(nid,var3didin(31),dtrad)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dtrad ok',dtrad
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dtrad ok',dtrad
 
          ierr = nf90_get_var(nid,var3didin(32),sens)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture sens ok',sens
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture sens ok',sens
 
          ierr = nf90_get_var(nid,var3didin(33),flat)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture flat ok',flat
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture flat ok',flat
 
          ierr = nf90_get_var(nid,var3didin(34),ts)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ts ok',ts
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture ts ok',ts
 
          ierr = nf90_get_var(nid,var3didin(35),ustar)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture ustar ok',ustar
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture ustar ok',ustar
 
          ierr = nf90_get_var(nid,var3didin(36),uw)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture uw ok',uw
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture uw ok',uw
 
          ierr = nf90_get_var(nid,var3didin(37),vw)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture vw ok',vw
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture vw ok',vw
 
          ierr = nf90_get_var(nid,var3didin(38),q1)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q1 ok',q1
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture q1 ok',q1
 
          ierr = nf90_get_var(nid,var3didin(39),q2)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q2 ok',q2
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture q2 ok',q2
 
 
@@ -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,6 +929,6 @@
       print *,'time_cas2=',time_cas2
 
-       if (it_cas1 > nt_cas) then
-        write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+       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
@@ -1005,5 +1005,5 @@
         enddo
 
-        return
+        RETURN
         END
 
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 5116)
@@ -89,7 +89,7 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) then
-       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
-       write(*,*) nf90_strerror(ierr)
+    if (ierr/=nf90_noerr) THEN
+       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
+       WRITE(*,*) nf90_strerror(ierr)
        stop ""
     endif
@@ -198,7 +198,7 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) then
-       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
-       write(*,*) nf90_strerror(ierr)
+    if (ierr/=nf90_noerr) THEN
+       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
+       WRITE(*,*) nf90_strerror(ierr)
        stop ""
     endif
@@ -326,7 +326,7 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) then
-       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
-       write(*,*) nf90_strerror(ierr)
+    if (ierr/=nf90_noerr) THEN
+       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
+       WRITE(*,*) nf90_strerror(ierr)
        stop ""
     endif
@@ -367,5 +367,5 @@
     PRINT*,'LECTURE DU TEMPS'
     ierr=nf90_inq_varid(nid,'time',timeid)
-    if(ierr/=nf90_noerr) then
+    IF(ierr/=nf90_noerr) THEN
        print *,'Variable time manquante dans cas.nc:'
        ierr=nf90_noerr
@@ -373,5 +373,5 @@
        allocate(time_val(nt_cas))
        ierr = nf90_get_var(nid,timeid,time_val)
-       if(ierr/=nf90_noerr) then
+       IF(ierr/=nf90_noerr) THEN
           print *,'Pb a la lecture de time cas.nc: '
        endif
@@ -575,5 +575,5 @@
      ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
      print *,'ierr=',i,ierr,name_var(i),var3didin(i)
-     if(ierr/=nf90_noerr) then
+     IF(ierr/=nf90_noerr) THEN
         print *,'Variable manquante dans cas.nc:',name_var(i)
      endif
@@ -581,8 +581,8 @@
   do i=1,nbvar3d
      print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
-     if(i<=35) then
+     IF(i<=35) THEN
         ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
         print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
-        if(ierr/=nf90_noerr) then
+        IF(ierr/=nf90_noerr) THEN
            print *,'Pb a la lecture de cas.nc: ',name_var(i)
            stop "getvarup"
@@ -591,5 +591,5 @@
         print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
         ierr = nf90_get_var(nid,var3didin(i),resul1, count = [1, 1, ntime])
-        if(ierr/=nf90_noerr) then
+        IF(ierr/=nf90_noerr) THEN
            print *,'Pb a la lecture de cas.nc: ',name_var(i)
            stop "getvarup"
@@ -695,5 +695,5 @@
   do i=1,nbvar3d
      ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
-     if(ierr/=nf90_noerr) then
+     IF(ierr/=nf90_noerr) THEN
         print *,'Variable manquante dans cas.nc:',i,name_var(i)
         ierr=nf90_noerr
@@ -701,16 +701,16 @@
      else
         !-----------------------------------------------------------------------
-        if(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
+        IF(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
            ierr = nf90_get_var(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
            print *,'read2_cas(apbp), on a lu ',i,name_var(i)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
            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)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
@@ -720,5 +720,5 @@
            ierr = nf90_get_var(nid,var3didin(i),resul2, count = [1, 1, ntime])
            print *,'read2_cas(resul2), on a lu ',i,name_var(i)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
@@ -728,5 +728,5 @@
            ierr = nf90_get_var(nid,var3didin(i),resul3)
            print *,'read2_cas(resul3), on a lu ',i,name_var(i)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
@@ -870,5 +870,5 @@
   do i=1,nbvar3d
      ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
-     if(ierr/=nf90_noerr) then
+     IF(ierr/=nf90_noerr) THEN
         print *,'Variable manquante dans cas.nc:',i,name_var(i)
         ierr=nf90_noerr
@@ -876,16 +876,16 @@
      else
         !-----------------------------------------------------------------------
-        if(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
+        IF(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
            ierr = nf90_get_var(nid,var3didin(i),apbp)
            print *,'read2_cas(apbp), on a lu ',i,name_var(i)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
            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)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
@@ -893,8 +893,8 @@
            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)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
@@ -905,5 +905,5 @@
            ierr = nf90_get_var(nid,var3didin(i),resul2)
            print *,'read2_cas(resul2), on a lu ',i,name_var(i)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
@@ -914,5 +914,5 @@
            ierr = nf90_get_var(nid,var3didin(i),resul3)
            print *,'read2_cas(resul3), on a lu ',i,name_var(i)
-           if(ierr/=nf90_noerr) then
+           IF(ierr/=nf90_noerr) THEN
               print *,'Pb a la lecture de cas.nc: ',name_var(i)
               stop "getvarup"
@@ -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,6 +1145,6 @@
   !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
-  if (it_cas1 > nt_cas) then
-     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+  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
@@ -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,6 +1361,6 @@
   !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
-  if (it_cas1 > nt_cas) then
-     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+  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
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 5116)
@@ -101,7 +101,7 @@
     ierr = nf90_open(fich_cas,nf90_nowrite,nid)
     PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-    if (ierr/=nf90_noerr) then
-       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
-       write(*,*) nf90_strerror(ierr)
+    if (ierr/=nf90_noerr) THEN
+       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
+       WRITE(*,*) nf90_strerror(ierr)
        stop ""
     endif
@@ -142,5 +142,5 @@
     PRINT*,'LECTURE DU TEMPS'
     ierr=nf90_inq_varid(nid,'time',timeid)
-    if(ierr/=nf90_noerr) then
+    IF(ierr/=nf90_noerr) THEN
        print *,'Variable time manquante dans cas.nc:'
        ierr=nf90_noerr
@@ -148,5 +148,5 @@
        allocate(time_val(nt_cas))
        ierr = nf90_get_var(nid,timeid,time_val)
-       if(ierr/=nf90_noerr) then
+       IF(ierr/=nf90_noerr) THEN
           print *,'A Pb a la lecture de time cas.nc: '
        endif
@@ -413,5 +413,5 @@
 
     ierr=nf90_inq_varid(nid,'ta',int_test)
-    if(ierr/=nf90_noerr) then
+    IF(ierr/=nf90_noerr) THEN
        PRINT*, '++++++++++++++++++++++++++++++'
        PRINT*, 'variable ta missing in cas.nc '
@@ -431,5 +431,5 @@
        ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
        PRINT*, 'name_var(i)', name_var(i), var3didin(i)
-       if(ierr/=nf90_noerr) then
+       IF(ierr/=nf90_noerr) THEN
           print *,'Variable manquante dans cas.nc:',i,name_var(i)
           ierr=nf90_noerr
@@ -453,8 +453,8 @@
           ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)
           !-----------------------------------------------------------------------
-          if(i<=4) then
+          IF(i<=4) THEN
              ierr = nf90_get_var(nid,var3didin(i),apbp)
              print *,'read_SCM(apbp), on a lu ',i,name_var(i)
-             if(ierr/=nf90_noerr) then
+             IF(ierr/=nf90_noerr) THEN
                 print *,'B Pb a la lecture de cas.nc: ',name_var(i)
                 stop "getvarup"
@@ -464,8 +464,8 @@
              !  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)
-             if(ierr/=nf90_noerr) then
+             IF(ierr/=nf90_noerr) THEN
                 print *,'C Pb a la lecture de cas.nc: ',name_var(i)
                 stop "getvarup"
@@ -477,8 +477,8 @@
              !  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)
-             if(ierr/=nf90_noerr) then
+             IF(ierr/=nf90_noerr) THEN
                 print *,'D Pb a la lecture de cas.nc: ',name_var(i)
                 stop "getvarup"
@@ -489,8 +489,8 @@
              !  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)
-             if(ierr/=nf90_noerr) then
+             IF(ierr/=nf90_noerr) THEN
                 print *,'E Pb a la lecture de cas.nc: ',name_var(i)
                 stop "getvarup"
@@ -504,5 +504,5 @@
              ierr = nf90_get_var(nid,var3didin(i),resul3)
              print *,'read_SCM(resul3), on a lu ',i,name_var(i)
-             if(ierr/=nf90_noerr) then
+             IF(ierr/=nf90_noerr) THEN
                 print *,'F Pb a la lecture de cas.nc: ',name_var(i)
                 stop "getvarup"
@@ -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,6 +785,6 @@
     !     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
 
-    if (it_cas1 > nt_cas) then
-       write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+    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
@@ -987,6 +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
@@ -994,8 +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
@@ -1003,9 +1001,9 @@
              enddo
 
-             if (k1==0 .or. k2==0) then
-                write(*,*) 'PB! k1, k2 = ',k1,k2
-                write(*,*) 'l,play(l) = ',l,play(l)/100
+             if (k1==0 .or. k2==0) THEN
+                WRITE(*,*) 'PB! k1, k2 = ',k1,k2
+                WRITE(*,*) 'l,play(l) = ',l,play(l)/100
                 do k = 1, nlev_cas-1
-                   write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
+                   WRITE(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
                 enddo
              endif
@@ -1017,5 +1015,5 @@
              t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
              theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
-             if(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
+             IF(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
              thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
              thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
@@ -1066,5 +1064,5 @@
              t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
              theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)
-             if(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
+             IF(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
              thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)
              thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)
@@ -1163,14 +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
@@ -1178,9 +1174,9 @@
              enddo
 
-             if (k1==0 .or. k2==0) then
-                write(*,*) 'PB! k1, k2 = ',k1,k2
-                write(*,*) 'l,plev(l) = ',l,plev(l)/100
+             if (k1==0 .or. k2==0) THEN
+                WRITE(*,*) 'PB! k1, k2 = ',k1,k2
+                WRITE(*,*) 'l,plev(l) = ',l,plev(l)/100
                 do k = 1, nlev_cas-1
-                   write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
+                   WRITE(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
                 enddo
              endif
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 5116)
@@ -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.
@@ -60,5 +60,5 @@
   230 format(6f9.3,4e11.3)
 
-          return
+          RETURN
           end
 
@@ -95,5 +95,5 @@
   223 format(4i3,f8.2)
 
-          return
+          RETURN
           end
 
@@ -137,5 +137,5 @@
   223 format(4i3,e13.2,f7.2,f7.3,f7.2,f7.3,f7.2)
 
-          return
+          RETURN
           end
 !=====================================================================
@@ -178,127 +178,127 @@
 
       ierr = nf90_open(fich_twpice,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) then
-         write(*,*) 'ERROR: Pb opening forcings cdf file '
-         write(*,*) nf90_strerror(ierr)
+      if (ierr.NE.nf90_noerr) THEN
+         WRITE(*,*) 'ERROR: Pb opening forcings cdf file '
+         WRITE(*,*) nf90_strerror(ierr)
          stop ""
       endif
 
       ierr=nf90_inq_varid(nid,"lat",var3didin(1))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'lat'
          endif
       
        ierr=nf90_inq_varid(nid,"lon",var3didin(2))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'lon'
          endif
 
        ierr=nf90_inq_varid(nid,"alt",var3didin(3))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'alt'
          endif
 
       ierr=nf90_inq_varid(nid,"phis",var3didin(4))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'phis'
          endif
 
       ierr=nf90_inq_varid(nid,"T",var3didin(5))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'T'
          endif
 
       ierr=nf90_inq_varid(nid,"q",var3didin(6))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'q'
          endif
 
       ierr=nf90_inq_varid(nid,"u",var3didin(7))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'u'
          endif
 
       ierr=nf90_inq_varid(nid,"v",var3didin(8))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'v'
          endif
 
       ierr=nf90_inq_varid(nid,"omega",var3didin(9))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'omega'
          endif
 
       ierr=nf90_inq_varid(nid,"div",var3didin(10))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'div'
          endif
 
       ierr=nf90_inq_varid(nid,"T_adv_h",var3didin(11))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'T_adv_h'
          endif
 
       ierr=nf90_inq_varid(nid,"T_adv_v",var3didin(12))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'T_adv_v'
          endif
 
       ierr=nf90_inq_varid(nid,"q_adv_h",var3didin(13))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'q_adv_h'
          endif
 
       ierr=nf90_inq_varid(nid,"q_adv_v",var3didin(14))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'q_adv_v'
          endif
 
       ierr=nf90_inq_varid(nid,"s",var3didin(15))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 's'
          endif
 
       ierr=nf90_inq_varid(nid,"s_adv_h",var3didin(16))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 's_adv_h'
          endif
     
       ierr=nf90_inq_varid(nid,"s_adv_v",var3didin(17))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 's_adv_v'
          endif
 
       ierr=nf90_inq_varid(nid,"p_srf_aver",var3didin(18))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'p_srf_aver'
          endif
 
       ierr=nf90_inq_varid(nid,"p_srf_center",var3didin(19))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'p_srf_center'
          endif
 
       ierr=nf90_inq_varid(nid,"T_srf",var3didin(20))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'T_srf'
          endif
@@ -315,44 +315,44 @@
           
          ierr = nf90_get_var(nid,var3didin(1),lat)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture lat ok',lat
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture lat ok',lat
 
          ierr = nf90_get_var(nid,var3didin(2),lon)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture lon ok',lon
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture lon ok',lon
  
          ierr = nf90_get_var(nid,var3didin(3),alt)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture alt ok',alt
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture alt ok',alt
  
          ierr = nf90_get_var(nid,var3didin(4),phis)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture phis ok',phis
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture phis ok',phis
           
          ierr = nf90_get_var(nid,var3didin(5),T)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture T ok'
 
          ierr = nf90_get_var(nid,var3didin(6),q)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture q ok'
 !q in kg/kg
        do l=1,ntime
@@ -362,23 +362,23 @@
        enddo
          ierr = nf90_get_var(nid,var3didin(7),u)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture u ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture u ok'
 
          ierr = nf90_get_var(nid,var3didin(8),v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture v ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture v ok'
 
          ierr = nf90_get_var(nid,var3didin(9),omega)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture omega ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture omega ok'
 !omega in mb/hour
        do l=1,ntime
@@ -389,16 +389,16 @@
 
          ierr = nf90_get_var(nid,var3didin(10),div)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture div ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture div ok'
 
          ierr = nf90_get_var(nid,var3didin(11),T_adv_h)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T_adv_h ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture T_adv_h ok'
 !T adv in K/s
        do l=1,ntime
@@ -410,9 +410,9 @@
 
          ierr = nf90_get_var(nid,var3didin(12),T_adv_v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T_adv_v ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture T_adv_v ok'
 !T adv in K/s
        do l=1,ntime
@@ -423,9 +423,9 @@
 
          ierr = nf90_get_var(nid,var3didin(13),q_adv_h)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q_adv_h ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture q_adv_h ok'
 !q adv in kg/kg/s
        do l=1,ntime
@@ -437,9 +437,9 @@
 
          ierr = nf90_get_var(nid,var3didin(14),q_adv_v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture q_adv_v ok'
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture q_adv_v ok'
 !q adv in kg/kg/s
        do l=1,ntime
@@ -451,42 +451,42 @@
 
          ierr = nf90_get_var(nid,var3didin(15),s)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(16),s_adv_h)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(17),s_adv_v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(18),p_srf_aver)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(19),p_srf_center)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(20),T_srf)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         write(*,*)'lecture T_srf ok', T_srf
-
-
-         end subroutine read_twpice
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!         WRITE(*,*)'lecture T_srf ok', T_srf
+
+
+         END SUBROUTINE read_twpice
 !=====================================================================
          subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
@@ -509,6 +509,6 @@
          ierr=nf90_inq_dimid(nid,"time",timedimin)
          ierr=nf90_inq_varid(nid,"time",timevar)
-         if (ierr.NE.nf90_noerr) then
-            write(*,*) 'ERROR: Field <time> is missing'
+         if (ierr.NE.nf90_noerr) THEN
+            WRITE(*,*) 'ERROR: Field <time> is missing'
             stop ""  
          endif
@@ -517,14 +517,14 @@
          ierr=nf90_inq_dimid(nid,"lev",levdimin)
          ierr=nf90_inq_varid(nid,"lev",levvar)
-         if (ierr.NE.nf90_noerr) then
-             write(*,*) 'ERROR: Field <lev> is lacking'
+         if (ierr.NE.nf90_noerr) THEN
+             WRITE(*,*) 'ERROR: Field <lev> is lacking'
              stop "" 
          endif
          ierr=nf90_inquire_dimension(nid,levdimin,len=levlen)
 
-         if((timelen/=ttm).or.(levlen/=llm)) then
-            write(*,*) 'ERROR: Not the good lenght for axis'
-            write(*,*) 'longitude: ',timelen,ttm+1
-            write(*,*) 'latitude: ',levlen,llm
+         if((timelen/=ttm).or.(levlen/=llm)) THEN
+            WRITE(*,*) 'ERROR: Not the good lenght for axis'
+            WRITE(*,*) 'longitude: ',timelen,ttm+1
+            WRITE(*,*) 'latitude: ',levlen,llm
             stop ""  
          endif
@@ -533,5 +533,5 @@
          ierr = nf90_get_var(nid,levvar,lev)
 
-       return
+       RETURN
        end
 !=====================================================================
@@ -574,14 +574,12 @@
        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
@@ -589,9 +587,9 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
+         if (k1.eq.0 .or. k2.eq.0) THEN
+          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
+          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
          do k = 1, nlev_sandu-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
          endif
@@ -648,5 +646,5 @@
        enddo
 
-          return
+          RETURN
           end
 !=====================================================================
@@ -689,14 +687,12 @@
        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
@@ -704,9 +700,9 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
+         if (k1.eq.0 .or. k2.eq.0) THEN
+          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
+          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
          do k = 1, nlev_astex-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
          endif
@@ -769,5 +765,5 @@
        enddo
 
-          return
+          RETURN
           end
 
@@ -819,6 +815,6 @@
       do k=1,llm
         do l=1,80
-          if(prico(l)>play(k)) then
-              if(play(k)>prico(l+1)) then
+          IF(prico(l)>play(k)) THEN
+              IF(play(k)>prico(l+1)) THEN
                 zlay(k)=zrico(l)+(play(k)-prico(l)) *                      &
      &              (zrico(l+1)-zrico(l))/(prico(l+1)-prico(l))
@@ -831,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)
@@ -846,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)
@@ -862,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)
@@ -882,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
@@ -893,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)
@@ -903,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)
@@ -915,7 +911,7 @@
         endif
 
-!?        if(play(k)>6e4) then
+!?        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)
@@ -932,5 +928,5 @@
       enddo
 
-          return
+          RETURN
           end
 
@@ -961,10 +957,10 @@
         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'
@@ -974,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
@@ -990,6 +986,6 @@
      &          it_sandu1,it_sandu2,time_sandu1,time_sandu2
 
-       if (it_sandu1 .ge. nt_sandu) then
-        write(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '          &
+       if (it_sandu1 .ge. nt_sandu) THEN
+        WRITE(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '          &
      &        ,day,it_sandu1,it_sandu2,timeit/86400.
         stop
@@ -1008,5 +1004,5 @@
      &it_sandu2,ts_prof
 
-        return
+        RETURN
         END
 !=====================================================================
@@ -1045,5 +1041,5 @@
   223 format(5i3,5f8.3)
 
-          return
+          RETURN
           end
 
@@ -1088,14 +1084,12 @@
        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
@@ -1103,9 +1097,9 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
+         if (k1.eq.0 .or. k2.eq.0) THEN
+          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
+          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
          do k = 1, nlev_toga-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
          endif
@@ -1165,5 +1159,5 @@
 !       enddo
  
-          return
+          RETURN
           end
  
@@ -1216,14 +1210,12 @@
        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
@@ -1231,9 +1223,9 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
+         if (k1.eq.0 .or. k2.eq.0) THEN
+          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
+          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
          do k = 1, nlev_cas-1
-          write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
+          WRITE(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
          enddo
          endif
@@ -1326,5 +1318,5 @@
 !       enddo
  
-          return
+          RETURN
           end
 !***************************************************************************** 
@@ -1366,14 +1358,12 @@
        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
@@ -1381,9 +1371,9 @@
          enddo
 
-         if (k1.eq.0 .or. k2.eq.0) then
-          write(*,*) 'PB! k1, k2 = ',k1,k2
-          write(*,*) 'l,play(l) = ',l,play(l)/100
+         if (k1.eq.0 .or. k2.eq.0) THEN
+          WRITE(*,*) 'PB! k1, k2 = ',k1,k2
+          WRITE(*,*) 'l,play(l) = ',l,play(l)/100
          do k = 1, nlev_dice-1
-          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+          WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
          endif
@@ -1449,5 +1439,5 @@
 !       enddo
  
-          return
+          RETURN
           end
 
@@ -1483,10 +1473,10 @@
 
 ! 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'
@@ -1496,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
@@ -1512,6 +1502,6 @@
      &          it_astex1,it_astex2,time_astex1,time_astex2
 
-       if (it_astex1 .ge. nt_astex) then
-        write(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '          &
+       if (it_astex1 .ge. nt_astex) THEN
+        WRITE(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '          &
      &        ,day,it_astex1,it_astex2,timeit/86400.
         stop
@@ -1540,5 +1530,5 @@
      &it_astex2,div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof 
 
-        return
+        RETURN
         END
 
@@ -1586,17 +1576,17 @@
 
 
-        if (forcing_type.eq.2) then
+        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'
@@ -1604,18 +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'
@@ -1627,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
@@ -1640,6 +1629,6 @@
        time_toga2=(it_toga2-1)*dt_toga
 
-       if (it_toga1 .ge. nt_toga) then
-        write(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '            &
+       if (it_toga1 .ge. nt_toga) THEN
+        WRITE(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '            &
      &        ,day,it_toga1,it_toga2,timeit/86400.
         stop
@@ -1680,5 +1669,5 @@
         enddo
 
-        return
+        RETURN
         END
 
@@ -1727,20 +1716,20 @@
 
 
-        if (forcing_type.eq.7) then
+        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
@@ -1752,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
@@ -1765,6 +1754,6 @@
        time_dice2=(it_dice2-1)*dt_dice
 
-       if (it_dice1 .ge. nt_dice) then
-        write(*,*) 'PB-stop: day, it_dice1, it_dice2, timeit: ',day,it_dice1,it_dice2,timeit/86400.
+       if (it_dice1 .ge. nt_dice) THEN
+        WRITE(*,*) 'PB-stop: day, it_dice1, it_dice2, timeit: ',day,it_dice1,it_dice2,timeit/86400.
         stop
        endif
@@ -1797,5 +1786,5 @@
         enddo
 
-        return
+        RETURN
         END
 
@@ -1836,19 +1825,19 @@
 
 ! 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
@@ -1867,6 +1856,6 @@
        time_gabls42=(it_gabls42-1)*dt_gabls4
 
-       if (it_gabls41 .ge. nt_gabls4) then
-        write(*,*) 'PB-stop: day, it_gabls41, it_gabls42, timeit: ',day,it_gabls41,it_gabls42,timeit/86400.
+       if (it_gabls41 .ge. nt_gabls4) THEN
+        WRITE(*,*) 'PB-stop: day, it_gabls41, it_gabls42, timeit: ',day,it_gabls41,it_gabls42,timeit/86400.
         stop
        endif
@@ -1884,5 +1873,5 @@
         enddo
         tg_prof=tg_gabls4(it_gabls42)-frac*(tg_gabls4(it_gabls42)-tg_gabls4(it_gabls41))
-        return
+        RETURN
         END
 
@@ -1920,5 +1909,5 @@
 
 ! 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'
@@ -1937,6 +1926,6 @@
      &          it_armcu1,it_armcu2,time_armcu1,time_armcu2
 
-       if (it_armcu1 .ge. nt_armcu) then
-        write(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '          &
+       if (it_armcu1 .ge. nt_armcu) THEN
+        WRITE(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '          &
      &        ,day,it_armcu1,it_armcu2,timeit/86400.
         stop
@@ -1963,5 +1952,5 @@
      &it_armcu2,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
 
-        return
+        RETURN
         END
 
@@ -1986,7 +1975,7 @@
 
         integer, parameter :: ilesfile=1
-        integer :: ierr,k,itrac,nt1,nt2
-
-        if(.not.(llesread)) return
+        INTEGER :: ierr,k,itrac,nt1,nt2
+
+        IF(.not.(llesread)) return
 
        open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
@@ -2002,5 +1991,5 @@
         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
@@ -2012,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)
@@ -2021,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
@@ -2039,5 +2028,5 @@
         endif
 
-        return
+        RETURN
         end
 !======================================================================
@@ -2056,7 +2045,7 @@
 
         integer, parameter :: ilesfile=1
-        integer :: k,ierr
-
-        if(.not.(llesread)) return
+        INTEGER :: k,ierr
+
+        IF(.not.(llesread)) return
 
        open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
@@ -2070,5 +2059,5 @@
         close(ilesfile)
 
-        return
+        RETURN
         end
 
@@ -2088,7 +2077,7 @@
 
         integer, parameter :: ilesfile=1
-        integer :: ierr,k
-
-        if(.not.(llesread)) return
+        INTEGER :: ierr,k
+
+        IF(.not.(llesread)) return
 
        open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
@@ -2102,5 +2091,5 @@
         close(ilesfile)
 
-        return
+        RETURN
         end
 
@@ -2123,7 +2112,7 @@
         integer, parameter :: ilesfile=1
         integer, parameter :: ifile=2
-        integer :: ierr,jtot,k
-
-        if(.not.(llesread)) return
+        INTEGER :: ierr,jtot,k
+
+        IF(.not.(llesread)) return
 
 ! Read profiles at full levels
@@ -2159,5 +2148,5 @@
         close(ifile)
 
-        return
+        RETURN
         end
 
@@ -2191,7 +2180,7 @@
 
       ierr = nf90_open(fich_fire,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) then
-         write(*,*) 'ERROR: Pb opening forcings nc file '
-         write(*,*) nf90_strerror(ierr)
+      if (ierr.NE.nf90_noerr) THEN
+         WRITE(*,*) 'ERROR: Pb opening forcings nc file '
+         WRITE(*,*) nf90_strerror(ierr)
          stop ""
       endif
@@ -2199,6 +2188,6 @@
 
        ierr=nf90_inq_varid(nid,"zz",var3didin(1))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'lev'
          endif
@@ -2206,72 +2195,72 @@
 
       ierr=nf90_inq_varid(nid,"thetal",var3didin(2))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'temp'
          endif
 
       ierr=nf90_inq_varid(nid,"qt",var3didin(3))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'qv'
          endif
 
       ierr=nf90_inq_varid(nid,"u",var3didin(4))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'u'
          endif
 
       ierr=nf90_inq_varid(nid,"v",var3didin(5))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'v'
          endif
 
       ierr=nf90_inq_varid(nid,"tke",var3didin(6))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'tke'
          endif
 
       ierr=nf90_inq_varid(nid,"ugeo",var3didin(7))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'ug'
          endif
 
       ierr=nf90_inq_varid(nid,"vgeo",var3didin(8))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'vg'
          endif
       
       ierr=nf90_inq_varid(nid,"wls",var3didin(9))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'wls'
          endif
 
       ierr=nf90_inq_varid(nid,"dqtdx",var3didin(10))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'dqtdx'
          endif
 
       ierr=nf90_inq_varid(nid,"dqtdy",var3didin(11))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'dqtdy'
       endif
 
       ierr=nf90_inq_varid(nid,"dqtdt",var3didin(12))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'dqtdt'
       endif
 
       ierr=nf90_inq_varid(nid,"thl_rad",var3didin(13))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'thl_rad'
       endif
@@ -2280,96 +2269,96 @@
  
          ierr = nf90_get_var(nid,var3didin(1),zz)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture z ok',zz
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture z ok',zz
 
          ierr = nf90_get_var(nid,var3didin(2),thl)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture thl ok',thl
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture thl ok',thl
 
          ierr = nf90_get_var(nid,var3didin(3),qt)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture qt ok',qt
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture qt ok',qt
  
          ierr = nf90_get_var(nid,var3didin(4),u)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture u ok',u
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture u ok',u
 
          ierr = nf90_get_var(nid,var3didin(5),v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture v ok',v
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture v ok',v
 
          ierr = nf90_get_var(nid,var3didin(6),tke)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture tke ok',tke
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture tke ok',tke
 
          ierr = nf90_get_var(nid,var3didin(7),ug)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ug ok',ug
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture ug ok',ug
 
          ierr = nf90_get_var(nid,var3didin(8),vg)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vg ok',vg
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vg ok',vg
 
          ierr = nf90_get_var(nid,var3didin(9),wls)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture wls ok',wls
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture wls ok',wls
 
          ierr = nf90_get_var(nid,var3didin(10),dqtdx)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dqtdx ok',dqtdx
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dqtdx ok',dqtdx
 
          ierr = nf90_get_var(nid,var3didin(11),dqtdy)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dqtdy ok',dqtdy
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dqtdy ok',dqtdy
 
          ierr = nf90_get_var(nid,var3didin(12),dqtdt)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture dqtdt ok',dqtdt
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture dqtdt ok',dqtdt
 
          ierr = nf90_get_var(nid,var3didin(13),thl_rad)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture thl_rad ok',thl_rad
-
-
-         end subroutine read_fire
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture thl_rad ok',thl_rad
+
+
+         END SUBROUTINE read_fire
 !=====================================================================
       subroutine read_dice(fich_dice,nlevel,ntime                         &
@@ -2408,7 +2397,7 @@
       pzero=100000.
       ierr = nf90_open(fich_dice,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) then
-         write(*,*) 'ERROR: Pb opening forcings nc file '
-         write(*,*) nf90_strerror(ierr)
+      if (ierr.NE.nf90_noerr) THEN
+         WRITE(*,*) 'ERROR: Pb opening forcings nc file '
+         WRITE(*,*) nf90_strerror(ierr)
          stop ""
       endif
@@ -2416,132 +2405,132 @@
 
        ierr=nf90_inq_varid(nid,"height",var3didin(1))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'height'
          endif
 
        ierr=nf90_inq_varid(nid,"pf",var3didin(11))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'pf'
          endif
 
       ierr=nf90_inq_varid(nid,"theta",var3didin(12))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'theta'
          endif
 
       ierr=nf90_inq_varid(nid,"qv",var3didin(13))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'qv'
          endif
 
       ierr=nf90_inq_varid(nid,"u",var3didin(14))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'u'
          endif
 
       ierr=nf90_inq_varid(nid,"v",var3didin(15))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'v'
          endif
 
       ierr=nf90_inq_varid(nid,"o3mmr",var3didin(16))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'o3'
          endif
 
       ierr=nf90_inq_varid(nid,"shf",var3didin(2))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'shf'
          endif
 
       ierr=nf90_inq_varid(nid,"lhf",var3didin(3))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'lhf'
          endif
       
       ierr=nf90_inq_varid(nid,"lwup",var3didin(4))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'lwup'
          endif
 
       ierr=nf90_inq_varid(nid,"swup",var3didin(5))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'dqtdx'
          endif
 
       ierr=nf90_inq_varid(nid,"Tg",var3didin(6))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'Tg'
       endif
 
       ierr=nf90_inq_varid(nid,"ustar",var3didin(7))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'ustar'
       endif
 
       ierr=nf90_inq_varid(nid,"psurf",var3didin(8))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'psurf'
       endif
 
       ierr=nf90_inq_varid(nid,"Ug",var3didin(9))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'Ug'
       endif
 
       ierr=nf90_inq_varid(nid,"Vg",var3didin(10))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'Vg'
       endif
 
       ierr=nf90_inq_varid(nid,"hadvT",var3didin(17))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hadvT'
       endif
 
       ierr=nf90_inq_varid(nid,"hadvq",var3didin(18))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hadvq'
       endif
 
       ierr=nf90_inq_varid(nid,"hadvu",var3didin(19))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hadvu'
       endif
 
       ierr=nf90_inq_varid(nid,"hadvv",var3didin(20))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hadvv'
       endif
 
       ierr=nf90_inq_varid(nid,"w",var3didin(21))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'w'
       endif
 
       ierr=nf90_inq_varid(nid,"omega",var3didin(22))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'omega'
       endif
@@ -2550,23 +2539,23 @@
  
          ierr = nf90_get_var(nid,var3didin(1),zz)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture zz ok',zz
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture zz ok',zz
  
          ierr = nf90_get_var(nid,var3didin(11),pres)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture pres ok',pres
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture pres ok',pres
 
          ierr = nf90_get_var(nid,var3didin(12),th)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture th ok',th
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture th ok',th
            do k=1,nlevel
              t(k)=th(k)*(pres(k)/pzero)**rkappa
@@ -2574,138 +2563,138 @@
 
          ierr = nf90_get_var(nid,var3didin(13),qv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture qv ok',qv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture qv ok',qv
  
          ierr = nf90_get_var(nid,var3didin(14),u)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture u ok',u
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture u ok',u
 
          ierr = nf90_get_var(nid,var3didin(15),v)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture v ok',v
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture v ok',v
 
          ierr = nf90_get_var(nid,var3didin(16),o3)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture o3 ok',o3
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture o3 ok',o3
 
          ierr = nf90_get_var(nid,var3didin(2),shf)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture shf ok',shf
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture shf ok',shf
 
          ierr = nf90_get_var(nid,var3didin(3),lhf)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture lhf ok',lhf
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture lhf ok',lhf
 
          ierr = nf90_get_var(nid,var3didin(4),lwup)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture lwup ok',lwup
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture lwup ok',lwup
 
          ierr = nf90_get_var(nid,var3didin(5),swup)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture swup ok',swup
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture swup ok',swup
 
          ierr = nf90_get_var(nid,var3didin(6),tg)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture tg ok',tg
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture tg ok',tg
 
          ierr = nf90_get_var(nid,var3didin(7),ustar)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ustar ok',ustar
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture ustar ok',ustar
 
          ierr = nf90_get_var(nid,var3didin(8),psurf)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture psurf ok',psurf
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture psurf ok',psurf
 
          ierr = nf90_get_var(nid,var3didin(9),ug)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture ug ok',ug
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture ug ok',ug
 
          ierr = nf90_get_var(nid,var3didin(10),vg)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture vg ok',vg
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture vg ok',vg
 
          ierr = nf90_get_var(nid,var3didin(17),hadvt)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvt ok',hadvt
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hadvt ok',hadvt
 
          ierr = nf90_get_var(nid,var3didin(18),hadvq)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvq ok',hadvq
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hadvq ok',hadvq
 
          ierr = nf90_get_var(nid,var3didin(19),hadvu)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvu ok',hadvu
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hadvu ok',hadvu
 
          ierr = nf90_get_var(nid,var3didin(20),hadvv)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture hadvv ok',hadvv
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture hadvv ok',hadvv
 
          ierr = nf90_get_var(nid,var3didin(21),w)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture w ok',w
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture w ok',w
 
          ierr = nf90_get_var(nid,var3didin(22),omega)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          write(*,*)'lecture omega ok',omega
-
-
-         end subroutine read_dice
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
+            stop "getvarup"
+         endif
+!          WRITE(*,*)'lecture omega ok',omega
+
+
+         END SUBROUTINE read_dice
 !=====================================================================
       subroutine read_gabls4(fich_gabls4,nlevel,ntime,nsol                    &
@@ -2744,7 +2733,7 @@
 
       ierr = nf90_open(fich_gabls4,nf90_nowrite,nid)
-      if (ierr.NE.nf90_noerr) then
-         write(*,*) 'ERROR: Pb opening forcings nc file '
-         write(*,*) nf90_strerror(ierr)
+      if (ierr.NE.nf90_noerr) THEN
+         WRITE(*,*) 'ERROR: Pb opening forcings nc file '
+         WRITE(*,*) nf90_strerror(ierr)
          stop ""
       endif
@@ -2752,89 +2741,89 @@
 
        ierr=nf90_inq_varid(nid,"height",var3didin(1))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'height'
          endif
 
       ierr=nf90_inq_varid(nid,"depth_sn",var3didin(2))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'depth_sn'
       endif
 
       ierr=nf90_inq_varid(nid,"Ug",var3didin(3))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'Ug'
       endif
 
       ierr=nf90_inq_varid(nid,"Vg",var3didin(4))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'Vg'
       endif
        ierr=nf90_inq_varid(nid,"pf",var3didin(5))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'pf'
          endif
 
       ierr=nf90_inq_varid(nid,"theta",var3didin(6))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'theta'
          endif
 
       ierr=nf90_inq_varid(nid,"tempe",var3didin(7))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'tempe'
          endif
 
       ierr=nf90_inq_varid(nid,"qv",var3didin(8))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'qv'
          endif
 
       ierr=nf90_inq_varid(nid,"u",var3didin(9))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'u'
          endif
 
       ierr=nf90_inq_varid(nid,"v",var3didin(10))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'v'
          endif
 
       ierr=nf90_inq_varid(nid,"hadvT",var3didin(11))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hadvt'
          endif
 
       ierr=nf90_inq_varid(nid,"hadvQ",var3didin(12))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'hadvq'
       endif
 
       ierr=nf90_inq_varid(nid,"Tsnow",var3didin(14))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'tsnow'
       endif
 
       ierr=nf90_inq_varid(nid,"snow_density",var3didin(15))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'snow_density'
       endif
 
       ierr=nf90_inq_varid(nid,"Tg",var3didin(16))
-         if(ierr/=nf90_noerr) then
-           write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+           WRITE(*,*) nf90_strerror(ierr)
            stop 'Tg'
       endif
@@ -2845,90 +2834,90 @@
  
          ierr = nf90_get_var(nid,var3didin(1),zz_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(2),depth_sn)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(3),ug_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(4),vg_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(5),pf_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(6),th_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(7),t_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(8),qv_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(9),u_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(10),v_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(11),hadvt_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(12),hadvq_i)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(14),tsnow)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
  
          ierr = nf90_get_var(nid,var3didin(15),snow_dens)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
 
          ierr = nf90_get_var(nid,var3didin(16),tg)
-         if(ierr/=nf90_noerr) then
-            write(*,*) nf90_strerror(ierr)
+         IF(ierr/=nf90_noerr) THEN
+            WRITE(*,*) nf90_strerror(ierr)
             stop "getvarup"
          endif
@@ -2950,5 +2939,5 @@
          enddo
 
- end subroutine read_gabls4
+ END SUBROUTINE read_gabls4
 !=====================================================================
 
@@ -3056,5 +3045,5 @@
  
 
-      end subroutine read_circ
+      END SUBROUTINE read_circ
 !=====================================================================
 !     Reads RTMIP input files      
@@ -3093,4 +3082,4 @@
  
 
-      end subroutine read_rtmip
+      END SUBROUTINE read_rtmip
 !=====================================================================
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 5116)
@@ -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,6 +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,                          &
@@ -22,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
@@ -47,7 +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=',     &
@@ -93,7 +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
@@ -194,7 +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
@@ -236,6 +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=',     &
@@ -282,7 +277,7 @@
 !wind nudging above 500m with a 2h time scale
         do l=1,llm
-        if (nudge_wind) then
-!           if (phi(l).gt.5000.) then
-        if (phi(l).gt.0.) then
+        if (nudge_wind) THEN
+!           if (phi(l).gt.5000.) 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.)
@@ -295,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.)
@@ -314,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)
@@ -333,6 +328,5 @@
 !---------------------------------------------------------------------
 
-       if (forcing_amma) then
-
+       if (forcing_amma) THEN
         PRINT*,                                                             &
      & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',     &
@@ -358,5 +352,5 @@
        enddo
 ! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
+!      WRITE(*,*)'avant interp vert', t_proftwp
       CALL interp_toga_vertical(play,nlev_amma,plev_amma                      &
      &         ,th_profamma,q_profamma,u_profamma,v_profamma                 &
@@ -365,5 +359,5 @@
      &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
      &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-       write(*,*) 'Profil initial forcing AMMA interpole'
+       WRITE(*,*) 'Profil initial forcing AMMA interpole'
 
 
@@ -416,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)
@@ -430,6 +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=',    &
@@ -486,6 +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=',    &
@@ -546,5 +538,5 @@
 ! et une divergence constante -> profil de omega
       tsurf = ts_prof
-      write(*,*) 'SST suivante: ',tsurf
+      WRITE(*,*) 'SST suivante: ',tsurf
       do l = 1, llm
        omega(l) = omega_mod(l)
@@ -568,6 +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=',    &
@@ -628,5 +619,5 @@
 ! la divergence,ug,vg,ufa,vfa
       tsurf = ts_prof
-      write(*,*) 'SST suivante: ',tsurf
+      WRITE(*,*) 'SST suivante: ',tsurf
       do l = 1, llm
        omega(l) = w_mod(l)
@@ -651,6 +642,5 @@
 ! Interpolation forcing standard case
 !---------------------------------------------------------------------
-      if (forcing_case) then
-
+      if (forcing_case) THEN
          PRINT*,'FORCING CASE forcing_case'
 
@@ -724,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)
@@ -734,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)
@@ -744,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)
@@ -755,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)
@@ -772,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)
@@ -824,6 +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*,                                                             &
@@ -915,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) 
@@ -922,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)
@@ -932,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)
@@ -942,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)
@@ -953,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)
@@ -971,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
@@ -985,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 5116)
@@ -12,7 +12,6 @@
 
       if (forcing_les .or. forcing_radconv                                      &
-     &    .or. forcing_GCSSold .or. forcing_fire) then
-
-      if (forcing_fire) then
+     &    .or. forcing_GCSSold .or. forcing_fire) THEN
+      if (forcing_fire) THEN
 !----------------------------------------------------------------------
 !read fire forcings from fire.nc
@@ -23,5 +22,5 @@
      &     ,ugprof,vgprof,wfls,dqtdxls                                          &
      &     ,dqtdyls,dqtdtls,thlpcar)
-      write(*,*) 'Forcing FIRE lu'
+      WRITE(*,*) 'Forcing FIRE lu'
       kmax=120            ! nombre de niveaux dans les profils et forcages
       else 
@@ -78,6 +77,6 @@
           print *,'k l height(k) height(k-1) zlay(l) frac=',k,l,height(k),height(k-1),zlay(l),frac
           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(l==1) PRINT*,'k, height, tttprof',k,height(k),tttprof(k)
+          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
@@ -122,16 +121,16 @@
         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(zlay(l-1)>height(kmax)) then
+        if (l>1) THEN
+        IF(zlay(l-1)>height(kmax)) THEN
            omega(l)=0.0
            omega2(l)=0.0
         endif   
         endif
-        if(q(l,1)<0.) q(l,1)=0.0
+        IF(q(l,1)<0.) q(l,1)=0.0
         q(l,2)  = 0.0
       enddo
@@ -142,5 +141,5 @@
 ! Forcing for GCSSold:
 !---------------------------------------------------------------------
-      if (forcing_GCSSold) then
+      if (forcing_GCSSold) THEN
        fich_gcssold_ctl = './forcing.ctl'
        fich_gcssold_dat = './forcing8.dat'
@@ -158,6 +157,5 @@
 ! Forcing for RICO:
 !---------------------------------------------------------------------
-      if (forcing_rico) then
-
+      if (forcing_rico) THEN
 !       CALL writefield_phy('omega', omega,llm+1)
       fich_rico = 'rico.txt'
@@ -187,6 +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'
@@ -195,8 +192,8 @@
      &         ,ht_toga,vt_toga,hq_toga,vq_toga)
 
-       write(*,*) 'Forcing TOGA lu'
+       WRITE(*,*) 'Forcing TOGA lu'
 
 ! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+      WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
       CALL interp_toga_time(daytime,day1,annee_ref                          &
      &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
@@ -212,9 +209,9 @@
      &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
      &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-       write(*,*) 'Profil initial forcing TOGA interpole'
+       WRITE(*,*) 'Profil initial forcing TOGA interpole'
 
 ! initial and boundary conditions :
       tsurf = ts_prof
-      write(*,*) 'SST initiale: ',tsurf
+      WRITE(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod(l)
@@ -239,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'
@@ -246,7 +243,7 @@
      &     ,ht_twpi,vt_twpi,hq_twpi,vq_twpi)
 
-      write(*,*) 'Forcing TWP-ICE lu'
+      WRITE(*,*) 'Forcing TWP-ICE lu'
 !Time interpolation for initial conditions using TOGA interpolation routine
-         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+         WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1
       CALL interp_toga_time(daytime,day1,annee_ref                          &
      &          ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi    &
@@ -258,5 +255,5 @@
 
 ! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
+!      WRITE(*,*)'avant interp vert', t_proftwp
       CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
      &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
@@ -264,9 +261,9 @@
      &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
      &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
+!       WRITE(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
 
 ! initial and boundary conditions :
 !      tsurf = ts_proftwp
-      write(*,*) 'SST initiale: ',tsurf
+      WRITE(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod(l)
@@ -293,9 +290,8 @@
 !---------------------------------------------------------------------
 
-      if (forcing_amma) then
-
+      if (forcing_amma) THEN
       CALL read_1D_cases
 
-      write(*,*) 'Forcing AMMA lu'
+      WRITE(*,*) 'Forcing AMMA lu'
 
 !champs initiaux:
@@ -315,5 +311,5 @@
       rho(:)=0.
 ! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
+!      WRITE(*,*)'avant interp vert', t_proftwp
       CALL interp_toga_vertical(play,nlev_amma,plev_amma                    &
      &         ,th_ammai,q_ammai,u_ammai,v_ammai,vitw_ammai                 &
@@ -321,9 +317,9 @@
      &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
      &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
-!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
+!       WRITE(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
 
 ! initial and boundary conditions :
 !      tsurf = ts_proftwp
-      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
       do l = 1, llm
 ! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
@@ -349,5 +345,5 @@
        dt_cooling(l)=0.
       enddo     
-       write(*,*) 'Prof initeforcing AMMA interpole temp39',temp(39)
+       WRITE(*,*) 'Prof initeforcing AMMA interpole temp39',temp(39)
       
 
@@ -364,5 +360,5 @@
 !---------------------------------------------------------------------
 
-      if (forcing_dice) then
+      if (forcing_dice) THEN
 !read DICE forcings
       fich_dice='dice_driver.nc'
@@ -373,5 +369,5 @@
      &     ,hu_dice,hv_dice,w_dice,omega_dice)
 
-      write(*,*) 'Forcing DICE lu'
+      WRITE(*,*) 'Forcing DICE lu'
 
 !champs initiaux:
@@ -393,5 +389,5 @@
       rho(:)=0.
 ! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
+!      WRITE(*,*)'avant interp vert', t_proftwp
 
 !     CALL interp_dice_time(daytime,day1,annee_ref
@@ -415,5 +411,5 @@
 !     omega_mod(:,:)=0.
 
-!       write(*,*) 'Profil initial forcing DICE interpole',t_mod
+!       WRITE(*,*) 'Profil initial forcing DICE interpole',t_mod
 ! Les forcages DICE sont donnes /jour et non /seconde !
       ht_mod(:)=ht_mod(:)/86400.
@@ -423,5 +419,5 @@
 
 ! initial and boundary conditions :
-      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
       do l = 1, llm
 ! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
@@ -450,5 +446,5 @@
        dt_cooling(l)=0.
       enddo     
-       write(*,*) 'Profil initial forcing DICE interpole temp39',temp(39)
+       WRITE(*,*) 'Profil initial forcing DICE interpole temp39',temp(39)
       
 
@@ -479,5 +475,5 @@
 !!!! Si la temperature de surface n'est pas impos??e:
   
-      if (forcing_gabls4) then
+      if (forcing_gabls4) THEN
 !read GABLS4 forcings
       
@@ -488,5 +484,5 @@
      & ,plev_gabls4,th_gabls4,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,ht_gabls4,hq_gabls4,tg_gabls4,tsnow_gabls4,snow_dens_gabls4)
 
-      write(*,*) 'Forcing GABLS4 lu'
+      WRITE(*,*) 'Forcing GABLS4 lu'
 
 !champs initiaux:
@@ -507,5 +503,5 @@
       rho(:)=0.
 ! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_proftwp
+!      WRITE(*,*)'avant interp vert', t_proftwp
 
 !     CALL interp_dice_time(daytime,day1,annee_ref
@@ -530,5 +526,5 @@
 
 ! initial and boundary conditions :
-      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
       do l = 1, llm
 ! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
@@ -590,12 +586,12 @@
 !---------------------------------------------------------------------
 
-      if (forcing_armcu) then
+      if (forcing_armcu) THEN
 ! read armcu forcing :
-       write(*,*) 'Avant lecture Forcing Arm_Cu'
+       WRITE(*,*) 'Avant lecture Forcing Arm_Cu'
       fich_armcu = './ifa_armcu.txt'
       CALL read_armcu(fich_armcu,nlev_armcu,nt_armcu,                       &
      & sens_armcu,flat_armcu,adv_theta_armcu,                               &
      & rad_theta_armcu,adv_qt_armcu)
-       write(*,*) 'Forcing Arm_Cu lu'
+       WRITE(*,*) 'Forcing Arm_Cu lu'
 
 !----------------------------------------------------------------------
@@ -615,5 +611,5 @@
 
 ! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+      WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
 
       print *,'Avant interp_armcu_time'
@@ -631,5 +627,5 @@
      &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
      &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
-       write(*,*) 'Forcages interpoles dans temps'
+       WRITE(*,*) 'Forcages interpoles dans temps'
 
 ! No vertical interpolation if nlev imposed to 19 or 40
@@ -640,5 +636,5 @@
 !     tsurf = ts_prof
 ! tsurf read in lmdz1d.def
-      write(*,*) 'Tsurf initiale: ',tsurf
+      WRITE(*,*) 'Tsurf initiale: ',tsurf
       do l = 1, llm
        play(l)=play_mod(l)*100.
@@ -689,6 +685,6 @@
 !---------------------------------------------------------------------
 
-      if (forcing_sandu) then
-       write(*,*) 'Avant lecture Forcing SANDU'
+      if (forcing_sandu) THEN
+       WRITE(*,*) 'Avant lecture Forcing SANDU'
 
 ! read sanduref forcing :
@@ -696,5 +692,5 @@
       CALL read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
 
-       write(*,*) 'Forcing SANDU lu'
+       WRITE(*,*) 'Forcing SANDU lu'
 
 !----------------------------------------------------------------------
@@ -707,5 +703,5 @@
 
 ! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+      WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
 ! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
 ! revoir 1DUTILS.h et les arguments
@@ -732,9 +728,9 @@
      &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
      &         ,omega_mod,o3mmr_mod,mxcalc)
-       write(*,*) 'Profil initial forcing SANDU interpole'
+       WRITE(*,*) 'Profil initial forcing SANDU interpole'
 
 ! initial and boundary conditions :
       tsurf = ts_prof
-      write(*,*) 'SST initiale: ',tsurf
+      WRITE(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod(l)
@@ -763,6 +759,6 @@
 !---------------------------------------------------------------------
 
-      if (forcing_astex) then
-       write(*,*) 'Avant lecture Forcing Astex'
+      if (forcing_astex) THEN
+       WRITE(*,*) 'Avant lecture Forcing Astex'
 
 ! read astex forcing :
@@ -771,5 +767,5 @@
      &  ug_astex,vg_astex,ufa_astex,vfa_astex)
 
-       write(*,*) 'Forcing Astex lu'
+       WRITE(*,*) 'Forcing Astex lu'
 
 !----------------------------------------------------------------------
@@ -782,5 +778,5 @@
 
 ! time interpolation for initial conditions:
-      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+      WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
 ! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
 ! revoir 1DUTILS.h et les arguments
@@ -808,9 +804,9 @@
      &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
      &         ,tke_mod,o3mmr_mod,mxcalc)
-       write(*,*) 'Profil initial forcing Astex interpole'
+       WRITE(*,*) 'Profil initial forcing Astex interpole'
 
 ! initial and boundary conditions :
       tsurf = ts_prof
-      write(*,*) 'SST initiale: ',tsurf
+      WRITE(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod(l)
@@ -839,12 +835,11 @@
 !---------------------------------------------------------------------
 
-      if (forcing_case) then
-
-         write(*,*) 'avant CALL read_1D_cas'
+      if (forcing_case) THEN
+         WRITE(*,*) 'avant CALL read_1D_cas'
          CALL read_1D_cas
-         write(*,*) 'Forcing read'
+         WRITE(*,*) 'Forcing read'
 
 !Time interpolation for initial conditions using TOGA interpolation routine
-         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+         WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1
       CALL interp_case_time(day,day1,annee_ref                                                              &
 !    &         ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                                         &
@@ -862,5 +857,5 @@
 
 ! vertical interpolation using TOGA interpolation routine:
-!      write(*,*)'avant interp vert', t_prof
+!      WRITE(*,*)'avant interp vert', t_prof
       CALL interp_case_vertical(play,nlev_cas,plev_prof_cas            &
      &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas    &
@@ -870,5 +865,5 @@
      &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
      &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
-!       write(*,*) 'Profil initial forcing case interpole',t_mod
+!       WRITE(*,*) 'Profil initial forcing case interpole',t_mod
 
 ! initial and boundary conditions :
@@ -877,5 +872,5 @@
       tg= ts_prof_cas 
       psurf=plev_prof_cas(1)
-      write(*,*) 'SST initiale: ',tsurf
+      WRITE(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod_cas(l)
@@ -914,12 +909,11 @@
 !---------------------------------------------------------------------
 
-      if (forcing_case2) then
-
-         write(*,*) 'avant CALL read2_1D_cas'
+      if (forcing_case2) THEN
+         WRITE(*,*) 'avant CALL read2_1D_cas'
          CALL read2_1D_cas
-         write(*,*) 'Forcing read'
+         WRITE(*,*) 'Forcing read'
 
 !Time interpolation for initial conditions using interpolation routine
-         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+         WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1
         CALL interp2_case_time(daytime,day1,annee_ref                                       &
 !    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
@@ -945,5 +939,5 @@
 
 ! vertical interpolation using interpolation routine:
-!      write(*,*)'avant interp vert', t_prof
+!      WRITE(*,*)'avant interp vert', t_prof
       CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
@@ -960,5 +954,5 @@
      &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
 
-!       write(*,*) 'Profil initial forcing case interpole',t_mod
+!       WRITE(*,*) 'Profil initial forcing case interpole',t_mod
 
 ! initial and boundary conditions :
@@ -967,5 +961,5 @@
       tg = ts_prof_cas 
       psurf=plev_prof_cas(1)
-      write(*,*) 'SST initiale: ',tsurf
+      WRITE(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod_cas(l)
@@ -1013,12 +1007,11 @@
 !---------------------------------------------------------------------
 
-      if (forcing_SCM) then
-
-         write(*,*) 'avant CALL old_read_SCM_cas'
+      if (forcing_SCM) THEN
+         WRITE(*,*) 'avant CALL old_read_SCM_cas'
          CALL old_read_SCM_cas
-         write(*,*) 'Forcing read' 
+         WRITE(*,*) 'Forcing read'
 
 !Time interpolation for initial conditions using interpolation routine
-         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+         WRITE(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1
         CALL interp2_case_time(daytime,day1,annee_ref                                       &
 !    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
@@ -1044,5 +1037,5 @@
 
 ! vertical interpolation using interpolation routine:
-!      write(*,*)'avant interp vert', t_prof
+!      WRITE(*,*)'avant interp vert', t_prof
       CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
      &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
@@ -1059,5 +1052,5 @@
      &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
 
-!       write(*,*) 'Profil initial forcing case interpole',t_mod
+!       WRITE(*,*) 'Profil initial forcing case interpole',t_mod
 
 ! initial and boundary conditions :
@@ -1067,5 +1060,5 @@
       tg = ts_prof_cas 
       psurf=plev_prof_cas(1)
-      write(*,*) 'SST initiale: ',tsurf
+      WRITE(*,*) 'SST initiale: ',tsurf
       do l = 1, llm
        temp(l) = t_mod_cas(l)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90	(revision 5116)
@@ -5,5 +5,5 @@
 USE comvert_mod, ONLY: presnivs
 USE comvert_mod, ONLY:  preff, pa
-USE ioipsl, only: getin
+USE ioipsl, ONLY: getin
 
 
@@ -13,8 +13,8 @@
       INCLUDE "dimensions.h"
 
-real :: airefi
-real :: zcufi    = 1.
-real :: zcvfi    = 1.
-real :: rlat_rad(1),rlon_rad(1)
+REAL :: airefi
+REAL :: zcufi    = 1.
+REAL :: zcvfi    = 1.
+REAL :: rlat_rad(1),rlon_rad(1)
 
 integer ntime
@@ -103,19 +103,19 @@
 !         ierr    = severity of situation ( = 0 normal )
  
-      character(len=*) modname
+      CHARACTER(LEN=*) modname
       integer ierr
-      character(len=*) message
+      CHARACTER(LEN=*) message
  
-      write(*,*) 'in abort_gcm'
+      WRITE(*,*) 'in abort_gcm'
       CALL histclo
-      write(*,*) 'out of histclo'
-      write(*,*) 'Stopping in ', modname
-      write(*,*) 'Reason = ',message
+      WRITE(*,*) 'out of histclo'
+      WRITE(*,*) 'Stopping in ', modname
+      WRITE(*,*) 'Reason = ',message
       CALL getin_dump
 
-      if (ierr == 0) then
-        write(*,*) 'Everything is cool'
+      if (ierr == 0) THEN
+        WRITE(*,*) 'Everything is cool'
       else
-        write(*,*) 'Houston, we have a problem ', ierr
+        WRITE(*,*) 'Houston, we have a problem ', ierr
       endif
       STOP
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/ecumev6_flux.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/ecumev6_flux.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ecumev6_flux.F90	(revision 5116)
@@ -253,21 +253,21 @@
 !----------------------- Modif Olive calcul de PRHOA ---------------------------
 
-!write(*,*) "PZ0SEA ",PZ0SEA
-!write(*,*) "PTA ",PTA
-!write(*,*) "PSST ",PSST
-!write(*,*) "PQA ",PQA
-!write(*,*) "PVMOD ",PVMOD
-!write(*,*) "PZREF ",PZREF
-!write(*,*) "PUREF ",PUREF
-!write(*,*) "PPS ",PPS
-!write(*,*) "PPA ",PPA
-!write(*,*) "OPRECIP ",OPRECIP
-!write(*,*) "PZ0HSEA ",PZ0HSEA
-!write(*,*) "PRAIN ",PRAIN
+!WRITE(*,*) "PZ0SEA ",PZ0SEA
+!WRITE(*,*) "PTA ",PTA
+!WRITE(*,*) "PSST ",PSST
+!WRITE(*,*) "PQA ",PQA
+!WRITE(*,*) "PVMOD ",PVMOD
+!WRITE(*,*) "PZREF ",PZREF
+!WRITE(*,*) "PUREF ",PUREF
+!WRITE(*,*) "PPS ",PPS
+!WRITE(*,*) "PPA ",PPA
+!WRITE(*,*) "OPRECIP ",OPRECIP
+!WRITE(*,*) "PZ0HSEA ",PZ0HSEA
+!WRITE(*,*) "PRAIN ",PRAIN
 
 
 PRHOA(:) = PPS(:) / (287.1 * PTA(:) * (1.+.61*PQA(:)))
-!write(*,*) "klon klon ",klon,PTA
-!write(*,*) "PRHOA ",SIZE(PRHOA),PRHOA
+!WRITE(*,*) "klon klon ",klon,PTA
+!WRITE(*,*) "PRHOA ",SIZE(PRHOA),PRHOA
 
 PREF = 100900.                    ! = 1000 hPa
@@ -358,5 +358,5 @@
 ZVMOD = MAX(PVMOD , 0.1 * MIN(10.,PUREF) )    !set a minimum value to wind
 
-write(*,*) "ZVMOD ",SIZE(ZVMOD)
+WRITE(*,*) "ZVMOD ",SIZE(ZVMOD)
 
 !       2.0. Radiative fluxes - For warm layer & cool skin
@@ -386,14 +386,14 @@
 ZWORK2A    = XRD/XRV
 
-!write(*,*) "ZFOES ",ZFOES
-!write(*,*) "PPS ",PPS
-!write(*,*) "ZWORK1 ",ZWORK1
-!write(*,*) "XRD ",XRD
-!write(*,*) "XRV ",XRV
-!write(*,*) "PPA ",PPA
-!write(*,*) "ZWORK1A ",ZWORK1A
-
-write(*,*) "PQSAT : ",PQSAT
-write(*,*) "PQSATA : ",PQSATA
+!WRITE(*,*) "ZFOES ",ZFOES
+!WRITE(*,*) "PPS ",PPS
+!WRITE(*,*) "ZWORK1 ",ZWORK1
+!WRITE(*,*) "XRD ",XRD
+!WRITE(*,*) "XRV ",XRV
+!WRITE(*,*) "PPA ",PPA
+!WRITE(*,*) "ZWORK1A ",ZWORK1A
+
+WRITE(*,*) "PQSAT : ",PQSAT
+WRITE(*,*) "PQSATA : ",PQSATA
 
 !*       2.    COMPUTE SATURATION HUMIDITY
@@ -410,7 +410,7 @@
 ZDQ(:) = PQA(:)-PQSATA(:)
 
-write(*,*) "PQA ",PQA(:)
-write(*,*) "PQSAT",PQSAT(:)
-write(*,*) "ZDQ",ZDQ(:)
+WRITE(*,*) "PQA ",PQA(:)
+WRITE(*,*) "PQSAT",PQSAT(:)
+WRITE(*,*) "ZDQ",ZDQ(:)
 
 !       2.3. Latent heat of vaporisation
@@ -421,6 +421,6 @@
 
 
-write(*,*) "ZLVA ",ZLVA
-write(*,*) "ZLVS ",ZLVS
+WRITE(*,*) "ZLVA ",ZLVA
+WRITE(*,*) "ZLVS ",ZLVS
 
 
@@ -450,7 +450,7 @@
 ZDDQ(:) = SIGN(MAX(ABS(ZDDQ(:)),10.0*ZDQSR0),ZDDQ(:))
 
-write(*,*) "ZDDU ",ZDDU
-write(*,*) "ZDDQ ",ZDDQ
-write(*,*) "ZDDT ",ZDDT
+WRITE(*,*) "ZDDU ",ZDDU
+WRITE(*,*) "ZDDQ ",ZDDQ
+WRITE(*,*) "ZDDT ",ZDDT
 
 JCV (:) = -1
@@ -624,7 +624,7 @@
   ZEF(JLON)  = -PRHOA(JLON)*ZLVS(JLON)*ZUSR(JLON)*ZQSR(JLON)
 
-  write(*,*) "ZTAU = ",ZTAU(JLON)
-  write(*,*) "SENS = ",ZHF(JLON)
-  write(*,*) "LAT = ",ZEF(JLON)
+  WRITE(*,*) "ZTAU = ",ZTAU(JLON)
+  WRITE(*,*) "SENS = ",ZHF(JLON)
+  WRITE(*,*) "LAT = ",ZEF(JLON)
 
 !       4.2. Exchange coefficients PCD, PCH, PCE
@@ -634,7 +634,7 @@
   PCE(JLON) = (ZUSR(JLON)*ZQSR(JLON))/(ZDDU(JLON)*ZDDQ(JLON))
 
-  write(*,*) "ZUSR = ",ZUSR(JLON)
-  write(*,*) "ZTSR = ",ZTSR(JLON)
-  write(*,*) "ZQSR = ",ZQSR(JLON)
+  WRITE(*,*) "ZUSR = ",ZUSR(JLON)
+  WRITE(*,*) "ZTSR = ",ZTSR(JLON)
+  WRITE(*,*) "ZQSR = ",ZQSR(JLON)
 
 !       4.3. Stochastic perturbation of turbulent fluxes
@@ -753,9 +753,9 @@
 !ENDIF
 
-write(*,*) "JLON ",JLON
-write(*,*) "PTA ",klon,PTA
-write(*,*) "PCD ",SIZE(PCD),PCD
-write(*,*) "PCQ ",SIZE(PCE),PCE
-write(*,*) "PCH ",SIZE(PCH),PCH
+WRITE(*,*) "JLON ",JLON
+WRITE(*,*) "PTA ",klon,PTA
+WRITE(*,*) "PCD ",SIZE(PCD),PCD
+WRITE(*,*) "PCQ ",SIZE(PCE),PCE
+WRITE(*,*) "PCH ",SIZE(PCH),PCH
 
 coeffs = [PCD,&
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5116)
@@ -73,5 +73,5 @@
    DO k = 1, klev
    DO i = 1, klon
-     IF (fl_cor_ebil > 0) then
+     IF (fl_cor_ebil > 0) THEN
        ZRCPD = RCPD*(1.0+RVTMP2*(pqn(i,k)+pqln(i,k)+pqsn(i,k)))
      ELSE
@@ -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/flott_gwd_rando_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/flott_gwd_rando_m.F90	(revision 5116)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h	(revision 5116)
@@ -9,9 +9,9 @@
 
 
-      real :: fsens
-      real :: flat
-      real :: betaevap
-      real :: ust
-      real :: tg
+      REAL :: fsens
+      REAL :: flat
+      REAL :: betaevap
+      REAL :: ust
+      REAL :: tg
 
       common /flux_arp/fsens,flat,betaevap,ust,tg,ok_flux_surf,ok_prescr_ust,ok_prescr_beta,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/fonte_neige_mod.F90	(revision 5116)
@@ -507,10 +507,10 @@
                                 ,xtrun_off_lic_0(iso_eau,i) &
                                 ,'fonte_neige 413') &
-        == 1) then
+        == 1) THEN
           WRITE(*,*) 'i=',i
           STOP
         ENDIF
       ENDDO !DO i=1,klon
-    ENDIF !IF (iso_eau > 0) then 
+    ENDIF !IF (iso_eau > 0) THEN
 #endif    
 #endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5116)
@@ -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,17 +96,17 @@
       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)
-          elseif (ifl_pbltree==2) then
+          elseif (ifl_pbltree==2) THEN
       drag_pro(i,k)= drag_pro(i,k)+ &
       6*LAI(i,jv)*veget(i,jv)*( yzlay(i,k)*(height(i,jv)-yzlay(i,k))/(height(i,jv)*height(i,jv)+ 0.01))
-          elseif (ifl_pbltree==3) then
+          elseif (ifl_pbltree==3) THEN
       drag_pro(i,k)= drag_pro(i,k)+ &
       veget(i,jv)*( yzlay(i,k)*(height(i,jv)-yzlay(i,k))/(height(i,jv)*height(i,jv)+ 0.01))
-          elseif (ifl_pbltree==0) then
+          elseif (ifl_pbltree==0) THEN
           drag_pro(i,k)=0.0
            endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/geo2atm.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/geo2atm.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/geo2atm.F90	(revision 5116)
@@ -5,5 +5,5 @@
   USE dimphy
   USE lmdz_phys_para
-  USE lmdz_grid_phy, only: grid_type, unstructured, regular_lonlat
+  USE lmdz_grid_phy, ONLY: grid_type, unstructured, regular_lonlat
   USE lmdz_abort_physic, ONLY: abort_physic
   IMPLICIT NONE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/global_mean.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/global_mean.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/global_mean.F90	(revision 5116)
@@ -6,7 +6,7 @@
 
   USE dimphy
-  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_para, ONLY: is_sequential
+  USE lmdz_phys_transfert_para, ONLY: reduce_sum
+  use lmdz_phys_mpi_data, ONLY: is_mpi_root
   USE ioipsl
   IMPLICIT NONE
@@ -20,6 +20,5 @@
   INTEGER :: i
 
-  if (is_sequential) then
-
+  if (is_sequential) THEN
    airetot = 0.
    sumtmp = 0.
@@ -29,5 +28,5 @@
    END DO
    if (laire) THEN
-    if(airetot/=0.) THEN
+    IF(airetot/=0.) THEN
      mfield=sumtmp/airetot
     endif
@@ -45,5 +44,5 @@
   if (laire) THEN
 !  PRINT*,'gmean airetot=',airetot
-   if(airetot/=0.) THEN
+   IF(airetot/=0.) THEN
     mfield=sumtmp/airetot
 !  else
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/grid_index.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/grid_index.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/grid_index.F90	(revision 5116)
@@ -9,13 +9,13 @@
 IMPLICIT NONE
 real, intent(in) :: lon_deg,lat_deg
-integer :: grid_index
+INTEGER :: grid_index
 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
    endif
 END DO
-return
+RETURN
 end
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm2l.F90	(revision 5116)
@@ -524,5 +524,5 @@
     DO i = 1, knon
       IF (check(i) .OR. omegafl(i)) THEN
-        ! CC         if (pplay(i,k) .le. plcl(i)) then
+        ! CC         if (pplay(i,k) .le. plcl(i)) THEN
         zm(i) = z(i, k-1)
         zp(i) = z(i, k)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/hbtm_mod.F90	(revision 5116)
@@ -640,5 +640,5 @@
              zmzp = 0.5*(zm(i)+zp(i))
              ! debug
-             ! if (i.EQ.1864) then
+             ! if (i.EQ.1864) THEN
              ! PRINT*,'i,pblh(1864),obklen(1864)',i,pblh(i),obklen(i)
              ! endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90	(revision 5116)
@@ -1609,5 +1609,5 @@
   END IF
 
-  ! If integral is negative (which in principal should not happen) then
+  ! If integral is negative (which in principal should not happen) THEN
   ! print a message and some info since execution will abort when calculating
   ! the variances.
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_bilKP_ave.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_bilKP_ave.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_bilKP_ave.h	(revision 5116)
@@ -20,6 +20,6 @@
          ENDDO
 cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-cym         write(*,*)'zx_lon = ',zx_lon(:,1)
-cym         write(*,*)'zx_lat = ',zx_lat(1,:)
+cym         WRITE(*,*)'zx_lon = ',zx_lon(:,1)
+cym         WRITE(*,*)'zx_lat = ',zx_lat(1,:)
 cym         CALL histbeg("histbilKP_ave", iim,zx_lon(:,1), jjmp1,
 cym     .                zx_lat(1,:),
@@ -29,5 +29,5 @@
      .                nhori, nid_bilKPave)
 
-         write(*,*)'Journee ', itau_phy, zjulian
+         WRITE(*,*)'Journee ', itau_phy, zjulian
          CALL histvert(nid_bilKPave, "presnivs",
      .                "Vertical levels","mb",
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_bilKP_ins.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_bilKP_ins.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_bilKP_ins.h	(revision 5116)
@@ -20,6 +20,6 @@
          ENDDO
 cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
-cym         write(*,*)'zx_lon = ',zx_lon(:,1)
-cym         write(*,*)'zx_lat = ',zx_lat(1,:)
+cym         WRITE(*,*)'zx_lon = ',zx_lon(:,1)
+cym         WRITE(*,*)'zx_lat = ',zx_lat(1,:)
 c
 cIM 280405 BEG
@@ -31,10 +31,10 @@
           jmax_ins=jjmp1
 cym          do i=1,iim-1
-cym             if(zx_lon(i,1).lt.lonmin_ins) imin_ins=i
-cym             if(zx_lon(i,1).le.lonmax_ins) imax_ins=i+1
+cym             IF(zx_lon(i,1).lt.lonmin_ins) imin_ins=i
+cym             IF(zx_lon(i,1).le.lonmax_ins) imax_ins=i+1
 cym          enddo
 cym          do j=1,jjmp1
-cym             if(zx_lat(1,j).ge.latmin_ins) jmax_ins=j
-cym             if(zx_lat(1,j).gt.latmax_ins) jmin_ins=j
+cym             IF(zx_lat(1,j).ge.latmin_ins) jmax_ins=j
+cym             IF(zx_lat(1,j).gt.latmax_ins) jmin_ins=j
 cym          enddo
 c
@@ -70,5 +70,5 @@
 cIM 280405 END
 c
-         write(*,*)'Journee ', itau_phy, zjulian
+         WRITE(*,*)'Journee ', itau_phy, zjulian
          CALL histvert(nid_bilKPins, "presnivs",
      .                "Vertical levels","mb",
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_histREGDYN.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_histREGDYN.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ini_histREGDYN.h	(revision 5116)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/iniradia.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/iniradia.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/iniradia.F90	(revision 5116)
@@ -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 '
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/init_be.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/init_be.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/init_be.F90	(revision 5116)
@@ -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
@@ -280,5 +280,5 @@
 !!  END IF ! fin de 19 niveaux verticaux
 !!
-!!!!!!  IF (klev .ge. 39) then
+!!!!!!  IF (klev .ge. 39) THEN
      DO k = 1,klev
         DO i = 1,klon
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/inlandsis.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/inlandsis.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/inlandsis.f90	(revision 5116)
@@ -186,5 +186,5 @@
   logical :: BloMod
   logical :: debut
-  integer :: jjtime
+  INTEGER :: jjtime
 
 
@@ -195,14 +195,14 @@
   ! ---------
 
-  real :: TBr_sv(klonv)                 ! Brightness Temperature
-  real :: IRdwsv(klonv)                 ! DOWNward   IR Flux
-  real :: IRupsv(klonv)                 ! UPward     IR Flux
-  real :: d_Bufs,Bufs_N                 ! Buffer Snow Layer Increment
-  real :: Buf_ro,Bros_N                 ! Buffer Snow Layer Density
-  real :: BufPro                        ! Buffer Snow Layer Density
-  real :: Buf_G1,BG1__N                 ! Buffer Snow Layer Dendr/Sphe[-]
-  real :: Buf_G2,BG2__N                 ! Buffer Snow Layer Spher/Size[-]
-  real :: Bdzssv(klonv)                 ! Buffer Snow Layer Thickness
-  real :: z_snsv(klonv)                 ! Snow-Ice, current Thickness
+  REAL :: TBr_sv(klonv)                 ! Brightness Temperature
+  REAL :: IRdwsv(klonv)                 ! DOWNward   IR Flux
+  REAL :: IRupsv(klonv)                 ! UPward     IR Flux
+  REAL :: d_Bufs,Bufs_N                 ! Buffer Snow Layer Increment
+  REAL :: Buf_ro,Bros_N                 ! Buffer Snow Layer Density
+  REAL :: BufPro                        ! Buffer Snow Layer Density
+  REAL :: Buf_G1,BG1__N                 ! Buffer Snow Layer Dendr/Sphe[-]
+  REAL :: Buf_G2,BG2__N                 ! Buffer Snow Layer Spher/Size[-]
+  REAL :: Bdzssv(klonv)                 ! Buffer Snow Layer Thickness
+  REAL :: z_snsv(klonv)                 ! Snow-Ice, current Thickness
 
 
@@ -211,100 +211,100 @@
   ! -----
 
-  integer :: iwr
-  integer :: ikl   ,isn   ,isl   ,ist      !
-  integer :: ist__s,ist__w                 ! Soil/Water Body Identifier
-  integer :: growth                        ! Seasonal               Mask
-  integer :: LISmsk                        ! Land+Ice / Open    Sea Mask
-  integer :: LSnMsk                        ! Snow-Ice / No Snow-Ice Mask
-  integer :: IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
-  integer :: SnoMsk                        ! Snow     / No Snow     Mask
-  real :: roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
-  real :: Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
-  real :: Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
-  real :: Polair                        ! Polar  Snow Switch
-  real :: PorSno,Salt_f,PorRef   !
+  INTEGER :: iwr
+  INTEGER :: ikl   ,isn   ,isl   ,ist      !
+  INTEGER :: ist__s,ist__w                 ! Soil/Water Body Identifier
+  INTEGER :: growth                        ! Seasonal               Mask
+  INTEGER :: LISmsk                        ! Land+Ice / Open    Sea Mask
+  INTEGER :: LSnMsk                        ! Snow-Ice / No Snow-Ice Mask
+  INTEGER :: IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
+  INTEGER :: SnoMsk                        ! Snow     / No Snow     Mask
+  REAL :: roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
+  REAL :: Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
+  REAL :: Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
+  REAL :: Polair                        ! Polar  Snow Switch
+  REAL :: PorSno,Salt_f,PorRef   !
   ! #sw real      PorVol,rWater                 !
   ! #sw real      rusNEW,rdzNEW,etaNEW          !
-  real :: ro_new                        !
-  real :: TaPole                        ! Maximum     Polar Temperature
-  real :: T__Min                        ! Minimum realistic Temperature
-  real :: EmiSol                        ! Emissivity of       Soil
-  real :: EmiSno                        ! Emissivity of            Snow
-  real :: EmiWat                        ! Emissivity of a Water Area
-  real :: vk2                           ! Square of Von Karman Constant
-  real :: u2star                        !(u*)**2
-  real :: Z0mLnd                        !          Land Roughness Length
+  REAL :: ro_new                        !
+  REAL :: TaPole                        ! Maximum     Polar Temperature
+  REAL :: T__Min                        ! Minimum realistic Temperature
+  REAL :: EmiSol                        ! Emissivity of       Soil
+  REAL :: EmiSno                        ! Emissivity of            Snow
+  REAL :: EmiWat                        ! Emissivity of a Water Area
+  REAL :: vk2                           ! Square of Von Karman Constant
+  REAL :: u2star                        !(u*)**2
+  REAL :: Z0mLnd                        !          Land Roughness Length
   ! #ZN real      sqrrZ0                        ! u*t/u*
-  real :: f_eff                         ! Marticorena & B. 1995 JGR (20)
-  real :: A_Fact                        ! Fundamental * Roughness
-  real :: Z0m_nu                        ! Smooth R Snow Roughness Length
-  real :: Z0mBSn                        !         BSnow Roughness Length
-  real :: Z0mBS0                        ! Mimimum BSnow Roughness Length
-  real :: Z0m_S0                        ! Mimimum  Snow Roughness Length
-  real :: Z0m_S1                        ! Maximum  Snow Roughness Length
+  REAL :: f_eff                         ! Marticorena & B. 1995 JGR (20)
+  REAL :: A_Fact                        ! Fundamental * Roughness
+  REAL :: Z0m_nu                        ! Smooth R Snow Roughness Length
+  REAL :: Z0mBSn                        !         BSnow Roughness Length
+  REAL :: Z0mBS0                        ! Mimimum BSnow Roughness Length
+  REAL :: Z0m_S0                        ! Mimimum  Snow Roughness Length
+  REAL :: Z0m_S1                        ! Maximum  Snow Roughness Length
   ! #SZ real      Z0Sa_N                        ! Regime   Snow Roughness Length
   ! #SZ real      Z0SaSi                        ! 1.IF Rgm Snow Roughness Length
   ! #GL real      Z0_GIM                        ! Mimimum GIMEX Roughness Length
-  real :: Z0_ICE                        ! Ice ISW   Roughness Length
-  real :: Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
-  real :: SnoWat                        ! Snow Layer    Switch
-  real :: rstar,alors                   !
-  real :: rstar0,rstar1,rstar2          !
-  real :: SameOK                        ! 1. => Same Type of Grains
-  real :: G1same                        ! Averaged G1,  same Grains
-  real :: G2same                        ! Averaged G2,  same Grains
-  real :: typ__1                        ! 1. => Lay1 Type: Dendritic
-  real :: zroNEW                        ! dz X ro, if fresh Snow
-  real :: G1_NEW                        ! G1,      if fresh Snow
-  real :: G2_NEW                        ! G2,      if fresh Snow
-  real :: zroOLD                        ! dz X ro, if old   Snow
-  real :: G1_OLD                        ! G1,      if old   Snow
-  real :: G2_OLD                        ! G2,      if old   Snow
-  real :: SizNEW                        ! Size,    if fresh Snow
-  real :: SphNEW                        ! Spheric.,if fresh Snow
-  real :: SizOLD                        ! Size,    if old   Snow
-  real :: SphOLD                        ! Spheric.,if old   Snow
-  real :: Siz_av                        ! Averaged    Grain Size
-  real :: Sph_av                        ! Averaged    Grain Spher.
-  real :: Den_av                        ! Averaged    Grain Dendr.
-  real :: G1diff                        ! Averaged G1, diff. Grains
-  real :: G2diff                        ! Averaged G2, diff. Grains
-  real :: G1                            ! Averaged G1
-  real :: G2                            ! Averaged G2
-  real :: param                         ! Polynomial   fit z0=f(T)
-  real :: Z0_obs                        ! Fit Z0_obs=f(T) (m)
-  real :: tamin                         ! min T of linear fit (K)
-  real :: tamax                         ! max T of linear fit (K)
-  real :: coefa,coefb,coefc,coefd       ! Coefs for z0=f(T)
-  real :: ta1,ta2,ta3                   ! Air temperature thresholds
-  real :: z01,z02,z03                   ! z0 thresholds
-  real :: tt_c,vv_c                     ! Critical param.
-  real :: tt_tmp,vv_tmp,vv_virt         ! Temporary variables
-  real :: e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
-  real :: zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
+  REAL :: Z0_ICE                        ! Ice ISW   Roughness Length
+  REAL :: Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
+  REAL :: SnoWat                        ! Snow Layer    Switch
+  REAL :: rstar,alors                   !
+  REAL :: rstar0,rstar1,rstar2          !
+  REAL :: SameOK                        ! 1. => Same Type of Grains
+  REAL :: G1same                        ! Averaged G1,  same Grains
+  REAL :: G2same                        ! Averaged G2,  same Grains
+  REAL :: typ__1                        ! 1. => Lay1 Type: Dendritic
+  REAL :: zroNEW                        ! dz X ro, if fresh Snow
+  REAL :: G1_NEW                        ! G1,      if fresh Snow
+  REAL :: G2_NEW                        ! G2,      if fresh Snow
+  REAL :: zroOLD                        ! dz X ro, if old   Snow
+  REAL :: G1_OLD                        ! G1,      if old   Snow
+  REAL :: G2_OLD                        ! G2,      if old   Snow
+  REAL :: SizNEW                        ! Size,    if fresh Snow
+  REAL :: SphNEW                        ! Spheric.,if fresh Snow
+  REAL :: SizOLD                        ! Size,    if old   Snow
+  REAL :: SphOLD                        ! Spheric.,if old   Snow
+  REAL :: Siz_av                        ! Averaged    Grain Size
+  REAL :: Sph_av                        ! Averaged    Grain Spher.
+  REAL :: Den_av                        ! Averaged    Grain Dendr.
+  REAL :: G1diff                        ! Averaged G1, diff. Grains
+  REAL :: G2diff                        ! Averaged G2, diff. Grains
+  REAL :: G1                            ! Averaged G1
+  REAL :: G2                            ! Averaged G2
+  REAL :: param                         ! Polynomial   fit z0=f(T)
+  REAL :: Z0_obs                        ! Fit Z0_obs=f(T) (m)
+  REAL :: tamin                         ! min T of linear fit (K)
+  REAL :: tamax                         ! max T of linear fit (K)
+  REAL :: coefa,coefb,coefc,coefd       ! Coefs for z0=f(T)
+  REAL :: ta1,ta2,ta3                   ! Air temperature thresholds
+  REAL :: z01,z02,z03                   ! z0 thresholds
+  REAL :: tt_c,vv_c                     ! Critical param.
+  REAL :: tt_tmp,vv_tmp,vv_virt         ! Temporary variables
+  REAL :: e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
+  REAL :: zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
   ! for Aeolian erosion and blowing snow
-  integer :: nit   ,iit
-  real :: Fac                           ! Correc. factor for drift ratio
-  real :: dusuth,signus
-  real :: sss__F,sss__N
-  real :: sss__K,sss__G
-  real :: us_127,us_227,us_327,us_427,us_527
-  real :: VVa_OK, usuth0
-  real :: ssstar
-  real :: SblPom
-  real :: rCd10n                        ! Square root of drag coefficient
-  real :: DendOK                        ! Dendricity Switch
-  real :: SaltOK                        ! Saltation  Switch
-  real :: MeltOK                        ! Saltation  Switch (Melting Snow)
-  real :: SnowOK                        ! Pack Top   Switch
-  real :: SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
-  real :: ShearX, ShearS                ! Arg. Max Shear Stress
-  real :: Por_BS                        ! Snow Porosity
-  real :: Salt_us                       ! New thresh.friction velocity u*t
-  real :: Fac_Mo,ArguSi,FacRho          ! Numerical factors for u*t
-  real :: SaltSI(klonv,0:nsno)          ! Snow Drift Index              !
-  real :: MIN_Mo                        ! Minimum Mobility Fresh Fallen *
-  character(len=3) :: qsalt_param              ! Switch for saltation flux param.
-  character(len=3) :: usth_param               ! Switch for u*t param
+  INTEGER :: nit   ,iit
+  REAL :: Fac                           ! Correc. factor for drift ratio
+  REAL :: dusuth,signus
+  REAL :: sss__F,sss__N
+  REAL :: sss__K,sss__G
+  REAL :: us_127,us_227,us_327,us_427,us_527
+  REAL :: VVa_OK, usuth0
+  REAL :: ssstar
+  REAL :: SblPom
+  REAL :: rCd10n                        ! Square root of drag coefficient
+  REAL :: DendOK                        ! Dendricity Switch
+  REAL :: SaltOK                        ! Saltation  Switch
+  REAL :: MeltOK                        ! Saltation  Switch (Melting Snow)
+  REAL :: SnowOK                        ! Pack Top   Switch
+  REAL :: SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
+  REAL :: ShearX, ShearS                ! Arg. Max Shear Stress
+  REAL :: Por_BS                        ! Snow Porosity
+  REAL :: Salt_us                       ! New thresh.friction velocity u*t
+  REAL :: Fac_Mo,ArguSi,FacRho          ! Numerical factors for u*t
+  REAL :: SaltSI(klonv,0:nsno)          ! Snow Drift Index              !
+  REAL :: MIN_Mo                        ! Minimum Mobility Fresh Fallen *
+  CHARACTER(LEN=3) :: qsalt_param              ! Switch for saltation flux param.
+  CHARACTER(LEN=3) :: usth_param               ! Switch for u*t param
 
 
@@ -409,9 +409,9 @@
     IF (BloMod) THEN
 
-    if (klonv==1) then
-      if(isnoSV(1)>=2                   .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
+            eta_SV(1,max(1,isnoSV(1)))<epsi) THEN
   ! +                       **********
                  CALL SISVAT_BSn
@@ -508,5 +508,5 @@
   ! +--Threshold Friction Velocity
   ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      if(ro__SV(ikl,isn)>300.) then
+      IF(ro__SV(ikl,isn)>300.) THEN
          Por_BS      =  1.000       - ro__SV(ikl,isn)     /ro_Ice
       else
@@ -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
@@ -526,5 +526,5 @@
 
       if (usth_param == "lis") then !Liston et al. 2007
-        if(ro__SV(ikl,isn)>300.) then
+        IF(ro__SV(ikl,isn)>300.) THEN
           Salt_us   = 0.005*exp(0.013*ro__SV(ikl,isn))
         else
@@ -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,7 +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
@@ -1081,6 +1080,5 @@
 
 
-  if (iflag_temp_inlandsis == 0) then
-
+  if (iflag_temp_inlandsis == 0) THEN
    CALL SISVAT_TSo
 
@@ -1205,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.)
@@ -1236,6 +1234,6 @@
   IF (SnoMod)                                                 THEN
 
-  if (discret_xf .AND. klonv==1) then
-  if(isnoSV(1)>=1) then
+  if (discret_xf .AND. klonv==1) THEN
+  IF(isnoSV(1)>=1) THEN
   ! +          **********
   CALL SISVAT_GSn
@@ -1336,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)
@@ -1472,7 +1470,6 @@
   !XF    MAR is then too warm and not enough melt
 
-     if(ro__SV(ikl,isnoSV(ikl))>50 &
-           .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)then
-
+     IF(ro__SV(ikl,isnoSV(ikl))>50 &
+           .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)THEN
          Z0hnSV(ikl) = max(zero &
                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)) &
@@ -1497,14 +1494,14 @@
 
 
-end subroutine inlandsis
-
-
-
-
-
-
-
-
-
-
-
+END SUBROUTINE inlandsis
+
+
+
+
+
+
+
+
+
+
+
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_bsn.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_bsn.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_bsn.f90	(revision 5116)
@@ -33,12 +33,12 @@
 
 
-  integer :: ikl   ,isn
-  real :: h_mmWE                        ! Eroded Snow Layer Min Thickness
-  real :: dbsaux(knonv)                 ! Drift Amount   (Dummy Variable)
-  real :: dzweqo,dzweqn,bsno_x          ! Conversion variables for erosion
-  real :: dz_new,rho_new
-  real :: snofOK                        ! Threshd Snow Fall
-  real :: Fac                           ! Correction factor for erosion
-  real :: densif                        ! Densification rate if erosion
+  INTEGER :: ikl   ,isn
+  REAL :: h_mmWE                        ! Eroded Snow Layer Min Thickness
+  REAL :: dbsaux(knonv)                 ! Drift Amount   (Dummy Variable)
+  REAL :: dzweqo,dzweqn,bsno_x          ! Conversion variables for erosion
+  REAL :: dz_new,rho_new
+  REAL :: snofOK                        ! Threshd Snow Fall
+  REAL :: Fac                           ! Correction factor for erosion
+  REAL :: densif                        ! Densification rate if erosion
 
   ! +--DATA
@@ -73,6 +73,5 @@
     if((dzweqo-dzweqn)>0                    .and. &
           dzsnSV(ikl,isn)>0                    .and. &
-          ro__SV(ikl,max(1,isnoSV(ikl)))<roBdSV) then
-
+          ro__SV(ikl,max(1,isnoSV(ikl)))<roBdSV) THEN
     !characteristic time scale for drifting snow compaction set to 24h
     !linear densification rate [kg/m3/s] over 24h
@@ -84,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
@@ -94,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_gsn.f90	(revision 5116)
@@ -184,5 +184,5 @@
   ! +  ------
 
-  integer :: dt__SV2
+  INTEGER :: dt__SV2
 
 
@@ -191,97 +191,97 @@
 
   logical :: vector                        !
-  integer :: ikl                           !
-  integer :: isn   ,isnp                   !
-  integer :: istoOK                        !
-  real :: G1_bak,G2_bak                 ! Old Values of G1, G2
-  real :: ro_dry(knonv,      nsno)      ! Dry Density            [g/cm3]
-  real :: etaSno(knonv,      nsno)      ! Liquid Water Content   [g/cm2]
-  real :: SnMass(knonv)                 ! Snow   Mass            [kg/m2]
-  real :: dTsndz                        ! Temperature Gradient
-  real :: sWater                        !        Water Content       [%]
-  real :: exp1Wa                        !
-  real :: dDENDR                        ! Dendricity Increment
-  real :: DENDRn                        ! Normalized Dendricity
-  real :: SPHERn                        ! Normalized Sphericity
-  real :: Wet_OK                        ! Wet Metamorphism Switch
-  real :: OK__DE                        !
-  real :: OK__wd                        ! New G*, from wet Dendritic
-  real :: G1__wd                        ! New G1, from wet Dendritic
-  real :: G2__wd                        ! New G2, from wet Dendritic
-  real :: OKlowT                        !
-  real :: facVap                        !
-  real :: OK_ldd                        !
-  real :: G1_ldd                        !
-  real :: G2_ldd                        !
-  real :: DiamGx                        !
-  real :: DiamOK                        !
-  real :: No_Big                        !
-  real :: dSPHER                        !
-  real :: SPHER0                        !
-  real :: SPHbig                        !
-  real :: G1_lds                        !
-  real :: OK_mdT                        !
-  real :: OKmidT                        !
-  real :: OKhigT                        !
-  real :: OK_mdd                        !
-  real :: G1_mdd                        !
-  real :: G2_mdd                        !
-  real :: G1_mds                        !
-  real :: OK_hdd                        !
-  real :: G1_hdd                        !
-  real :: G2_hdd                        !
-  real :: OK_hds                        !
-  real :: G1_hds                        !
-  real :: T1__OK,T2__OK                 !
-  real :: T3_xOK,T3__OK,T3_nOK          !
-  real :: ro1_OK,ro2_OK                 !
-  real :: dT1_OK,dT2_OK,dT3xOK,dT3_OK   !
-  real :: dT4xOK,dT4_OK,dT4nOK,AngSno   !
-  real :: G2_hds,SphrOK,HISupd          !
-  real :: H1a_OK,H1b_OK,H1__OK          !
-  real :: H23aOK,H23bOK,H23_OK          !
-  real :: H2__OK,H3__OK                 !
-  real :: H45_OK,H4__OK,H5__OK          !
-  real :: ViscSn,OK_Liq,OK_Ang,OKxLiq   !
-  real :: dSnMas,dzsnew,rosnew,rosmax,smb_old,smb_new
-  real :: zn_old,zn_new
-
-  real :: epsi5                         ! Alpha ev67 single precision	
-  real :: vdiam1                        ! Small Grains Min.Diam.[.0001m]
-  real :: vdiam2                        ! Spher.Variat.Max Diam.    [mm]
-  real :: vdiam3                        ! Min.Diam.|Limit Spher.    [mm]
-  real :: vdiam4                        ! Min.Diam.|Viscosity Change
-  real :: vsphe1                        ! Max Sphericity
-  real :: vsphe2                        ! Low T Metamorphism  Coeff.
-  real :: vsphe3                        ! Max.Sphericity (history=1)
-  real :: vsphe4                        ! Min.Sphericity=>history=1
-  real :: vtang1,vtang2,vtang3,vtang4   ! Temperature Contribution
-  real :: vtang5,vtang6,vtang7,vtang8   !
-  real :: vtang9,vtanga,vtangb,vtangc   !
-  real :: vrang1,vrang2                 ! Density     Contribution
-  real :: vgang1,vgang2,vgang3,vgang4   ! Grad(T)     Contribution
-  real :: vgang5,vgang6,vgang7,vgang8   !
-  real :: vgang9,vganga,vgangb,vgangc   !
-  real :: vgran6                        ! Max.Sphericity for Settling
-  real :: vtelv1                        ! Threshold | history = 2, 3
-  real :: vvap1                        ! Vapor Pressure Coefficient
-  real :: vvap2                        ! Vapor Pressure Exponent
-  real :: vgrat1                        ! Boundary weak/mid   grad(T)
-  real :: vgrat2                        ! Boundary mid/strong grad(T)
-  real :: vfi                        ! PHI,         strong grad(T)
-  real :: vvisc1,vvisc2,vvisc3,vvisc4   ! Viscosity Coefficients
-  real :: vvisc5,vvisc6,vvisc7          ! id., wet Snow
-  real :: rovisc                        ! Wet Snow Density  Influence
-  real :: vdz3                        ! Maximum Layer Densification
-  real :: OK__ws                        ! New G2
-  real :: G1__ws                        ! New G1, from wet Spheric
-  real :: G2__ws                        ! New G2, from wet Spheric
-  real :: husi_0,husi_1,husi_2,husi_3   ! Constants for New G2
-  real :: vtail1,vtail2                 ! Constants for New G2
-  real :: frac_j                        ! Time Step            [Day]
-
-  real :: vdent1                       ! Wet Snow Metamorphism
-  integer :: nvdent1                       ! (Coefficients for
-  integer :: nvdent2                       !           Dendricity)
+  INTEGER :: ikl                           !
+  INTEGER :: isn   ,isnp                   !
+  INTEGER :: istoOK                        !
+  REAL :: G1_bak,G2_bak                 ! Old Values of G1, G2
+  REAL :: ro_dry(knonv,      nsno)      ! Dry Density            [g/cm3]
+  REAL :: etaSno(knonv,      nsno)      ! Liquid Water Content   [g/cm2]
+  REAL :: SnMass(knonv)                 ! Snow   Mass            [kg/m2]
+  REAL :: dTsndz                        ! Temperature Gradient
+  REAL :: sWater                        !        Water Content       [%]
+  REAL :: exp1Wa                        !
+  REAL :: dDENDR                        ! Dendricity Increment
+  REAL :: DENDRn                        ! Normalized Dendricity
+  REAL :: SPHERn                        ! Normalized Sphericity
+  REAL :: Wet_OK                        ! Wet Metamorphism Switch
+  REAL :: OK__DE                        !
+  REAL :: OK__wd                        ! New G*, from wet Dendritic
+  REAL :: G1__wd                        ! New G1, from wet Dendritic
+  REAL :: G2__wd                        ! New G2, from wet Dendritic
+  REAL :: OKlowT                        !
+  REAL :: facVap                        !
+  REAL :: OK_ldd                        !
+  REAL :: G1_ldd                        !
+  REAL :: G2_ldd                        !
+  REAL :: DiamGx                        !
+  REAL :: DiamOK                        !
+  REAL :: No_Big                        !
+  REAL :: dSPHER                        !
+  REAL :: SPHER0                        !
+  REAL :: SPHbig                        !
+  REAL :: G1_lds                        !
+  REAL :: OK_mdT                        !
+  REAL :: OKmidT                        !
+  REAL :: OKhigT                        !
+  REAL :: OK_mdd                        !
+  REAL :: G1_mdd                        !
+  REAL :: G2_mdd                        !
+  REAL :: G1_mds                        !
+  REAL :: OK_hdd                        !
+  REAL :: G1_hdd                        !
+  REAL :: G2_hdd                        !
+  REAL :: OK_hds                        !
+  REAL :: G1_hds                        !
+  REAL :: T1__OK,T2__OK                 !
+  REAL :: T3_xOK,T3__OK,T3_nOK          !
+  REAL :: ro1_OK,ro2_OK                 !
+  REAL :: dT1_OK,dT2_OK,dT3xOK,dT3_OK   !
+  REAL :: dT4xOK,dT4_OK,dT4nOK,AngSno   !
+  REAL :: G2_hds,SphrOK,HISupd          !
+  REAL :: H1a_OK,H1b_OK,H1__OK          !
+  REAL :: H23aOK,H23bOK,H23_OK          !
+  REAL :: H2__OK,H3__OK                 !
+  REAL :: H45_OK,H4__OK,H5__OK          !
+  REAL :: ViscSn,OK_Liq,OK_Ang,OKxLiq   !
+  REAL :: dSnMas,dzsnew,rosnew,rosmax,smb_old,smb_new
+  REAL :: zn_old,zn_new
+
+  REAL :: epsi5                         ! Alpha ev67 single precision
+  REAL :: vdiam1                        ! Small Grains Min.Diam.[.0001m]
+  REAL :: vdiam2                        ! Spher.Variat.Max Diam.    [mm]
+  REAL :: vdiam3                        ! Min.Diam.|Limit Spher.    [mm]
+  REAL :: vdiam4                        ! Min.Diam.|Viscosity Change
+  REAL :: vsphe1                        ! Max Sphericity
+  REAL :: vsphe2                        ! Low T Metamorphism  Coeff.
+  REAL :: vsphe3                        ! Max.Sphericity (history=1)
+  REAL :: vsphe4                        ! Min.Sphericity=>history=1
+  REAL :: vtang1,vtang2,vtang3,vtang4   ! Temperature Contribution
+  REAL :: vtang5,vtang6,vtang7,vtang8   !
+  REAL :: vtang9,vtanga,vtangb,vtangc   !
+  REAL :: vrang1,vrang2                 ! Density     Contribution
+  REAL :: vgang1,vgang2,vgang3,vgang4   ! Grad(T)     Contribution
+  REAL :: vgang5,vgang6,vgang7,vgang8   !
+  REAL :: vgang9,vganga,vgangb,vgangc   !
+  REAL :: vgran6                        ! Max.Sphericity for Settling
+  REAL :: vtelv1                        ! Threshold | history = 2, 3
+  REAL :: vvap1                        ! Vapor Pressure Coefficient
+  REAL :: vvap2                        ! Vapor Pressure Exponent
+  REAL :: vgrat1                        ! Boundary weak/mid   grad(T)
+  REAL :: vgrat2                        ! Boundary mid/strong grad(T)
+  REAL :: vfi                        ! PHI,         strong grad(T)
+  REAL :: vvisc1,vvisc2,vvisc3,vvisc4   ! Viscosity Coefficients
+  REAL :: vvisc5,vvisc6,vvisc7          ! id., wet Snow
+  REAL :: rovisc                        ! Wet Snow Density  Influence
+  REAL :: vdz3                        ! Maximum Layer Densification
+  REAL :: OK__ws                        ! New G2
+  REAL :: G1__ws                        ! New G1, from wet Spheric
+  REAL :: G2__ws                        ! New G2, from wet Spheric
+  REAL :: husi_0,husi_1,husi_2,husi_3   ! Constants for New G2
+  REAL :: vtail1,vtail2                 ! Constants for New G2
+  REAL :: frac_j                        ! Time Step            [Day]
+
+  REAL :: vdent1                       ! Wet Snow Metamorphism
+  INTEGER :: nvdent1                       ! (Coefficients for
+  INTEGER :: nvdent2                       !           Dendricity)
 
   ! +--Snow Properties: IO
@@ -679,5 +679,5 @@
 
   !XF
-  if(G1snSV(ikl,isn)<0.1) &
+  IF(G1snSV(ikl,isn)<0.1) &
         G2_hds = G2snSV(ikl,isn) + 1.d1 *AngSno*vfi     *frac_j
   !XF
@@ -739,5 +739,5 @@
   ! +  ~~~~~~~~~~~~~~~~~~~
   ! #vp     IF          (isn    .le.     isnoSV(ikl))
-  ! #vp.    write(47,471)isn            ,isnoSV(ikl)                    ,
+  ! #vp.    WRITE(47,471)isn            ,isnoSV(ikl)                    ,
   ! #vp.                 TsisSV(ikl,isn),ro__SV(ikl,isn),eta_SV(ikl,isn),
   ! #vp.                 G1_bak         ,G2_bak         ,istoSV(ikl,isn),
@@ -860,5 +860,5 @@
   ! #wp.                             .AND.istoSV(ikl,isn).eq.     0)
   ! #wp.    THEN
-  ! #wp       write(6,*) ikl,isn,' G1,G2,hist,OK_Ang  ',
+  ! #wp       WRITE(6,*) ikl,isn,' G1,G2,hist,OK_Ang  ',
   ! #wp.          G1snSV(ikl,isn), G2snSV(ikl,isn),istoSV(ikl,isn),OK_Ang
   ! #wp       stop "Grains anguleux mal d?finis"
@@ -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)
@@ -923,3 +923,3 @@
 
 
-end subroutine sisvat_gsn
+END SUBROUTINE sisvat_gsn
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qsn.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qsn.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qsn.f90	(revision 5116)
@@ -61,5 +61,5 @@
   use VARxSV
   use VARySV
-  use surface_data, only: is_ok_slush,opt_runoff_ac
+  use surface_data, ONLY: is_ok_slush,opt_runoff_ac
 
 
@@ -86,47 +86,47 @@
   ! +  ==================
 
-  integer :: ikl   ,isn                    !
-  integer :: nh                            ! Non erodible Snow: up.lay.Index
-  integer :: LayrOK                        ! 1 (0)  if In(Above) Snow Pack
-  integer :: k_face                        ! 1 (0)  if Crystal(no) faceted
-  integer :: LastOK                        ! 1 ==>  1! Snow Layer
-  integer :: NOLayr                        ! 1     Layer  Update
-  integer :: noSnow(knonv)                 ! Nb of Layers Updater
-  integer :: kSlush                        ! Slush Switch
-  real :: dTSnow                        ! Temperature                  [C]
-  real :: EExdum(knonv)                 ! Energy in Excess when no Snow
-  real :: OKmelt                        ! 1 (0)  if        (no) Melting
-  real :: EnMelt                        ! Energy in excess, for Melting
-  real :: SnHLat                        ! Energy consumed   in  Melting
-  real :: AdEnrg,B_Enrg                 ! Additional Energy from  Vapor
-  real :: dzVap0,dzVap1                 ! Vaporized Thickness          [m]
-  real :: dzMelt(knonv)                 ! Melted    Thickness          [m]
-  real :: rosDry                        ! Snow volumic Mass if no Water in
-  real :: PorVol                        ! Pore volume
-  real :: PClose                        ! Pore Hole Close OFF Switch
-  real :: SGDiam                        !      Snow Grain Diameter
-  real :: SGDmax                        ! Max. Snow Grain Diameter
-  real :: rWater                        ! Retained Water           [kg/m2]
-  real :: drrNEW                        ! New available Water      [kg/m2]
-  real :: rdzNEW                        ! Snow          Mass       [kg/m2]
-  real :: rdzsno                        ! Snow          Mass       [kg/m2]
-  real :: EnFrez                        ! Energy Release    in  Freezing
-  real :: WaFrez                        ! Water  consumed   in  Melting
-  real :: RapdOK                        ! 1. ==> Snow melts rapidly
-  real :: ThinOK                        ! 1. ==> Snow Layer is thin
-  real :: dzepsi                        ! Minim. Snow Layer Thickness (!)
-  real :: dz_Min                        ! Minim. Snow Layer Thickness
-  real :: z_Melt                        ! Last (thin) Layer Melting
-  real :: rusnew                        ! Surficial Water Thickness   [mm]
-  real :: zWater                        ! Max Slush Water Thickness   [mm]
-  real :: zSlush                        !     Slush Water Thickness   [mm]
-  real :: ro_new                        ! New Snow/ice  Density    [kg/m3]
-  real :: zc,zt                         ! Non erod.Snow Thickness[mm w.e.]
-  real :: rusnSV0(knonv)
-  real :: Tsave
+  INTEGER :: ikl   ,isn                    !
+  INTEGER :: nh                            ! Non erodible Snow: up.lay.Index
+  INTEGER :: LayrOK                        ! 1 (0)  if In(Above) Snow Pack
+  INTEGER :: k_face                        ! 1 (0)  if Crystal(no) faceted
+  INTEGER :: LastOK                        ! 1 ==>  1! Snow Layer
+  INTEGER :: NOLayr                        ! 1     Layer  Update
+  INTEGER :: noSnow(knonv)                 ! Nb of Layers Updater
+  INTEGER :: kSlush                        ! Slush Switch
+  REAL :: dTSnow                        ! Temperature                  [C]
+  REAL :: EExdum(knonv)                 ! Energy in Excess when no Snow
+  REAL :: OKmelt                        ! 1 (0)  if        (no) Melting
+  REAL :: EnMelt                        ! Energy in excess, for Melting
+  REAL :: SnHLat                        ! Energy consumed   in  Melting
+  REAL :: AdEnrg,B_Enrg                 ! Additional Energy from  Vapor
+  REAL :: dzVap0,dzVap1                 ! Vaporized Thickness          [m]
+  REAL :: dzMelt(knonv)                 ! Melted    Thickness          [m]
+  REAL :: rosDry                        ! Snow volumic Mass if no Water in
+  REAL :: PorVol                        ! Pore volume
+  REAL :: PClose                        ! Pore Hole Close OFF Switch
+  REAL :: SGDiam                        !      Snow Grain Diameter
+  REAL :: SGDmax                        ! Max. Snow Grain Diameter
+  REAL :: rWater                        ! Retained Water           [kg/m2]
+  REAL :: drrNEW                        ! New available Water      [kg/m2]
+  REAL :: rdzNEW                        ! Snow          Mass       [kg/m2]
+  REAL :: rdzsno                        ! Snow          Mass       [kg/m2]
+  REAL :: EnFrez                        ! Energy Release    in  Freezing
+  REAL :: WaFrez                        ! Water  consumed   in  Melting
+  REAL :: RapdOK                        ! 1. ==> Snow melts rapidly
+  REAL :: ThinOK                        ! 1. ==> Snow Layer is thin
+  REAL :: dzepsi                        ! Minim. Snow Layer Thickness (!)
+  REAL :: dz_Min                        ! Minim. Snow Layer Thickness
+  REAL :: z_Melt                        ! Last (thin) Layer Melting
+  REAL :: rusnew                        ! Surficial Water Thickness   [mm]
+  REAL :: zWater                        ! Max Slush Water Thickness   [mm]
+  REAL :: zSlush                        !     Slush Water Thickness   [mm]
+  REAL :: ro_new                        ! New Snow/ice  Density    [kg/m3]
+  REAL :: zc,zt                         ! Non erod.Snow Thickness[mm w.e.]
+  REAL :: rusnSV0(knonv)
+  REAL :: Tsave
 
   ! +--OUTPUT of SISVAT Trace Statistics (see assignation in PHY_SISVAT)
   ! +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  integer :: isnnew,isinew,isnUpD,isnitr
+  INTEGER :: isnnew,isinew,isnUpD,isnitr
 
   ! OUTPUT in SISVAT at specified i,j,k,n (see assignation in PHY_SISVAT)
@@ -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)))
@@ -364,12 +364,12 @@
       PClose = max(0.,min(1.,PClose))
 
-      if(isn==1) then
+      IF(isn==1) THEN
            PClose = 1
        ispiSV(ikl)= max(ispiSV(ikl),1)
       endif
 
-      if(drr_SV(ikl)    >0  .and.TsisSV(ikl,isn)>273.14) then
+      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
+             ro__SV(ikl,isn)>950) THEN
          dzsnSV(ikl,isn) = dzsnSV(ikl,isn)*ro__SV(ikl,isn)/ro_ice
          ro__SV(ikl,isn) = ro_ice
@@ -384,5 +384,5 @@
   !    .      TsisSV(ikl,isn)  >273.14 .and.
   !    .      TsisSV(ikl,isn+1)<273.15 .and.
-  !    .      drr_SV(ikl)      >0)     then
+  !    .      drr_SV(ikl)      >0)     THEN
       !  TsisSV(ikl,isn)=273.14
       !  PClose = 1
@@ -492,6 +492,6 @@
       rusnew      = rusnSV(ikl) * SWf_SV(ikl)
 
-      if(isnoSV(ikl)<=1 .OR. opt_runoff_ac) rusnew = 0.
-      !if(ivgtSV(ikl)>=1) rusnew = 0.
+      IF(isnoSV(ikl)<=1 .OR. opt_runoff_ac) rusnew = 0.
+      !IF(ivgtSV(ikl)>=1) rusnew = 0.
 
   ! #EU                        rusnew = 0.
@@ -525,8 +525,8 @@
      ENDDO
 
-     if(zt<0.005+(TaT_SV(ikl)-TfSnow)/1000..and. &
+     IF(zt<0.005+(TaT_SV(ikl)-TfSnow)/1000..and. &
            isnoSV(ikl)             >0         .and. &
            TaT_SV(ikl)             >=TfSnow   .and. &
-           istoSV(ikl,isnoSV(ikl)) >1       ) then
+           istoSV(ikl,isnoSV(ikl)) >1       ) THEN
       DO isn=1,isnoSV(ikl)
        drr_SV(ikl)    = drr_SV(ikl) &
@@ -562,5 +562,5 @@
             +zSlush                           ) & !
             / max(dzsnSV(ikl,isn) , epsi           ) !
-      if(ro_new<ro_Ice+20) then ! MAX 940kg/m3         !
+      IF(ro_new<ro_Ice+20) then ! MAX 940kg/m3         !
        rusnSV(ikl)  = rusnSV(ikl)          - zSlush    ! [mm] OR [kg/m2]
        RuofSV(ikl,4)= max(0.,RuofSV(ikl,4) - zSlush/dt__SV)
@@ -715,3 +715,3 @@
 
 
-end subroutine sisvat_qsn
+END SUBROUTINE sisvat_qsn
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qso.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qso.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_qso.f90	(revision 5116)
@@ -109,7 +109,7 @@
   ! +  ==================
 
-  integer :: isl   ,jsl   ,ist   ,ikl      !
-  integer :: ikm   ,ikp   ,ik0   ,ik1      !
-  integer :: ist__s,ist__w                 ! Soil/Water Body Identifier
+  INTEGER :: isl   ,jsl   ,ist   ,ikl      !
+  INTEGER :: ikm   ,ikp   ,ik0   ,ik1      !
+  INTEGER :: ist__s,ist__w                 ! Soil/Water Body Identifier
   ! #BP real      z0soil                        ! Soil Surface Bumps Height  [m]
   ! #BP real      z_Bump                        !(Partly)Bumpy Layers Height [m]
@@ -118,27 +118,27 @@
 
   ! #BP real      etBump(knonv)                 ! Bumps Layer Averaged Humidity
-  real :: etaMid                        ! Layer Interface's Humidity
-  real :: Dhydif                        ! Hydraulic Diffusivity   [m2/s]
-  real :: eta__f                        ! Water Front Soil Water Content
-  real :: Khyd_f                        ! Water Front Hydraulic Conduct.
-  real :: Khydav                        ! Hydraulic Conductivity   [m/s]
-  real :: WgFlow                        ! Water gravitat. Flux [kg/m2/s]
-  real :: Wg_MAX                        ! Water MAX.grav. Flux [kg/m2/s]
-  real :: SatRat                        ! Saturation      Flux [kg/m2/s]
-  real :: WExces                        ! Saturat. Excess Flux [kg/m2/s]
-  real :: SoRnOF(knonv)                 ! Soil     Run    OFF
-  real :: Dhydtz(knonv,-nsol:0)         ! Dhydif * dt / dz           [m]
-  real :: Elem_A,Elem_B,Elem_C          !   Diagonal Coefficients
-  real :: Diag_A(knonv,-nsol:0)         ! A Diagonal
-  real :: Diag_B(knonv,-nsol:0)         ! B Diagonal
-  real :: Diag_C(knonv,-nsol:0)         ! C Diagonal
-  real :: Term_D(knonv,-nsol:0)         !   Independant Term
-  real :: Aux__P(knonv,-nsol:0)         ! P Auxiliary Variable
-  real :: Aux__Q(knonv,-nsol:0)         ! Q Auxiliary Variable
-  real :: etaaux(knonv,-nsol:-nsol+1)   ! Soil Water Content     [m3/m3]
-  real :: FreeDr                        ! Free Drainage Fraction (actual)
-  real :: FreeD0                        ! Free Drainage Fraction (1=Full)
-  real :: aKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: a * dt
-  real :: bKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: b * dt
+  REAL :: etaMid                        ! Layer Interface's Humidity
+  REAL :: Dhydif                        ! Hydraulic Diffusivity   [m2/s]
+  REAL :: eta__f                        ! Water Front Soil Water Content
+  REAL :: Khyd_f                        ! Water Front Hydraulic Conduct.
+  REAL :: Khydav                        ! Hydraulic Conductivity   [m/s]
+  REAL :: WgFlow                        ! Water gravitat. Flux [kg/m2/s]
+  REAL :: Wg_MAX                        ! Water MAX.grav. Flux [kg/m2/s]
+  REAL :: SatRat                        ! Saturation      Flux [kg/m2/s]
+  REAL :: WExces                        ! Saturat. Excess Flux [kg/m2/s]
+  REAL :: SoRnOF(knonv)                 ! Soil     Run    OFF
+  REAL :: Dhydtz(knonv,-nsol:0)         ! Dhydif * dt / dz           [m]
+  REAL :: Elem_A,Elem_B,Elem_C          !   Diagonal Coefficients
+  REAL :: Diag_A(knonv,-nsol:0)         ! A Diagonal
+  REAL :: Diag_B(knonv,-nsol:0)         ! B Diagonal
+  REAL :: Diag_C(knonv,-nsol:0)         ! C Diagonal
+  REAL :: Term_D(knonv,-nsol:0)         !   Independant Term
+  REAL :: Aux__P(knonv,-nsol:0)         ! P Auxiliary Variable
+  REAL :: Aux__Q(knonv,-nsol:0)         ! Q Auxiliary Variable
+  REAL :: etaaux(knonv,-nsol:-nsol+1)   ! Soil Water Content     [m3/m3]
+  REAL :: FreeDr                        ! Free Drainage Fraction (actual)
+  REAL :: FreeD0                        ! Free Drainage Fraction (1=Full)
+  REAL :: aKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: a * dt
+  REAL :: bKdtSV3( 0:nsot, 0:nkhy)      ! Khyd=a*eta+b: b * dt
 
   ! Water (Mass) Budget
@@ -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)
@@ -550,5 +550,5 @@
   ! +--IO, for Verification
   ! +  ~~~~~~~~~~~~~~~~~~~~
-  ! #WR     write(6,6010)
+  ! #WR     WRITE(6,6010)
   DO   isl= 0,-nsol,-1
     DO ikl= 1,knonv
@@ -557,5 +557,5 @@
       Khydsv(ikl,isl)   =(aKdtSV3(ist,ikp)  *eta_SV(ikl,isl) &
             +bKdtSV3(ist,ikp)) *2.0/dt__SV
-  ! #WR     write(6,6011) ikl,isl,eta_SV(ikl,isl)*1.e3,
+  ! #WR     WRITE(6,6011) ikl,isl,eta_SV(ikl,isl)*1.e3,
   ! #WR.                  ikp,    aKdtSV3(ist,ikp),bKdtSV3(ist,ikp),
   ! #WR.                          Khydsv(ikl,isl)
@@ -706,3 +706,3 @@
 
 
-end subroutine sisvat_qso
+END SUBROUTINE sisvat_qso
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_sno_albedo.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_sno_albedo.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_sno_albedo.f90	(revision 5116)
@@ -67,5 +67,5 @@
   use VARySV
   use VARtSV
-  USE surface_data, only: iflag_albcalc,correc_alb
+  USE surface_data, ONLY: iflag_albcalc,correc_alb
 
   IMPLICIT NONE
@@ -73,36 +73,36 @@
 
   ! + -- INPUT
-  integer :: jjtime
+  INTEGER :: jjtime
 
   ! +--Internal Variables
   ! +  ==================
 
-  real :: coalb1(knonv)                      ! weighted Coalbedo, Vis.
-  real :: coalb2(knonv)                      ! weighted Coalbedo, nIR 1
-  real :: coalb3(knonv)                      ! weighted Coalbedo, nIR 2
-  real :: coalbm                             ! weighted Coalbedo, mean
-  real :: sExt_1(knonv)                      ! Extinction Coeff., Vis.
-  real :: sExt_2(knonv)                      ! Extinction Coeff., nIR 1
-  real :: sExt_3(knonv)                      ! Extinction Coeff., nIR 2
-  real :: SnOpSV(knonv,      nsno)           ! Snow Grain optical Size
+  REAL :: coalb1(knonv)                      ! weighted Coalbedo, Vis.
+  REAL :: coalb2(knonv)                      ! weighted Coalbedo, nIR 1
+  REAL :: coalb3(knonv)                      ! weighted Coalbedo, nIR 2
+  REAL :: coalbm                             ! weighted Coalbedo, mean
+  REAL :: sExt_1(knonv)                      ! Extinction Coeff., Vis.
+  REAL :: sExt_2(knonv)                      ! Extinction Coeff., nIR 1
+  REAL :: sExt_3(knonv)                      ! Extinction Coeff., nIR 2
+  REAL :: SnOpSV(knonv,      nsno)           ! Snow Grain optical Size
   ! #AG real      agesno
 
-  integer :: isn   ,ikl   ,isn1, i
-  real :: sbeta1,sbeta2,sbeta3,sbeta4,sbeta5
-  real :: AgeMax,AlbMin,HSnoSV,HIceSV,doptmx,SignG1,Sph_OK
-  real :: dalbed,dalbeS,dalbeW
-  real :: bsegal,czemax,csegal,csza
-  real :: RoFrez,DiffRo,SignRo,SnowOK,OpSqrt
-  real :: albSn1,albIc1,a_SnI1,a_SII1
-  real :: albSn2,albIc2,a_SnI2,a_SII2
-  real :: albSn3,albIc3,a_SnI3,a_SII3
-  real :: albSno,albIce,albSnI,albSII,albWIc,albmax
-  real :: doptic,Snow_H,SIce_H,SnownH,SIcenH
-  real :: exarg1,exarg2,exarg3,sign_0,sExt_0
-  real :: albedo_old,albCor
-  real :: ro_ave,dz_ave,minalb
-  real :: l1min,l1max,l2min,l2max,l3min,l3max
-  real :: l6min(6), l6max(6), albSn6(6), a_SII6(6)
-  real :: lmintmp,lmaxtmp,albtmp
+  INTEGER :: isn   ,ikl   ,isn1, i
+  REAL :: sbeta1,sbeta2,sbeta3,sbeta4,sbeta5
+  REAL :: AgeMax,AlbMin,HSnoSV,HIceSV,doptmx,SignG1,Sph_OK
+  REAL :: dalbed,dalbeS,dalbeW
+  REAL :: bsegal,czemax,csegal,csza
+  REAL :: RoFrez,DiffRo,SignRo,SnowOK,OpSqrt
+  REAL :: albSn1,albIc1,a_SnI1,a_SII1
+  REAL :: albSn2,albIc2,a_SnI2,a_SII2
+  REAL :: albSn3,albIc3,a_SnI3,a_SII3
+  REAL :: albSno,albIce,albSnI,albSII,albWIc,albmax
+  REAL :: doptic,Snow_H,SIce_H,SnownH,SIcenH
+  REAL :: exarg1,exarg2,exarg3,sign_0,sExt_0
+  REAL :: albedo_old,albCor
+  REAL :: ro_ave,dz_ave,minalb
+  REAL :: l1min,l1max,l2min,l2max,l3min,l3max
+  REAL :: l6min(6), l6max(6), albSn6(6), a_SII6(6)
+  REAL :: lmintmp,lmaxtmp,albtmp
 
   ! +--Local   DATA
@@ -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))
@@ -569,5 +569,5 @@
 
 
-end subroutine snoptp
+END SUBROUTINE snoptp
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_ts2.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_ts2.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_ts2.f90	(revision 5116)
@@ -95,12 +95,12 @@
   ! +  ==================
 
-  integer :: ig, jk, isl
-  real :: mu
-  real :: Tsrf(klonv)               ! surface temperature as extrapolated from soil
-  real :: mug(klonv)                 !hj coef top layers
-  real :: ztherm_i(klonv), zdz2(klonv, -nsol:nsno), z1s
-  real :: pfluxgrd(klonv), pcapcal(klonv), cal(klonv)
-  real :: beta(klonv), dif_grnd(klonv)
-  real :: C_coef(klonv, -nsol:nsno), D_coef(klonv, -nsol:nsno)
+  INTEGER :: ig, jk, isl
+  REAL :: mu
+  REAL :: Tsrf(klonv)               ! surface temperature as extrapolated from soil
+  REAL :: mug(klonv)                 !hj coef top layers
+  REAL :: ztherm_i(klonv), zdz2(klonv, -nsol:nsno), z1s
+  REAL :: pfluxgrd(klonv), pcapcal(klonv), cal(klonv)
+  REAL :: beta(klonv), dif_grnd(klonv)
+  REAL :: C_coef(klonv, -nsol:nsno), D_coef(klonv, -nsol:nsno)
 
   REAL, DIMENSION(klonv) :: zx_mh, zx_nh, zx_oh
@@ -123,5 +123,5 @@
 
 
-  ! write(*,*)'T check'
+  ! WRITE(*,*)'T check'
 
   ! DO  ig = 1,knonv
@@ -196,9 +196,9 @@
   ! IF (knonv>0) THEN
   !  DO ig=1,8
-  !    write(*,*)ig,'sisvat: Tsis ',TsisSV(ig,isnoSV(ig))
-  !    write(*,*)'max-1            ',TsisSV(ig,isnoSV(ig)-1)
-  !    write(*,*)'max-2            ',TsisSV(ig,isnoSV(ig)-2)
-  !    write(*,*)'0                ',TsisSV(ig,0)
-  !!        write(*,*)min(max(isnoSV(ig),0),1),max(1-isnoSV(ig),0)
+  !    WRITE(*,*)ig,'sisvat: Tsis ',TsisSV(ig,isnoSV(ig))
+  !    WRITE(*,*)'max-1            ',TsisSV(ig,isnoSV(ig)-1)
+  !    WRITE(*,*)'max-2            ',TsisSV(ig,isnoSV(ig)-2)
+  !    WRITE(*,*)'0                ',TsisSV(ig,0)
+  !!        WRITE(*,*)min(max(isnoSV(ig),0),1),max(1-isnoSV(ig),0)
   !  ENDDO
   ! END IF
@@ -216,8 +216,8 @@
 
     IF (mug(ig)  <= 0.05) THEN
-      write(*, *)'Attention mu low', mug(ig)
+      WRITE(*, *)'Attention mu low', mug(ig)
     ENDIF
     IF (mug(ig)  >= 0.98) THEN
-      write(*, *)'Attention mu high', mug(ig)
+      WRITE(*, *)'Attention mu high', mug(ig)
     ENDIF
 
@@ -243,5 +243,5 @@
     ENDDO
   ENDDO
-  ! write(*,*)ig,'Tsis',TsisSV(ig,0)
+  ! WRITE(*,*)ig,'Tsis',TsisSV(ig,0)
 
   ! IF (indice == is_sic) THEN
@@ -329,33 +329,33 @@
   DO ig = 1, knonv
     IF (ps__SV(ig)<1.) THEN
-      ! write(*,*)'ig',ig,'ps',ps__SV(ig)
+      ! WRITE(*,*)'ig',ig,'ps',ps__SV(ig)
       ps__SV(ig) = max(ps__SV(ig), 1.e-8)
     ENDIF
     IF (p1l_SV(ig)<1.) THEN
-      ! write(*,*)'ig',ig,'p1l',p1l_SV(ig)
+      ! WRITE(*,*)'ig',ig,'p1l',p1l_SV(ig)
       p1l_SV(ig) = max(p1l_SV(ig), 1.e-8)
     ENDIF
     IF (TaT_SV(ig)<180.) THEN
-      ! write(*,*)'ig',ig,'TaT',TaT_SV(ig)
+      ! WRITE(*,*)'ig',ig,'TaT',TaT_SV(ig)
       TaT_SV(ig) = max(TaT_SV(ig), 180.)
     ENDIF
     IF (QaT_SV(ig)<1.e-8) THEN
-      ! write(*,*)'ig',ig,'QaT',QaT_SV(ig)
+      ! WRITE(*,*)'ig',ig,'QaT',QaT_SV(ig)
       QaT_SV(ig) = max(QaT_SV(ig), 1.e-8)
     ENDIF
     IF (Tsf_SV(ig)<100.) THEN
-      ! write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
+      ! WRITE(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
       Tsf_SV(ig) = max(Tsf_SV(ig), 180.)
     ENDIF
     IF (Tsf_SV(ig)>500.) THEN
-      ! write(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
+      ! WRITE(*,*)'ig',ig,'Tsf',Tsf_SV(ig)
       Tsf_SV(ig) = min(Tsf_SV(ig), 400.)
     ENDIF
     ! IF (Tsrf(ig).LT.1.) THEN
-    !!          write(*,*)'ig',ig,'Tsrf',Tsrf(ig)
+    !!          WRITE(*,*)'ig',ig,'Tsrf',Tsrf(ig)
     !   Tsrf(ig)=max(Tsrf(ig),TaT_SV(ig)-20.)
     ! ENDIF
     IF (cdH_SV(ig)<1.e-10) THEN
-      ! IF (ig.le.3)   write(*,*)'ig',ig,'cdH',cdH_SV(ig)
+      ! IF (ig.le.3)   WRITE(*,*)'ig',ig,'cdH',cdH_SV(ig)
       cdH_SV(ig) = .5
     ENDIF
@@ -370,5 +370,5 @@
       zx_qs = r2es * FOEEW(Tsf_SV(ig), zdelta) / ps__SV(ig)
       zx_qs = MIN(0.5, zx_qs)
-      !write(*,*)'zcor',retv*zx_qs
+      !WRITE(*,*)'zcor',retv*zx_qs
       zcor = 1. / (1. - retv * zx_qs)
       zx_qs = zx_qs * zcor
@@ -470,3 +470,3 @@
   ENDDO
 
-end subroutine sisvat_ts2
+END SUBROUTINE sisvat_ts2
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_tso.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_tso.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_tso.f90	(revision 5116)
@@ -94,49 +94,49 @@
   ! +  ==================
 
-  integer :: ikl   ,isl   ,jsl   ,ist      !
-  integer :: ist__s,ist__w                 ! Soil/Water  Body Identifier
-  integer :: islsgn                        ! Soil/Snow Surfac.Identifier
-  real :: eps__3                        ! Arbitrary    Low Number
-  real :: etaMid,psiMid                 ! Layer Interface's Humidity
-  real :: mu_eta                        !     Soil thermal Conductivity
-  real :: mu_exp                        ! arg Soil thermal Conductivity
-  real :: mu_min                        ! Min Soil thermal Conductivity
-  real :: mu_max                        ! Max Soil thermal Conductivity
-  real :: mu_sno(knonv),mu_aux          !     Snow thermal Conductivity
-  real :: mu__dz(knonv,-nsol:nsno+1)    ! mu_(eta,sno)   / dz
-  real :: dtC_sv(knonv,-nsol:nsno)      ! dt      / C
-  real :: IRs__D(knonv)                 ! UpwardIR Previous Iter.Contr.
-  real :: dIRsdT(knonv)                 ! UpwardIR           T Derivat.
-  real :: f_HSHL(knonv)                 ! Factor common to HS and HL
-  real :: dRidTs(knonv)                 ! d(Rib)/d(Ts)
-  real :: HS___D(knonv)                 ! Sensible Heat Flux Atm.Contr.
-  real :: f___HL(knonv)                 !
-  real :: HL___D(knonv)                 ! Latent   Heat Flux Atm.Contr.
+  INTEGER :: ikl   ,isl   ,jsl   ,ist      !
+  INTEGER :: ist__s,ist__w                 ! Soil/Water  Body Identifier
+  INTEGER :: islsgn                        ! Soil/Snow Surfac.Identifier
+  REAL :: eps__3                        ! Arbitrary    Low Number
+  REAL :: etaMid,psiMid                 ! Layer Interface's Humidity
+  REAL :: mu_eta                        !     Soil thermal Conductivity
+  REAL :: mu_exp                        ! arg Soil thermal Conductivity
+  REAL :: mu_min                        ! Min Soil thermal Conductivity
+  REAL :: mu_max                        ! Max Soil thermal Conductivity
+  REAL :: mu_sno(knonv),mu_aux          !     Snow thermal Conductivity
+  REAL :: mu__dz(knonv,-nsol:nsno+1)    ! mu_(eta,sno)   / dz
+  REAL :: dtC_sv(knonv,-nsol:nsno)      ! dt      / C
+  REAL :: IRs__D(knonv)                 ! UpwardIR Previous Iter.Contr.
+  REAL :: dIRsdT(knonv)                 ! UpwardIR           T Derivat.
+  REAL :: f_HSHL(knonv)                 ! Factor common to HS and HL
+  REAL :: dRidTs(knonv)                 ! d(Rib)/d(Ts)
+  REAL :: HS___D(knonv)                 ! Sensible Heat Flux Atm.Contr.
+  REAL :: f___HL(knonv)                 !
+  REAL :: HL___D(knonv)                 ! Latent   Heat Flux Atm.Contr.
   REAL :: TSurf0(knonv),dTSurf          ! Previous Surface Temperature
-  real :: qsatsg(knonv) !,den_qs,arg_qs ! Soil   Saturat. Spec. Humidity
-  real :: dqs_dT(knonv)                 ! d(qsatsg)/dTv
-  real :: Psi(   knonv)                 ! 1st Soil Layer Water Potential
-  real :: RHuSol(knonv)                 ! Soil Surface Relative Humidity
-  real :: etaSol                        ! Soil Surface          Humidity
-  real :: d__eta                        ! Soil Surface Humidity Increm.
-  real :: Elem_A,Elem_C                 !   Diagonal Coefficients
-  real :: Diag_A(knonv,-nsol:nsno)      ! A Diagonal
-  real :: Diag_B(knonv,-nsol:nsno)      ! B Diagonal
-  real :: Diag_C(knonv,-nsol:nsno)      ! C Diagonal
-  real :: Term_D(knonv,-nsol:nsno)      !   Independant Term
-  real :: Aux__P(knonv,-nsol:nsno)      ! P Auxiliary Variable
-  real :: Aux__Q(knonv,-nsol:nsno)      ! Q Auxiliary Variable
-  real :: Ts_Min,Ts_Max                 ! Temperature Limits
+  REAL :: qsatsg(knonv) !,den_qs,arg_qs ! Soil   Saturat. Spec. Humidity
+  REAL :: dqs_dT(knonv)                 ! d(qsatsg)/dTv
+  REAL :: Psi(   knonv)                 ! 1st Soil Layer Water Potential
+  REAL :: RHuSol(knonv)                 ! Soil Surface Relative Humidity
+  REAL :: etaSol                        ! Soil Surface          Humidity
+  REAL :: d__eta                        ! Soil Surface Humidity Increm.
+  REAL :: Elem_A,Elem_C                 !   Diagonal Coefficients
+  REAL :: Diag_A(knonv,-nsol:nsno)      ! A Diagonal
+  REAL :: Diag_B(knonv,-nsol:nsno)      ! B Diagonal
+  REAL :: Diag_C(knonv,-nsol:nsno)      ! C Diagonal
+  REAL :: Term_D(knonv,-nsol:nsno)      !   Independant Term
+  REAL :: Aux__P(knonv,-nsol:nsno)      ! P Auxiliary Variable
+  REAL :: Aux__Q(knonv,-nsol:nsno)      ! Q Auxiliary Variable
+  REAL :: Ts_Min,Ts_Max                 ! Temperature Limits
   ! #e1 real      Exist0                        ! Existing Layer Switch
-  real :: psat_wat, psat_ice, sp        ! computation of qsat
-
-  integer :: nt_srf,it_srf,itEuBk          ! HL: Surface Scheme
+  REAL :: psat_wat, psat_ice, sp        ! computation of qsat
+
+  INTEGER :: nt_srf,it_srf,itEuBk          ! HL: Surface Scheme
   parameter(nt_srf=10)                     ! 10 before
-  real :: agpsrf,xgpsrf,dt_srf,dt_ver   !
-  real :: etaBAK(knonv)                 !
-  real :: etaNEW(knonv)                 !
-  real :: etEuBk(knonv)                 !
-  real :: fac_dt(knonv),faceta(knonv)   !
-  real :: PsiArg(knonv),SHuSol(knonv)   !
+  REAL :: agpsrf,xgpsrf,dt_srf,dt_ver   !
+  REAL :: etaBAK(knonv)                 !
+  REAL :: etaNEW(knonv)                 !
+  REAL :: etEuBk(knonv)                 !
+  REAL :: fac_dt(knonv),faceta(knonv)   !
+  REAL :: PsiArg(knonv),SHuSol(knonv)   !
 
 
@@ -436,5 +436,5 @@
             * exp (6827.*(1.         /273.16-1./TsisSV(ikl,isl)))
 
-      if(TsisSV(ikl,isl)<=273.16) then
+      IF(TsisSV(ikl,isl)<=273.16) THEN
         qsatsg(ikl) = 0.622 * psat_ice / (sp - 0.378 * psat_ice)
       else
@@ -466,5 +466,5 @@
         END DO
 
-    if(ist__s==1) then ! to reduce computer time
+    IF(ist__s==1) then ! to reduce computer time
 
     DO it_srf=1,nt_srf                                     !
@@ -615,6 +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))
@@ -673,3 +672,3 @@
 
 
-end subroutine sisvat_tso
+END SUBROUTINE sisvat_tso
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90	(revision 5116)
@@ -30,6 +30,6 @@
 
 
-  character(len=6) :: labWEq
-  integer :: istart
+  CHARACTER(LEN=6) :: labWEq
+  INTEGER :: istart
 
   logical :: logWEq
@@ -40,6 +40,6 @@
   ! +  ================
 
-  integer :: ikl   ,isn
-  real :: SnoWEQ,IceWEQ
+  INTEGER :: ikl   ,isn
+  REAL :: SnoWEQ,IceWEQ
 
 
@@ -85,10 +85,10 @@
 
   !!      IF (istart.eq.1)                                              THEN
-  !!        write(45,45)dahost,i___SV(lwriSV(1)),j___SV(lwriSV(1)),
+  !!        WRITE(45,45)dahost,i___SV(lwriSV(1)),j___SV(lwriSV(1)),
   !!     .              n___SV(lwriSV(1))
   !! 45     format(a18,10('-'),'Pt.',3i4,60('-'))
   !!      END IF
 
-  !!      write(45,450) labWEq,IceWEQ,iiceSV(ikl),SnoWEQ
+  !!      WRITE(45,450) labWEq,IceWEQ,iiceSV(ikl),SnoWEQ
   !!     .                    ,IceWEQ+SnoWEQ,isnoSV(ikl)
   !!     .                                  ,drr_SV(ikl)*dt__SV
@@ -102,3 +102,3 @@
 
 
-end subroutine sisvat_weq
+END SUBROUTINE sisvat_weq
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zag.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zag.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zag.f90	(revision 5116)
@@ -63,12 +63,12 @@
   ! +  -----
 
-  integer :: isagrb(knonv)                 ! 2nd Layer History
-  real :: dzagrb(knonv)                 ! 2nd Layer Thickness
-  real :: T_agrb(knonv)                 ! 2nd Layer Temperature
-  real :: roagrb(knonv)                 ! 2nd Layer Density
-  real :: etagrb(knonv)                 ! 2nd Layer Water Content
-  real :: G1agrb(knonv)                 ! 2nd Layer Dendricity/Spher.
-  real :: G2agrb(knonv)                 ! 2nd Layer Sphericity/Size
-  real :: agagrb(knonv)                 ! 2nd Layer Age
+  INTEGER :: isagrb(knonv)                 ! 2nd Layer History
+  REAL :: dzagrb(knonv)                 ! 2nd Layer Thickness
+  REAL :: T_agrb(knonv)                 ! 2nd Layer Temperature
+  REAL :: roagrb(knonv)                 ! 2nd Layer Density
+  REAL :: etagrb(knonv)                 ! 2nd Layer Water Content
+  REAL :: G1agrb(knonv)                 ! 2nd Layer Dendricity/Spher.
+  REAL :: G2agrb(knonv)                 ! 2nd Layer Sphericity/Size
+  REAL :: agagrb(knonv)                 ! 2nd Layer Age
 
 
@@ -76,14 +76,14 @@
   ! +  ------------
 
-  integer :: isagra(knonv)                 ! 1st Layer History
-  real :: WEagra(knonv)                 ! 1st Layer Height    [mm w.e.]
-  real :: Agreg1(knonv)                 ! 1. ===>   Agregates
-  real :: dzagra(knonv)                 ! 1st Layer Thickness
-  real :: T_agra(knonv)                 ! 1st Layer Temperature
-  real :: roagra(knonv)                 ! 1st Layer Density
-  real :: etagra(knonv)                 ! 1st Layer Water Content
-  real :: G1agra(knonv)                 ! 1st Layer Dendricity/Spher.
-  real :: G2agra(knonv)                 ! 1st Layer Sphericity/Size
-  real :: agagra(knonv)                 ! 1st Layer Age
+  INTEGER :: isagra(knonv)                 ! 1st Layer History
+  REAL :: WEagra(knonv)                 ! 1st Layer Height    [mm w.e.]
+  REAL :: Agreg1(knonv)                 ! 1. ===>   Agregates
+  REAL :: dzagra(knonv)                 ! 1st Layer Thickness
+  REAL :: T_agra(knonv)                 ! 1st Layer Temperature
+  REAL :: roagra(knonv)                 ! 1st Layer Density
+  REAL :: etagra(knonv)                 ! 1st Layer Water Content
+  REAL :: G1agra(knonv)                 ! 1st Layer Dendricity/Spher.
+  REAL :: G2agra(knonv)                 ! 1st Layer Sphericity/Size
+  REAL :: agagra(knonv)                 ! 1st Layer Age
 
 
@@ -91,38 +91,38 @@
   ! +  ==================
 
-  integer :: ikl
-  integer :: nh                            ! Averaged    Snow History
-  integer :: nh__OK                        ! 1=>Conserve Snow History
-  real :: rh                            !
-  real :: dz                            ! Thickness
-  real :: dzro_1                        ! Thickness X Density, Lay.1
-  real :: dzro_2                        ! Thickness X Density, Lay.2
-  real :: dzro                          ! Thickness X Density, Aver.
-  real :: ro                            ! Averaged    Density
-  real :: wn                            ! Averaged    Water Content
-  real :: tn                            ! Averaged    Temperature
-  real :: ag                            ! Averaged    Snow Age
-  real :: SameOK                        ! 1. => Same Type of Grains
-  real :: G1same                        ! Averaged G1,  same Grains
-  real :: G2same                        ! Averaged G2,  same Grains
-  real :: typ__1                        ! 1. => Lay1 Type: Dendritic
-  real :: zroNEW                        ! dz X ro, if fresh Snow
-  real :: G1_NEW                        ! G1,      if fresh Snow
-  real :: G2_NEW                        ! G2,      if fresh Snow
-  real :: zroOLD                        ! dz X ro, if old   Snow
-  real :: G1_OLD                        ! G1,      if old   Snow
-  real :: G2_OLD                        ! G2,      if old   Snow
-  real :: SizNEW                        ! Size,    if fresh Snow
-  real :: SphNEW                        ! Spheric.,if fresh Snow
-  real :: SizOLD                        ! Size,    if old   Snow
-  real :: SphOLD                        ! Spheric.,if old   Snow
-  real :: Siz_av                        ! Averaged    Grain Size
-  real :: Sph_av                        ! Averaged    Grain Spher.
-  real :: Den_av                        ! Averaged    Grain Dendr.
-  real :: DendOK                        ! 1. => Average is  Dendr.
-  real :: G1diff                        ! Averaged G1, diff. Grains
-  real :: G2diff                        ! Averaged G2, diff. Grains
-  real :: G1                            ! Averaged G1
-  real :: G2                            ! Averaged G2
+  INTEGER :: ikl
+  INTEGER :: nh                            ! Averaged    Snow History
+  INTEGER :: nh__OK                        ! 1=>Conserve Snow History
+  REAL :: rh                            !
+  REAL :: dz                            ! Thickness
+  REAL :: dzro_1                        ! Thickness X Density, Lay.1
+  REAL :: dzro_2                        ! Thickness X Density, Lay.2
+  REAL :: dzro                          ! Thickness X Density, Aver.
+  REAL :: ro                            ! Averaged    Density
+  REAL :: wn                            ! Averaged    Water Content
+  REAL :: tn                            ! Averaged    Temperature
+  REAL :: ag                            ! Averaged    Snow Age
+  REAL :: SameOK                        ! 1. => Same Type of Grains
+  REAL :: G1same                        ! Averaged G1,  same Grains
+  REAL :: G2same                        ! Averaged G2,  same Grains
+  REAL :: typ__1                        ! 1. => Lay1 Type: Dendritic
+  REAL :: zroNEW                        ! dz X ro, if fresh Snow
+  REAL :: G1_NEW                        ! G1,      if fresh Snow
+  REAL :: G2_NEW                        ! G2,      if fresh Snow
+  REAL :: zroOLD                        ! dz X ro, if old   Snow
+  REAL :: G1_OLD                        ! G1,      if old   Snow
+  REAL :: G2_OLD                        ! G2,      if old   Snow
+  REAL :: SizNEW                        ! Size,    if fresh Snow
+  REAL :: SphNEW                        ! Spheric.,if fresh Snow
+  REAL :: SizOLD                        ! Size,    if old   Snow
+  REAL :: SphOLD                        ! Spheric.,if old   Snow
+  REAL :: Siz_av                        ! Averaged    Grain Size
+  REAL :: Sph_av                        ! Averaged    Grain Spher.
+  REAL :: Den_av                        ! Averaged    Grain Dendr.
+  REAL :: DendOK                        ! 1. => Average is  Dendr.
+  REAL :: G1diff                        ! Averaged G1, diff. Grains
+  REAL :: G2diff                        ! Averaged G2, diff. Grains
+  REAL :: G1                            ! Averaged G1
+  REAL :: G2                            ! Averaged G2
 
 
@@ -236,3 +236,3 @@
 
 
-end subroutine sisvat_zag
+END SUBROUTINE sisvat_zag
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zcr.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zcr.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zcr.f90	(revision 5116)
@@ -49,15 +49,15 @@
   ! +  ==================
   ! +
-  integer :: ikl   ,isn   ,is0   ,is1
-  integer :: isno_1                        ! Switch:  ! Snow Layer over Ice
-  real :: Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure
-  real :: DenSph                        ! 1. when contiguous spheric
+  INTEGER :: ikl   ,isn   ,is0   ,is1
+  INTEGER :: isno_1                        ! Switch:  ! Snow Layer over Ice
+  REAL :: Dtyp_0,Dtyp_1                 ! Snow Grains Difference Measure
+  REAL :: DenSph                        ! 1. when contiguous spheric
   ! +                                           !     and dendritic  Grains
-  real :: DendOK                        ! 1. when dendritic  Grains
-  real :: dTypMx                        ! Grain Type Differ.
-  real :: dTypSp                        ! Sphericity Weight
-  real :: dTypRo                        ! Density    Weight
-  real :: dTypDi                        ! Grain Diam.Weight
-  real :: dTypHi                        ! History    Weight
+  REAL :: DendOK                        ! 1. when dendritic  Grains
+  REAL :: dTypMx                        ! Grain Type Differ.
+  REAL :: dTypSp                        ! Sphericity Weight
+  REAL :: dTypRo                        ! Density    Weight
+  REAL :: dTypDi                        ! Grain Diam.Weight
+  REAL :: dTypHi                        ! History    Weight
 
 
@@ -173,3 +173,3 @@
   ! +
 
-end subroutine sisvat_zcr
+END SUBROUTINE sisvat_zcr
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zsn.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zsn.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_zsn.f90	(revision 5116)
@@ -52,5 +52,5 @@
   use VARxSV
   use VARySV
-  use surface_data, only: ok_zsn_ii
+  use surface_data, ONLY: ok_zsn_ii
 
   IMPLICIT NONE
@@ -60,49 +60,49 @@
   ! +  ==================
 
-  integer :: ikl   ,isn   ,i               !
-
-
-
-
-
-
-  integer :: NLay_s(knonv)                 ! Split Snow Layer         Switch
-  integer :: isagr1(knonv)                 ! 1st     Layer History
-  integer :: isagr2(knonv)                 ! 2nd     Layer History
-  integer :: LstLay                        ! 0 ====> isnoSV = 1
-  integer :: isno_n                        ! Snow Normal.Profile
-  integer :: iice_n                        ! Ice  Normal.Profile
-  integer :: iiceOK                        ! Ice         Switch
-  integer :: icemix                        ! 0 ====> Agregated Snow+Ice=Snow
+  INTEGER :: ikl   ,isn   ,i               !
+
+
+
+
+
+
+  INTEGER :: NLay_s(knonv)                 ! Split Snow Layer         Switch
+  INTEGER :: isagr1(knonv)                 ! 1st     Layer History
+  INTEGER :: isagr2(knonv)                 ! 2nd     Layer History
+  INTEGER :: LstLay                        ! 0 ====> isnoSV = 1
+  INTEGER :: isno_n                        ! Snow Normal.Profile
+  INTEGER :: iice_n                        ! Ice  Normal.Profile
+  INTEGER :: iiceOK                        ! Ice         Switch
+  INTEGER :: icemix                        ! 0 ====> Agregated Snow+Ice=Snow
   ! +                                           ! 1                          Ice
-  integer :: isn1  (knonv)                 ! 1st layer to stagger
-  real :: staggr                        !              stagger  Switch
-
-  real :: WEagre(knonv)                 ! Snow Water Equivalent Thickness
-  real :: dzthin(knonv)                 ! Thickness of the thinest layer
-  real :: OKthin                        ! Swich ON  a  new thinest layer
-  real :: dz_dif                        ! difference from ideal discret.
-  real :: thickL                        ! Thick Layer          Indicator
-  real :: OK_ICE                        ! Swich ON   uppermost Ice Layer
-
-  real :: Agrege(knonv)                 ! 1. when Agregation constrained
-  real :: dzepsi                        ! Min Single Snw Layer Thickness
-  real :: dzxmin                        ! Min Acceptable Layer Thickness
-  real :: dz_min                        ! Min            Layer Thickness
-  real :: dz_max                        ! Max            Layer Thickness
-  real :: dzagr1(knonv)                 ! 1st     Layer Thickness
-  real :: dzagr2(knonv)                 ! 2nd     Layer Thickness
-  real :: T_agr1(knonv)                 ! 1st     Layer Temperature
-  real :: T_agr2(knonv)                 ! 2nd     Layer Temperature
-  real :: roagr1(knonv)                 ! 1st     Layer Density
-  real :: roagr2(knonv)                 ! 2nd     Layer Density
-  real :: etagr1(knonv)                 ! 1st     Layer Water Content
-  real :: etagr2(knonv)                 ! 2nd     Layer Water Content
-  real :: G1agr1(knonv)                 ! 1st     Layer Dendricity/Spher.
-  real :: G1agr2(knonv)                 ! 2nd     Layer Dendricity/Spher.
-  real :: G2agr1(knonv)                 ! 1st     Layer Sphericity/Size
-  real :: G2agr2(knonv)                 ! 2nd     Layer Sphericity/Size
-  real :: agagr1(knonv)                 ! 1st     Layer Age
-  real :: agagr2(knonv)                 ! 2nd     Layer Age
+  INTEGER :: isn1  (knonv)                 ! 1st layer to stagger
+  REAL :: staggr                        !              stagger  Switch
+
+  REAL :: WEagre(knonv)                 ! Snow Water Equivalent Thickness
+  REAL :: dzthin(knonv)                 ! Thickness of the thinest layer
+  REAL :: OKthin                        ! Swich ON  a  new thinest layer
+  REAL :: dz_dif                        ! difference from ideal discret.
+  REAL :: thickL                        ! Thick Layer          Indicator
+  REAL :: OK_ICE                        ! Swich ON   uppermost Ice Layer
+
+  REAL :: Agrege(knonv)                 ! 1. when Agregation constrained
+  REAL :: dzepsi                        ! Min Single Snw Layer Thickness
+  REAL :: dzxmin                        ! Min Acceptable Layer Thickness
+  REAL :: dz_min                        ! Min            Layer Thickness
+  REAL :: dz_max                        ! Max            Layer Thickness
+  REAL :: dzagr1(knonv)                 ! 1st     Layer Thickness
+  REAL :: dzagr2(knonv)                 ! 2nd     Layer Thickness
+  REAL :: T_agr1(knonv)                 ! 1st     Layer Temperature
+  REAL :: T_agr2(knonv)                 ! 2nd     Layer Temperature
+  REAL :: roagr1(knonv)                 ! 1st     Layer Density
+  REAL :: roagr2(knonv)                 ! 2nd     Layer Density
+  REAL :: etagr1(knonv)                 ! 1st     Layer Water Content
+  REAL :: etagr2(knonv)                 ! 2nd     Layer Water Content
+  REAL :: G1agr1(knonv)                 ! 1st     Layer Dendricity/Spher.
+  REAL :: G1agr2(knonv)                 ! 2nd     Layer Dendricity/Spher.
+  REAL :: G2agr1(knonv)                 ! 1st     Layer Sphericity/Size
+  REAL :: G2agr2(knonv)                 ! 2nd     Layer Sphericity/Size
+  REAL :: agagr1(knonv)                 ! 1st     Layer Age
+  REAL :: agagr2(knonv)                 ! 2nd     Layer Age
 
 
@@ -130,8 +130,8 @@
 
     DO ikl=1,knonv
-      if(isnoSV(ikl)<=2)             dz_min=max(0.0050,dz_min)
+      IF(isnoSV(ikl)<=2)             dz_min=max(0.0050,dz_min)
 
                                       dzepsi=0.0015
-      if(ro__SV(ikl,isnoSV(ikl))>920) dzepsi=0.0020
+      IF(ro__SV(ikl,isnoSV(ikl))>920) dzepsi=0.0020
 
       dzthin(ikl) = 0.                              ! Arbitrary unrealistic
@@ -240,5 +240,5 @@
     DO ikl=1,knonv
       isn         =    i_thin(ikl)
-      if(LIndsv(ikl)>0) isn=min(nsno-1,isn) ! cXF
+      IF(LIndsv(ikl)>0) isn=min(nsno-1,isn) ! cXF
       isagr1(ikl) =    istoSV(ikl,isn)
       isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
@@ -410,5 +410,5 @@
 
     isn=max(1,isnoSV(ikl)-3)
-    if(dzsnSV(ikl,isn)>0.30) then   ! surface layer > 30cm
+    IF(dzsnSV(ikl,isn)>0.30) then   ! surface layer > 30cm
      i_thin(ikl) = isn              ! XF 04/07/2019
      dzthin(ikl) = dzsnSV(ikl,isn)
@@ -416,5 +416,5 @@
 
     isn=max(1,isnoSV(ikl)-2)
-    if(dzsnSV(ikl,isn)>0.10) then   ! surface layer > 10cm
+    IF(dzsnSV(ikl,isn)>0.10) then   ! surface layer > 10cm
      i_thin(ikl) = isn              ! XF 04/07/2019
      dzthin(ikl) = dzsnSV(ikl,isn)
@@ -422,5 +422,5 @@
 
     isn=max(1,isnoSV(ikl)-1)
-    if(dzsnSV(ikl,isn)>0.05) then   ! surface layer > 5cm
+    IF(dzsnSV(ikl,isn)>0.05) then   ! surface layer > 5cm
      i_thin(ikl) = isn              ! XF 04/07/2019
      dzthin(ikl) = dzsnSV(ikl,isn)
@@ -428,5 +428,5 @@
 
     isn=max(1,isnoSV(ikl))
-    if(dzsnSV(ikl,isn)>0.02) then   ! surface layer > 2cm
+    IF(dzsnSV(ikl,isn)>0.02) then   ! surface layer > 2cm
      i_thin(ikl) = isn              ! XF 04/07/2019
      dzthin(ikl) = dzsnSV(ikl,isn)
@@ -572,5 +572,5 @@
     DO ikl=1,knonv
       isn         =    i_thin(ikl)
-      if(LIndsv(ikl)>0) isn=min(isn, nsno-1) !cXF
+      IF(LIndsv(ikl)>0) isn=min(isn, nsno-1) !cXF
       isagr1(ikl) =    istoSV(ikl,isn)
       isagr2(ikl) =    istoSV(ikl,isn+LIndsv(ikl))
@@ -598,8 +598,8 @@
   ! + 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
+    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
+          dzsnSV(ikl,max(1,isnoSV(ikl)-3))>0.30 )THEN
       Agrege(ikl) = min(1, &
             max(0, &
@@ -739,3 +739,3 @@
 
 
-end subroutine sisvat_zsn
+END SUBROUTINE sisvat_zsn
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 5116)
@@ -165,20 +165,20 @@
         real, dimension(klon) :: mean_dens
         ! lat_scale : temperature lapse rate against latitude [K degree-1]
-        real :: lat_scale
+        REAL :: lat_scale
         ! sh_scale : temperature lapse rate against altitude [K km-1]
-        real :: sh_scale
+        REAL :: sh_scale
         ! variables for density profile
         ! E0, E1 : exponent
-        real :: E0, E1
+        REAL :: E0, E1
         ! depth at which 550 kg m-3 is reached [m]
-        real :: z550
+        REAL :: z550
         ! depths of snow layers
-        real :: depth, snow_depth, distup
+        REAL :: depth, snow_depth, distup
         ! number of initial snow layers
-        integer :: nb_snow_layer
+        INTEGER :: nb_snow_layer
         ! For density calc.
-        real :: alpha0, alpha1, ln_smb
+        REAL :: alpha0, alpha1, ln_smb
         ! theoritical densities [kg m-3]
-        real :: rho0, rho1, rho1_550
+        REAL :: rho0, rho1, rho1_550
         ! constants for density profile
         ! C0, C1 : constant, 0.07 for z <= 550 kg m-3
@@ -228,9 +228,9 @@
             klonv = klon
             knonv = knon
-                write(*, *) 'ikl, lon and lat in INLANDSIS'
+                WRITE(*, *) 'ikl, lon and lat in INLANDSIS'
 
             DO ikl = 1, knon
                 i=ikl2i(ikl)
-                write(*, *) 'ikl=', ikl, 'rlon=', rlon(i), 'rlat=', rlat(i)
+                WRITE(*, *) 'ikl=', ikl, 'rlon=', rlon(i), 'rlat=', rlat(i)
             END DO
 
@@ -260,5 +260,5 @@
             ! +--Soil layer thickness . Compute soil discretization (as for LMDZ)
             ! +  ----------------------------------------------------------------
-            !        write(*,'(/a)') 'Start SISVAT init: soil discretization ', nsoilmx
+            !        WRITE(*,'(/a)') 'Start SISVAT init: soil discretization ', nsoilmx
             CALL get_soil_levels(dz1, dz2, lambda)
 
@@ -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
@@ -399,5 +399,5 @@
                 else
 
-                !    write(*, *) 'Attention: temperature initialization is only defined for Greenland and Antarctica'
+                !    WRITE(*, *) 'Attention: temperature initialization is only defined for Greenland and Antarctica'
 
                      mean_dens(ikl) =350.
@@ -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
@@ -499,6 +499,6 @@
                 open(unit = un_outfor, status = 'replace', file = fn_outfor)
                 ikl = gp_outfor     ! index sur la grille land ice
-                write(un_outfor, *) fn_outfor, ikl, dt__SV, rlon(ikl2i(ikl)), rlat(ikl2i(ikl))
-                write(un_outfor, *) 'nsnow - albedo - z0m - z0h , dz [m,30], temp [K,41], rho [kg/m3,41], eta [kg/kg,41] &
+                WRITE(un_outfor, *) fn_outfor, ikl, dt__SV, rlon(ikl2i(ikl)), rlat(ikl2i(ikl))
+                WRITE(un_outfor, *) 'nsnow - albedo - z0m - z0h , dz [m,30], temp [K,41], rho [kg/m3,41], eta [kg/kg,41] &
    G1 [-,30], G2 [-,30], agesnow [d,30], history [-,30], DOP [m,30]'
             END IF
@@ -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)
@@ -564,5 +564,5 @@
             !      will be used for characterizing the Buffer Layer
             !      (see update of  Bros_N, G1same, G2same, zroOLD, zroNEW)
-            ! #BS  if(n==1) qbs_HY(i,j) = dsnbSV(ikl)
+            ! #BS  IF(n==1) qbs_HY(i,j) = dsnbSV(ikl)
             qsnoSV(ikl) = snow_cont_air(ikl)
 
@@ -642,5 +642,5 @@
                     toicSV(ikl) = toicSV(ikl) - sn_add
                 ELSE
-                    write(*, *) 'Attention, bare ice... point ', ikl
+                    WRITE(*, *) 'Attention, bare ice... point ', ikl
                     isnoSV(ikl) = 1
                     istoSV(ikl, 1) = 0
@@ -713,15 +713,15 @@
             IF (ok_outfor) THEN
              ikl= gp_outfor
-            write(un_outfor, *) '+++++++++++', rlon(ikl2i(ikl)), rlat(ikl2i(ikl)),alt(ikl),'+++++++++++'
-            write(un_outfor, *) isnoSV(ikl), alb_SV(ikl), Z0m_SV(ikl), Z0h_SV(ikl),HSs_sv(ikl),HLs_sv(ikl),alb1(ikl),alb2(ikl)
-            write(un_outfor, *) dzsnSV(ikl, :)
-            write(un_outfor, *) TsisSV(ikl, :)
-            write(un_outfor, *) ro__SV(ikl, :)
-            write(un_outfor, *) eta_SV(ikl, :)
-            write(un_outfor, *) G1snSV(ikl, :)
-            write(un_outfor, *) G2snSV(ikl, :)
-            write(un_outfor, *) agsnSV(ikl, :)
-            write(un_outfor, *) istoSV(ikl, :)
-            write(un_outfor, *) DOPsnSV(ikl, :)
+            WRITE(un_outfor, *) '+++++++++++', rlon(ikl2i(ikl)), rlat(ikl2i(ikl)),alt(ikl),'+++++++++++'
+            WRITE(un_outfor, *) isnoSV(ikl), alb_SV(ikl), Z0m_SV(ikl), Z0h_SV(ikl),HSs_sv(ikl),HLs_sv(ikl),alb1(ikl),alb2(ikl)
+            WRITE(un_outfor, *) dzsnSV(ikl, :)
+            WRITE(un_outfor, *) TsisSV(ikl, :)
+            WRITE(un_outfor, *) ro__SV(ikl, :)
+            WRITE(un_outfor, *) eta_SV(ikl, :)
+            WRITE(un_outfor, *) G1snSV(ikl, :)
+            WRITE(un_outfor, *) G2snSV(ikl, :)
+            WRITE(un_outfor, *) agsnSV(ikl, :)
+            WRITE(un_outfor, *) istoSV(ikl, :)
+            WRITE(un_outfor, *) DOPsnSV(ikl, :)
         ENDIF
 
@@ -771,5 +771,5 @@
         fz(rk) = fz1 * (dalph_soil**rk - 1.) / (dalph_soil - 1.)
 
-        !    write(*,*)'Start soil level computation'
+        !    WRITE(*,*)'Start soil level computation'
         !-----------------------------------------------------------------------
         ! Calculation of some constants
@@ -1190,5 +1190,5 @@
             ENDIF
         ENDDO
-        write(*, *)'Read ', fichnom, ' finished!!'
+        WRITE(*, *)'Read ', fichnom, ' finished!!'
 
         !*********************************************************************************
@@ -1216,10 +1216,10 @@
 
                 END DO
-                write(*, *)'Copy histo', ikl
+                WRITE(*, *)'Copy histo', ikl
 
                 DO  isn = 1, isnoSV(ikl) !nsno
                     snopts = snopts + 1
                     IF (isto(i, isn) > 10.) THEN          !hj check
-                        write(*, *)'Irregular isto', ikl, i, isn, isto(i, isn)
+                        WRITE(*, *)'Irregular isto', ikl, i, isn, isto(i, isn)
                         isto(i, isn) = 1.
                     ENDIF
@@ -1245,5 +1245,5 @@
                         errro = errro + 1
                     ENDIF
-                    write(*, *)ikl, i, isn, Tsis(i, isn), G1sn(i, isn)
+                    WRITE(*, *)ikl, i, isn, Tsis(i, isn), G1sn(i, isn)
                     G1snSV(ikl, isn) = G1sn(i, isn)          ! [-]        [-]
                     G2snSV(ikl, isn) = G2sn(i, isn)          ! [-] [0.0001 m]
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/iophy.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/iophy.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/iophy.F90	(revision 5116)
@@ -141,9 +141,9 @@
 
       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
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
-        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn
+        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
+        WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
+        WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
+        WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn
       ENDIF
 
@@ -348,6 +348,5 @@
 
     ENDDO
-    if (is_sequential) then
-
+    if (is_sequential) THEN
      npstn=pim
      IF(.NOT. ALLOCATED(nptabij)) THEN
@@ -835,7 +834,7 @@
      ALLOCATE(index2d(nbp_lon*jj_nb))
      ALLOCATE(fieldok(nbp_lon*jj_nb))
-     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
+     IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
      CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
-     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
+     IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
     ELSE
      ALLOCATE(fieldok(npstn))
@@ -857,7 +856,7 @@
       ENDDO
      ENDIF
-     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
+     IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
      CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
-     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
+     IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
 
     ENDIF
@@ -903,7 +902,7 @@
       ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
       ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
-      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
+      IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
       CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
-      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
+      IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
     ELSE
       nlev=size(field,2)
@@ -929,7 +928,7 @@
         ENDDO
       ENDIF
-      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
+      IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
       CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
-      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
+      IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
     ENDIF 
     DEALLOCATE(index3d)
@@ -998,5 +997,5 @@
       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
@@ -1035,5 +1034,5 @@
     
     
-    IF (SIZE(field) == klon) then
+    IF (SIZE(field) == klon) THEN
         CALL Gather_omp(field,buffer_omp)
     ELSE
@@ -1049,9 +1048,9 @@
         IF (using_xios) THEN  
           IF (prt_level >= 10) THEN
-             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
+             WRITE(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)
           ENDIF
           
           IF (grid_type==regular_lonlat) THEN
-            IF (SIZE(field) == klon) then
+            IF (SIZE(field) == klon) THEN
               CALL xios_send_field(var%name, Field2d)
             ELSE
@@ -1059,5 +1058,5 @@
             ENDIF 
           ELSE IF (grid_type==unstructured) THEN
-            IF (SIZE(field) == klon) then
+            IF (SIZE(field) == klon) THEN
               CALL xios_send_field(var%name, buffer_omp)
             ELSE
@@ -1067,5 +1066,5 @@
           ENDIF
           IF (prt_level >= 10) THEN
-             write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
+             WRITE(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
                              trim(var%name)                       
           ENDIF
@@ -1080,10 +1079,10 @@
                 IF (firstx) THEN
                    IF (prt_level >= 10) THEN
-                      write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
+                      WRITE(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
                                      iff,trim(var%name)                       
-                      write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, CALL xios_send_field"
+                      WRITE(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, CALL xios_send_field"
                    ENDIF
                    IF (grid_type==regular_lonlat) THEN
-                     IF (SIZE(field) == klon) then
+                     IF (SIZE(field) == klon) THEN
                         CALL xios_send_field(var%name, Field2d)
                      ELSE
@@ -1091,5 +1090,5 @@
                      ENDIF
                    ELSE IF (grid_type==unstructured) THEN
-                     IF (SIZE(field) == klon) then
+                     IF (SIZE(field) == klon) THEN
                        CALL xios_send_field(var%name, buffer_omp)
                      ELSE
@@ -1111,5 +1110,5 @@
 !                        IF (iff == iff_beg) THEN
 !                          IF (prt_level >= 10) THEN
-!                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, CALL xios_send_field"
+!                            WRITE(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, CALL xios_send_field"
 !                          ENDIF
 !                          CALL xios_send_field(var%name, Field2d)
@@ -1126,5 +1125,5 @@
                         ELSE
                               DO ip=1, npstn
-                                write(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
+                                WRITE(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
                                      IF(nptabij(ip)>=klon_mpi_begin.AND. &
                                         nptabij(ip)<=klon_mpi_end) THEN
@@ -1135,5 +1134,5 @@
 #ifndef CPP_IOIPSL_NO_OUTPUT 
                        IF (prt_level >= 10) THEN
-                         write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, CALL wxios_write_2D"
+                         WRITE(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, CALL wxios_write_2D"
                        ENDIF
                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
@@ -1190,5 +1189,5 @@
   IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
 
-  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name
+  IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite3d ',var%name
 
 ! ug RUSTINE POUR LES STD LEVS.....
@@ -1239,5 +1238,5 @@
 !    ENDIF
 
-    IF (SIZE(field,1) == klon) then
+    IF (SIZE(field,1) == klon) THEN
         CALL Gather_omp(field,buffer_omp)
     ELSE
@@ -1253,9 +1252,9 @@
       IF (using_xios) THEN  
           IF (prt_level >= 10) THEN
-             write(lunout,*)'Dans iophy histwrite3D,var%name ',&
+             WRITE(lunout,*)'Dans iophy histwrite3D,var%name ',&
                              trim(var%name)                       
           ENDIF
           IF (grid_type==regular_lonlat) THEN
-            IF (SIZE(field,1) == klon) then
+            IF (SIZE(field,1) == klon) THEN
                CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
             ELSE
@@ -1263,5 +1262,5 @@
             ENDIF
           ELSE IF (grid_type==unstructured) THEN
-            IF (SIZE(field,1) == klon) then
+            IF (SIZE(field,1) == klon) THEN
                CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
             ELSE
@@ -1280,12 +1279,12 @@
               IF (firstx) THEN
                 IF (prt_level >= 10) THEN
-                  write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
+                  WRITE(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
                                   iff,nlev,klev, firstx                       
-                  write(lunout,*)'histwrite3d_phy: CALL xios_send_field for ', &
+                  WRITE(lunout,*)'histwrite3d_phy: CALL xios_send_field for ', &
                                   trim(var%name), ' with iim jjm nlevx = ', &
                                   nbp_lon,jj_nb,nlevx
                 ENDIF
                 IF (grid_type==regular_lonlat) THEN
-                  IF (SIZE(field,1) == klon) then
+                  IF (SIZE(field,1) == klon) THEN
                       CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
                   ELSE
@@ -1293,5 +1292,5 @@
                   ENDIF
                 ELSE IF (grid_type==unstructured) THEN
-                  IF (SIZE(field,1) == klon) then
+                  IF (SIZE(field,1) == klon) THEN
                      CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
                   ELSE
@@ -1351,5 +1350,5 @@
   ENDIF ! vars_defined
 
-  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
+  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite3d ',var%name
 
   END SUBROUTINE histwrite3d_phy
@@ -1386,5 +1385,5 @@
     !Et sinon on.... écrit
     IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
-    IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) then
+    IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) THEN
 !$OMP MASTER
 
@@ -1465,13 +1464,13 @@
   IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
 
-  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
+  IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite3d_xios ',field_name
 
     !Et on.... écrit
-    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) then
-      write(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field)
+    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) THEN
+      WRITE(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field)
       CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
     ENDIF
     
-    IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) then
+    IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) THEN
 !$OMP MASTER
         CALL xios_send_field(field_name,field)
@@ -1527,5 +1526,5 @@
   ENDIF
 
-  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
+  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite3d_xios ',field_name
 
   END SUBROUTINE histwrite3d_xios
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90	(revision 5116)
@@ -65,5 +65,5 @@
 !$OMP END MASTER
 
-      return
+      RETURN
       end
 
@@ -249,5 +249,5 @@
          enddo
          ! Pole sud
-         if ( jmax > 1 ) then
+         if ( jmax > 1 ) THEN
             ijl=ijl+1
             do i=1,imax
@@ -260,5 +260,5 @@
       deallocate(zx)
 
-      return
+      RETURN
       end
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/iostart.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/iostart.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/iostart.F90	(revision 5116)
@@ -40,6 +40,6 @@
       ierr = nf90_open (filename, nf90_nowrite,nid_start)
       IF (ierr/=nf90_noerr) THEN
-        write(6,*)' Pb d''ouverture du fichier '//filename
-        write(6,*)' ierr = ', ierr
+        WRITE(6,*)' Pb d''ouverture du fichier '//filename
+        WRITE(6,*)' ierr = ', ierr
         CALL abort_physic("", "", 1)
       ENDIF
@@ -316,6 +316,6 @@
                           nid_restart)
       IF (ierr/=nf90_noerr) THEN
-        write(lunout,*)'open_restartphy: problem creating file '//trim(filename)
-        write(lunout,*)trim(nf90_strerror(ierr))
+        WRITE(lunout,*)'open_restartphy: problem creating file '//trim(filename)
+        WRITE(lunout,*)trim(nf90_strerror(ierr))
         CALL abort_physic("open_restartphy", trim(nf90_strerror(ierr)), 1)
       ENDIF
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/iotd.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/iotd.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/iotd.h	(revision 5116)
@@ -13,5 +13,5 @@
       INTEGER dim_coord(4)
       real iotd_ts,iotd_t0
-      integer :: n_names_iotd_def
+      INTEGER :: n_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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ecrit.F90	(revision 5116)
@@ -58,5 +58,5 @@
 ! Ajouts
       integer, save :: ntime=0
-      integer :: idim,varid
+      INTEGER :: idim,varid
       character (len =50):: fichnom
       integer, dimension(4) :: id
@@ -65,5 +65,5 @@
 
 
-       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,11 +114,11 @@
 !        PRINT*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date
 
-           if (ierr/=nf90_noerr) then
-              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
-              write(*,*) "***** with time"
-              write(*,*) 'ierr=', ierr   
+           if (ierr/=nf90_noerr) THEN
+              WRITE(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              WRITE(*,*) "***** with time"
+              WRITE(*,*) 'ierr=', ierr
            endif
 
-!          write(6,*)'WRITEDIAGFI: date= ', date
+!          WRITE(6,*)'WRITEDIAGFI: date= ', date
         end if ! of if (nom.eq.firstnom)
 
@@ -126,5 +126,5 @@
 !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,8 +175,8 @@
       ierr= nf90_put_var(nid,varid,zx,corner,edges)
 
-      if (ierr/=nf90_noerr) then
-           write(*,*) "***** PUT_VAR problem in writediagfi"
-           write(*,*) "***** with ",nom
-           write(*,*) 'ierr=', ierr
+      if (ierr/=nf90_noerr) THEN
+           WRITE(*,*) "***** PUT_VAR problem in writediagfi"
+           WRITE(*,*) "***** with ",nom
+           WRITE(*,*) 'ierr=', ierr
       endif 
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ini.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ini.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/iotd_ini.F90	(revision 5116)
@@ -42,5 +42,5 @@
       INTEGER :: ierr
 
-      integer :: nvarid
+      INTEGER :: nvarid
       integer, dimension(2) :: id  
 
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/isccp_cloud_types.F90	(revision 5116)
@@ -247,57 +247,57 @@
   ! PRINT*,' isccp_cloud_types npoints=',npoints
 
-  ! if ( debug.ne.0 ) then
+  ! if ( debug.ne.0 ) THEN
   ! j=1
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write(6,'(a10)') 'debug='
-  ! write(6,'(8I10)') debug
-  ! write(6,'(a10)') 'debugcol='
-  ! write(6,'(8I10)') debugcol
-  ! write(6,'(a10)') 'npoints='
-  ! write(6,'(8I10)') npoints
-  ! write(6,'(a10)') 'nlev='
-  ! write(6,'(8I10)') nlev
-  ! write(6,'(a10)') 'ncol='
-  ! write(6,'(8I10)') ncol
-  ! write(6,'(a10)') 'top_height='
-  ! write(6,'(8I10)') top_height
-  ! write(6,'(a10)') 'overlap='
-  ! write(6,'(8I10)') overlap
-  ! write(6,'(a10)') 'emsfc_lw='
-  ! write(6,'(8f10.2)') emsfc_lw
-  ! write(6,'(a10)') 'tautab='
-  ! write(6,'(8f10.2)') tautab
-  ! write(6,'(a10)') 'invtau(1:100)='
-  ! write(6,'(8i10)') (invtau(i),i=1,100)
+  ! WRITE(6,'(a10)') 'j='
+  ! WRITE(6,'(8I10)') j
+  ! WRITE(6,'(a10)') 'debug='
+  ! WRITE(6,'(8I10)') debug
+  ! WRITE(6,'(a10)') 'debugcol='
+  ! WRITE(6,'(8I10)') debugcol
+  ! WRITE(6,'(a10)') 'npoints='
+  ! WRITE(6,'(8I10)') npoints
+  ! WRITE(6,'(a10)') 'nlev='
+  ! WRITE(6,'(8I10)') nlev
+  ! WRITE(6,'(a10)') 'ncol='
+  ! WRITE(6,'(8I10)') ncol
+  ! WRITE(6,'(a10)') 'top_height='
+  ! WRITE(6,'(8I10)') top_height
+  ! WRITE(6,'(a10)') 'overlap='
+  ! WRITE(6,'(8I10)') overlap
+  ! WRITE(6,'(a10)') 'emsfc_lw='
+  ! WRITE(6,'(8f10.2)') emsfc_lw
+  ! WRITE(6,'(a10)') 'tautab='
+  ! WRITE(6,'(8f10.2)') tautab
+  ! WRITE(6,'(a10)') 'invtau(1:100)='
+  ! WRITE(6,'(8i10)') (invtau(i),i=1,100)
   ! do j=1,npoints,debug
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write(6,'(a10)') 'sunlit='
-  ! write(6,'(8I10)') sunlit(j)
-  ! write(6,'(a10)') 'seed='
-  ! write(6,'(8I10)') seed(j)
-  ! write(6,'(a10)') 'pfull='
-  ! write(6,'(8f10.2)') (pfull(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'phalf='
-  ! write(6,'(8f10.2)') (phalf(j,i),i=1,nlev+1)
-  ! write(6,'(a10)') 'qv='
-  ! write(6,'(8f10.3)') (qv(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'cc='
-  ! write(6,'(8f10.3)') (cc(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'conv='
-  ! write(6,'(8f10.2)') (conv(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dtau_s='
-  ! write(6,'(8g12.5)') (dtau_s(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dtau_c='
-  ! write(6,'(8f10.2)') (dtau_c(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'skt='
-  ! write(6,'(8f10.2)') skt(j)
-  ! write(6,'(a10)') 'at='
-  ! write(6,'(8f10.2)') (at(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dem_s='
-  ! write(6,'(8f10.3)') (dem_s(j,i),i=1,nlev)
-  ! write(6,'(a10)') 'dem_c='
-  ! write(6,'(8f10.2)') (dem_c(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'j='
+  ! WRITE(6,'(8I10)') j
+  ! WRITE(6,'(a10)') 'sunlit='
+  ! WRITE(6,'(8I10)') sunlit(j)
+  ! WRITE(6,'(a10)') 'seed='
+  ! WRITE(6,'(8I10)') seed(j)
+  ! WRITE(6,'(a10)') 'pfull='
+  ! WRITE(6,'(8f10.2)') (pfull(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'phalf='
+  ! WRITE(6,'(8f10.2)') (phalf(j,i),i=1,nlev+1)
+  ! WRITE(6,'(a10)') 'qv='
+  ! WRITE(6,'(8f10.3)') (qv(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'cc='
+  ! WRITE(6,'(8f10.3)') (cc(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'conv='
+  ! WRITE(6,'(8f10.2)') (conv(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'dtau_s='
+  ! WRITE(6,'(8g12.5)') (dtau_s(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'dtau_c='
+  ! WRITE(6,'(8f10.2)') (dtau_c(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'skt='
+  ! WRITE(6,'(8f10.2)') skt(j)
+  ! WRITE(6,'(a10)') 'at='
+  ! WRITE(6,'(8f10.2)') (at(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'dem_s='
+  ! WRITE(6,'(8f10.3)') (dem_s(j,i),i=1,nlev)
+  ! WRITE(6,'(a10)') 'dem_c='
+  ! WRITE(6,'(8f10.2)') (dem_c(j,i),i=1,nlev)
   ! enddo
   ! endif
@@ -338,8 +338,8 @@
   ! IM
   ! IM
-  ! if (ncolprint.ne.0) then
+  ! if (ncolprint.ne.0) THEN
   ! do j=1,npoints,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
+  ! WRITE(6,'(a10)') 'j='
+  ! WRITE(6,'(8I10)') j
   ! write (6,'(a)') 'seed:'
   ! write (6,'(I3.2)') seed(j)
@@ -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
@@ -398,14 +398,14 @@
   ! do jj=1,num1
   ! j=index1(jj)
-  ! write(6,*)  ' error = cloud fraction less than zero'
-  ! write(6,*) ' or '
-  ! write(6,*)  ' error = cloud fraction greater than 1'
-  ! write(6,*) 'value at point ',j,' is ',cc(j,ilev)
-  ! write(6,*) 'level ',ilev
+  ! WRITE(6,*)  ' error = cloud fraction less than zero'
+  ! WRITE(6,*) ' or '
+  ! WRITE(6,*)  ' error = cloud fraction greater than 1'
+  ! WRITE(6,*) 'value at point ',j,' is ',cc(j,ilev)
+  ! WRITE(6,*) 'level ',ilev
   ! STOP
   ! enddo
   ! 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
@@ -414,11 +414,11 @@
   ! do jj=1,num1
   ! j=index1(jj)
-  ! write(6,*)
+  ! WRITE(6,*)
   ! &           ' error = convective cloud fraction less than zero'
-  ! write(6,*) ' or '
-  ! write(6,*)
+  ! WRITE(6,*) ' or '
+  ! WRITE(6,*)
   ! &           ' error = convective cloud fraction greater than 1'
-  ! write(6,*) 'value at point ',j,' is ',conv(j,ilev)
-  ! write(6,*) 'level ',ilev
+  ! WRITE(6,*) 'value at point ',j,' is ',conv(j,ilev)
+  ! WRITE(6,*) 'level ',ilev
   ! STOP
   ! enddo
@@ -426,5 +426,5 @@
   ! num1=0
   ! do j=1,npoints
-  ! if (dtau_s(j,ilev) .lt. 0.) then
+  ! if (dtau_s(j,ilev) .lt. 0.) THEN
   ! num1=num1+1
   ! index1(num1)=j
@@ -433,13 +433,13 @@
   ! do jj=1,num1
   ! j=index1(jj)
-  ! write(6,*)
+  ! WRITE(6,*)
   ! &           ' error = stratiform cloud opt. depth less than zero'
-  ! write(6,*) 'value at point ',j,' is ',dtau_s(j,ilev)
-  ! write(6,*) 'level ',ilev
+  ! WRITE(6,*) 'value at point ',j,' is ',dtau_s(j,ilev)
+  ! WRITE(6,*) 'level ',ilev
   ! STOP
   ! enddo
   ! num1=0
   ! do j=1,npoints
-  ! if (dtau_c(j,ilev) .lt. 0.) then
+  ! if (dtau_c(j,ilev) .lt. 0.) THEN
   ! num1=num1+1
   ! index1(num1)=j
@@ -448,8 +448,8 @@
   ! do jj=1,num1
   ! j=index1(jj)
-  ! write(6,*)
+  ! WRITE(6,*)
   ! &           ' error = convective cloud opt. depth less than zero'
-  ! write(6,*) 'value at point ',j,' is ',dtau_c(j,ilev)
-  ! write(6,*) 'level ',ilev
+  ! WRITE(6,*) 'value at point ',j,' is ',dtau_c(j,ilev)
+  ! WRITE(6,*) 'level ',ilev
   ! STOP
   ! enddo
@@ -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
@@ -464,11 +464,11 @@
   ! do jj=1,num1
   ! j=index1(jj)
-  ! write(6,*)
+  ! WRITE(6,*)
   ! &           ' error = stratiform cloud emissivity less than zero'
-  ! write(6,*)'or'
-  ! write(6,*)
+  ! WRITE(6,*)'or'
+  ! WRITE(6,*)
   ! &           ' error = stratiform cloud emissivity greater than 1'
-  ! write(6,*) 'value at point ',j,' is ',dem_s(j,ilev)
-  ! write(6,*) 'level ',ilev
+  ! WRITE(6,*) 'value at point ',j,' is ',dem_s(j,ilev)
+  ! WRITE(6,*) 'level ',ilev
   ! STOP
   ! enddo
@@ -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
@@ -483,8 +483,8 @@
   ! do jj=1,num1
   ! j=index1(jj)
-  ! write(6,*)
+  ! WRITE(6,*)
   ! &           ' error = convective cloud emissivity less than zero'
-  ! write(6,*)'or'
-  ! write(6,*)
+  ! WRITE(6,*)'or'
+  ! WRITE(6,*)
   ! &           ' error = convective cloud emissivity greater than 1'
   ! write (6,*)
@@ -516,9 +516,9 @@
 
   ! IM
-  ! if (ncolprint.ne.0) then
+  ! if (ncolprint.ne.0) THEN
   ! write (6,'(a)') 'frac_out_pp_rev:'
   ! do j=1,npoints,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
+  ! WRITE(6,'(a10)') 'j='
+  ! WRITE(6,'(8I10)') j
   ! write (6,'(8f5.2)')
   ! &     ((frac_out(j,ibox,ilev),ibox=1,ncolprint),ilev=1,nlev)
@@ -528,9 +528,9 @@
   ! write (6,'(I3)') ncol
   ! endif
-  ! if (ncolprint.ne.0) then
+  ! if (ncolprint.ne.0) THEN
   ! write (6,'(a)') 'last_frac_pp:'
   ! do j=1,npoints,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
+  ! WRITE(6,'(a10)') 'j='
+  ! WRITE(6,'(8I10)') j
   ! write (6,'(8f5.2)') (tca(j,0))
   ! enddo
@@ -570,9 +570,9 @@
       END IF
       ! IM
-      ! IF (ncolprint.ne.0) then
+      ! IF (ncolprint.ne.0) THEN
       ! write (6,'(a)') 'threshold_nsf2:'
       ! do j=1,npoints,1000
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
+      ! WRITE(6,'(a10)') 'j='
+      ! WRITE(6,'(8I10)') j
       ! write (6,'(8f5.2)') (threshold(j,ibox),ibox=1,ncolprint)
       ! enddo
@@ -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,9 +681,8 @@
 
     ! IM
-    ! if (ncolprint.ne.0) then
-
+    ! if (ncolprint.ne.0) THEN
     ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
+    ! WRITE(6,'(a10)') 'j='
+    ! WRITE(6,'(8I10)') j
     ! write (6,'(a)') 'last_frac:'
     ! write (6,'(8f5.2)') (tca(j,ilev-1))
@@ -738,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)
@@ -750,10 +749,9 @@
   END DO ! ilev
   ! IM
-  ! if (ncolprint.ne.0) then
-
+  ! if (ncolprint.ne.0) THEN
   ! do j=1,npoints ,1000
-  ! write(6,'(a10)') 'j='
-  ! write(6,'(8I10)') j
-  ! write(6,'(i2,1X,8(f7.2,1X))')
+  ! WRITE(6,'(a10)') 'j='
+  ! WRITE(6,'(8I10)') j
+  ! WRITE(6,'(i2,1X,8(f7.2,1X))')
   ! &          ilev,
   ! &          (tau(j,ibox),ibox=1,ncolprint)
@@ -799,5 +797,5 @@
     ! IM
     ! if (ncolprint .ne. 0)
-    ! &         write(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
+    ! &         WRITE(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
     DO ilev = 1, nlev
       DO j = 1, npoints
@@ -818,9 +816,9 @@
       END DO
       ! IM
-      ! if (ncolprint .ne. 0) then
+      ! if (ncolprint .ne. 0) THEN
       ! do j=1,npoints ,1000
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
-      ! write(6,'(i2,1X,3(f8.3,3X))') ilev,
+      ! WRITE(6,'(a10)') 'j='
+      ! WRITE(6,'(8I10)') j
+      ! WRITE(6,'(i2,1X,3(f8.3,3X))') ilev,
       ! &           qv(j,ilev)*(phalf(j,ilev+1)-phalf(j,ilev))/(grav/100.),
       ! &           tauwv(j),dem_wv(j,ilev)
@@ -858,8 +856,8 @@
       END DO
       ! IM
-      ! if (ncolprint.ne.0) then
+      ! if (ncolprint.ne.0) THEN
       ! do j=1,npoints ,1000
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
+      ! WRITE(6,'(a10)') 'j='
+      ! WRITE(6,'(8I10)') j
       ! write (6,'(a)') 'ilev:'
       ! write (6,'(I2)') ilev
@@ -884,8 +882,8 @@
 
     ! IM
-    ! if (ncolprint.ne.0) then
+    ! if (ncolprint.ne.0) THEN
     ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
+    ! WRITE(6,'(a10)') 'j='
+    ! WRITE(6,'(8I10)') j
     ! write (6,'(a)') 'id:'
     ! write (6,'(a)') 'surface'
@@ -904,9 +902,8 @@
 
     ! IM
-    ! if (ncolprint.ne.0) then
-
+    ! if (ncolprint.ne.0) THEN
     ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
+    ! WRITE(6,'(a10)') 'j='
+    ! WRITE(6,'(8I10)') j
     ! write (6,'(a)') 'ts:'
     ! write (6,'(8f7.2)') (skt(j),ibox=1,ncolprint)
@@ -938,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)))
@@ -965,11 +962,11 @@
 
       ! IM
-      ! if (ncolprint.ne.0) then
+      ! if (ncolprint.ne.0) THEN
       ! do j=1,npoints,1000
       ! write (6,'(a)') 'ilev:'
       ! write (6,'(I2)') ilev
 
-      ! write(6,'(a10)') 'j='
-      ! write(6,'(8I10)') j
+      ! WRITE(6,'(a10)') 'j='
+      ! WRITE(6,'(8I10)') j
       ! write (6,'(a)') 'emiss_layer:'
       ! write (6,'(8f7.2)') (dem(j,ibox),ibox=1,ncolprint)
@@ -1009,9 +1006,8 @@
 
     ! IM
-    ! if (ncolprint.ne.0) then
-
+    ! if (ncolprint.ne.0) THEN
     ! do j=1,npoints ,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
+    ! WRITE(6,'(a10)') 'j='
+    ! WRITE(6,'(8I10)') j
     ! write (6,'(a)') 'id:'
     ! write (6,'(a)') 'surface'
@@ -1103,9 +1099,8 @@
 
     ! IM
-    ! if (ncolprint.ne.0) then
-
+    ! if (ncolprint.ne.0) THEN
     ! do j=1,npoints,1000
-    ! write(6,'(a10)') 'j='
-    ! write(6,'(8I10)') j
+    ! WRITE(6,'(a10)') 'j='
+    ! WRITE(6,'(8I10)') j
 
     ! write (6,'(a)') 'attrop:'
@@ -1212,5 +1207,5 @@
           IF ((ptop(j,ibox)==0.) & ! IM  &
                                    ! .and.(frac_out(j,ibox,ilev) .ne. 0))
-                                   ! then
+                                   ! THEN
               .AND. (frac_out(j,ibox,ilev)/=0.0)) THEN
             ptop(j, ibox) = pfull(j, ilev)
@@ -1388,23 +1383,23 @@
           ! IM           ipres(j) = 0
 
-          ! if (tau(j,ibox) .lt. isccp_taumin) then
+          ! if (tau(j,ibox) .lt. isccp_taumin) THEN
           ! itau(j)=1
           ! 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
+          ! &          .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
+          ! &          .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
+          ! &          .and. tau(j,ibox) .lt. 23.) THEN
           ! itau(j)=5
           ! else if (tau(j,ibox) .ge. 23.
-          ! &          .and. tau(j,ibox) .lt. 60.) then
+          ! &          .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
@@ -1412,22 +1407,22 @@
           !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
+          ! else IF(ptop(j,ibox) .ge. 180.
+          ! &          .and.ptop(j,ibox) .lt. 310.) THEN
           ! ipres(j)=2
-          ! else if(ptop(j,ibox) .ge. 310.
-          ! &          .and.ptop(j,ibox) .lt. 440.) then
+          ! else IF(ptop(j,ibox) .ge. 310.
+          ! &          .and.ptop(j,ibox) .lt. 440.) THEN
           ! ipres(j)=3
-          ! else if(ptop(j,ibox) .ge. 440.
-          ! &          .and.ptop(j,ibox) .lt. 560.) then
+          ! else IF(ptop(j,ibox) .ge. 440.
+          ! &          .and.ptop(j,ibox) .lt. 560.) THEN
           ! ipres(j)=4
-          ! else if(ptop(j,ibox) .ge. 560.
-          ! &          .and.ptop(j,ibox) .lt. 680.) then
+          ! else IF(ptop(j,ibox) .ge. 560.
+          ! &          .and.ptop(j,ibox) .lt. 680.) THEN
           ! ipres(j)=5
-          ! else if(ptop(j,ibox) .ge. 680.
-          ! &          .and.ptop(j,ibox) .lt. 800.) then
+          ! else IF(ptop(j,ibox) .ge. 680.
+          ! &          .and.ptop(j,ibox) .lt. 800.) THEN
           ! ipres(j)=6
-          ! else if(ptop(j,ibox) .ge. 800.) then
+          ! else IF(ptop(j,ibox) .ge. 800.) THEN
           ! ipres(j)=7
           ! end if
@@ -1443,7 +1438,7 @@
           ! pctj(itau(j),ipres(j),iw(j))=.FALSE.
           !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 (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
           ! PRINT*,' ISCCP iw=',iw(j),j
           ! fq_dynreg(itau(j),ipres(j),iw(j))=
@@ -1472,16 +1467,16 @@
     ! IM ajout stats s/ W500 END
 
-    ! if(j.EQ.6722) then
+    ! IF(j.EQ.6722) THEN
     ! PRINT*,' ISCCP',w(j),iw(j),ipres(j),itau(j)
     ! endif
 
-    ! 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(pctj(itau(j),ipres(j),iw(j))) THEN
+    ! 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(pctj(itau(j),ipres(j),iw(j))) THEN
     ! nfq_dynreg(itau(j),ipres(j),iw(j))=
     ! &    nfq_dynreg(itau(j),ipres(j),iw(j))+1.
-    ! if(itau(j).EQ.4.AND.ipres(j).EQ.2.AND.
-    ! &    iw(j).EQ.10) then
+    ! IF(itau(j).EQ.4.AND.ipres(j).EQ.2.AND.
+    ! &    iw(j).EQ.10) THEN
     ! PRINT*,' isccp AVANT',
     ! &    nfq_dynreg(itau(j),ipres(j),iw(j)),
@@ -1510,12 +1505,12 @@
   ! do l = 1, 7
   ! do k = 1, 7
-  ! if (nfq_dynreg(k,l,nw).GT.0.) then
+  ! if (nfq_dynreg(k,l,nw).GT.0.) THEN
   ! fq_dynreg(k,l,nw) = fq_dynreg(k,l,nw)/nfq_dynreg(k,l,nw)
-  ! if(k.EQ.4.AND.l.EQ.2.AND.nw.EQ.10) then
+  ! IF(k.EQ.4.AND.l.EQ.2.AND.nw.EQ.10) THEN
   ! PRINT*,' isccp APRES',nfq_dynreg(k,l,nw),
   ! &   fq_dynreg(k,l,nw)
   ! endif
   ! else
-  ! if(fq_dynreg(k,l,nw).NE.0.) then
+  ! 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
@@ -1533,6 +1528,5 @@
 
   ! cIM
-  ! if (debugcol.ne.0) then
-
+  ! if (debugcol.ne.0) THEN
   ! do j=1,npoints,debugcol
 
@@ -1554,15 +1548,15 @@
     !print test
 
-  ! write(ftn09,11) j
+  ! WRITE(ftn09,11) j
   ! 11        format('ftn09.',i4.4)
   ! open(9, FILE=ftn09, FORM='FORMATTED')
 
-  ! write(9,'(a1)') ' '
-  ! write(9,'(10i5)')
+  ! WRITE(9,'(a1)') ' '
+  ! WRITE(9,'(10i5)')
   ! &                  (ilev,ilev=5,nlev,5)
-  ! write(9,'(a1)') ' '
+  ! WRITE(9,'(a1)') ' '
 
   ! do ibox=1,ncol
-  ! write(9,'(40(a1),1x,40(a1))')
+  ! WRITE(9,'(40(a1),1x,40(a1))')
   ! &           (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev)
   ! &           ,(cchar(acc(ilev,ibox)+1),ilev=1,nlev)
@@ -1571,7 +1565,7 @@
 
   ! IM
-  ! if (ncolprint.ne.0) then
-  ! write(6,'(a1)') ' '
-  ! write(6,'(a2,1X,5(a7,1X),a50)')
+  ! if (ncolprint.ne.0) THEN
+  ! WRITE(6,'(a1)') ' '
+  ! WRITE(6,'(a2,1X,5(a7,1X),a50)')
   ! &                  'ilev',
   ! &                  'pfull','at',
@@ -1580,6 +1574,6 @@
 
   ! do 4012 ilev=1,nlev
-  ! write(6,'(60i2)') (box(i,ilev),i=1,ncolprint)
-  ! write(6,'(i2,1X,5(f7.2,1X),50(a1))')
+  ! WRITE(6,'(60i2)') (box(i,ilev),i=1,ncolprint)
+  ! WRITE(6,'(i2,1X,5(f7.2,1X),50(a1))')
   ! &                  ilev,
   ! &                  pfull(j,ilev)/100.,at(j,ilev),
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/limit_read_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/limit_read_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/limit_read_mod.F90	(revision 5116)
@@ -158,5 +158,5 @@
 ! 2) Read fraction, if not type_ocean=couple
 ! 3) Read sea surface temperature, if not type_ocean=couple
-! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
+! 4) Read albedo and rugosity for land surface, ONLY in case of no vegetation model
 ! 5) Close file and distribuate variables to all processus
 
@@ -401,5 +401,5 @@
 
 !****************************************************************************************
-! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
+! 4) Read albedo and rugosity for land surface, ONLY in case of no vegetation model
 
 !****************************************************************************************
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_exchange_coeff.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_exchange_coeff.F90	(revision 5116)
@@ -29,32 +29,32 @@
 
 !!-------------------------------------------------------------------------------------------------------------
-! integer :: iflag_atke        ! flag that controls options in atke_compute_km_kh
-! integer :: iflag_atke_lmix   ! flag that controls the calculation of mixing length in atke
-! integer :: iflag_num_atke    ! flag that controls the numerical treatment of diffusion coeffiient calculation
+! INTEGER :: iflag_atke        ! flag that controls options in atke_compute_km_kh
+! INTEGER :: iflag_atke_lmix   ! flag that controls the calculation of mixing length in atke
+! 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
 
-! real :: kappa = 0.4         ! Von Karman constant
-! real :: cn                  ! Sm value at Ri=0
-! real :: cinf                ! Sm value at Ri=-Inf
-! real :: ri0                 ! Richardson number near zero to guarantee continuity in slope of Sm (stability function) at Ri=0
-! real :: ri1                 ! Richardson number near zero to guarantee continuity in slope of Pr (Prandlt's number) at Ri=0
-! real :: lmin                ! minimum mixing length corresponding to the Kolmogov dissipation scale  in planetary atmospheres (Chen et al 2016, JGR Atmos)
-! real :: ctkes               ! coefficient for surface TKE
-! real :: clmixshear          ! coefficient for mixing length depending on local wind shear
+! REAL :: kappa = 0.4         ! Von Karman constant
+! REAL :: cn                  ! Sm value at Ri=0
+! REAL :: cinf                ! Sm value at Ri=-Inf
+! REAL :: ri0                 ! Richardson number near zero to guarantee continuity in slope of Sm (stability function) at Ri=0
+! REAL :: ri1                 ! Richardson number near zero to guarantee continuity in slope of Pr (Prandlt's number) at Ri=0
+! REAL :: lmin                ! minimum mixing length corresponding to the Kolmogov dissipation scale  in planetary atmospheres (Chen et al 2016, JGR Atmos)
+! REAL :: ctkes               ! coefficient for surface TKE
+! REAL :: clmixshear          ! coefficient for mixing length depending on local wind shear
 
 ! Tunable parameters for the ATKE scheme and their range of values
 !!-------------------------------------------------------------------------------------------------------------
-! real :: cepsilon            ! controls the value of the dissipation length scale, range [1.2 - 10]
-! real :: cke                 ! controls the value of the diffusion coefficient of TKE, range [1 - 5]
-! real :: l0                  ! asymptotic mixing length far from the ground [m] (Sun et al 2011, JAMC), range [15 - 75]
-! real :: clmix               ! controls the value of the mixing length in stratified conditions, range [0.1 - 2]
-! real :: ric                 ! critical Richardson number controlling the slope of Sm in stable conditions, range [0.19 - 0.25]
-! real :: smmin               ! minimum value of Sm in very stable conditions (defined here as minsqrt(Ez/Ek)) at large Ri, range [0.025 - 0.1]
-! real :: pr_neut             ! neutral value of the Prandtl number (Ri=0), range [0.7 - 1]
-! real :: pr_slope            ! linear slope of Pr with Ri in the very stable regime, range [3 - 5]
-! real :: cinffac             ! ratio between cinf and cn controlling the convective limit of Sm, range [1.2 - 5.0]
-! real :: pr_asym             ! value of Prandlt in the convective limit(Ri=-Inf), range [0.3 - 0.5]
+! REAL :: cepsilon            ! controls the value of the dissipation length scale, range [1.2 - 10]
+! REAL :: cke                 ! controls the value of the diffusion coefficient of TKE, range [1 - 5]
+! REAL :: l0                  ! asymptotic mixing length far from the ground [m] (Sun et al 2011, JAMC), range [15 - 75]
+! REAL :: clmix               ! controls the value of the mixing length in stratified conditions, range [0.1 - 2]
+! REAL :: ric                 ! critical Richardson number controlling the slope of Sm in stable conditions, range [0.19 - 0.25]
+! REAL :: smmin               ! minimum value of Sm in very stable conditions (defined here as minsqrt(Ez/Ek)) at large Ri, range [0.025 - 0.1]
+! REAL :: pr_neut             ! neutral value of the Prandtl number (Ri=0), range [0.7 - 1]
+! REAL :: pr_slope            ! linear slope of Pr with Ri in the very stable regime, range [3 - 5]
+! REAL :: cinffac             ! ratio between cinf and cn controlling the convective limit of Sm, range [1.2 - 5.0]
+! REAL :: pr_asym             ! value of Prandlt in the convective limit(Ri=-Inf), range [0.3 - 0.5]
 !!-------------------------------------------------------------------------------------------------------------
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_turbulence_ini.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_atke_turbulence_ini.F90	(revision 5116)
@@ -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_sublim_sedim.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 5116)
@@ -225,5 +225,5 @@
               ! we thus solve the differential equation using an implicit scheme for both qb and qv
  
-              ! we do not consider deposition, only sublimation
+              ! we do not consider deposition, ONLY sublimation
               IF (zqv(i) < qsi(i)) THEN
                  rhoair=zpres(i)/ztemp(i)/RD
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90	(revision 5116)
@@ -65,5 +65,5 @@
 
                                
-IF (iflag_num_atke == 1) then
+IF (iflag_num_atke == 1) THEN
    !! In this case, we make an explicit prediction of the wind shear to calculate the tke in a
    !! forward backward way
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_cloud_optics_prop.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_cloud_optics_prop.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_cloud_optics_prop.F90	(revision 5116)
@@ -24,5 +24,5 @@
   
   USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)  
-  USE lmdz_lscp_tools, only: icefrac_lscp
+  USE lmdz_lscp_tools, ONLY: icefrac_lscp
 
   IMPLICIT NONE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloud_optics_prop_ini.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloud_optics_prop_ini.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloud_optics_prop_ini.F90	(revision 5116)
@@ -81,11 +81,11 @@
     cdnc_min_m3=cdnc_min*1.E6
     IF (cdnc_min_m3<0.) cdnc_min_m3=20.E6 ! astuce pour retrocompatibilite
-    write(lunout,*)'cdnc_min=', cdnc_min_m3/1.E6
+    WRITE(lunout,*)'cdnc_min=', cdnc_min_m3/1.E6
     CALL getin_p('cdnc_max',cdnc_max)
     cdnc_max_m3=cdnc_max*1.E6
     IF (cdnc_max_m3<0.) cdnc_max_m3=1000.E6 ! astuce pour retrocompatibilite
-    write(lunout,*)'cdnc_max=', cdnc_max_m3/1.E6
+    WRITE(lunout,*)'cdnc_max=', cdnc_max_m3/1.E6
     CALL getin_p('iflag_t_glace',iflag_t_glace)      
-    write(lunout,*)'iflag_t_glace= ',iflag_t_glace
+    WRITE(lunout,*)'iflag_t_glace= ',iflag_t_glace
     CALL getin_p('rad_chau1',rad_chau1)
     CALL getin_p('rad_chau2',rad_chau2)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5116)
@@ -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
@@ -117,6 +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))
 
@@ -161,5 +160,5 @@
 !      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
 !      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.002*zqta(ind1,ind2) 
-!       if (paprs(ind1,ind2).gt.90000) then
+!       if (paprs(ind1,ind2).gt.90000) THEN
 !       ratqs(ind1,ind2)=0.002
 !       else 
@@ -186,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) 
@@ -227,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) 
@@ -246,5 +245,5 @@
       enddo
      
-      return
+      RETURN
 !     end
 END SUBROUTINE cloudth
@@ -265,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
@@ -347,6 +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))
 
@@ -391,5 +389,5 @@
       sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
       sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
-!       if (paprs(ind1,ind2).gt.90000) then
+!       if (paprs(ind1,ind2).gt.90000) THEN
 !       ratqs(ind1,ind2)=0.002
 !       else 
@@ -510,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) 
@@ -554,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) 
@@ -573,5 +571,5 @@
       enddo
      
-      return
+      RETURN
 !     end
 END SUBROUTINE cloudth_vert
@@ -586,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
@@ -694,6 +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))
 
@@ -759,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) 
@@ -790,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)
@@ -800,5 +797,5 @@
       endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.110 et l.183
       enddo       ! from the loop on ngrid l.108
-      return
+      RETURN
 !     end
 END SUBROUTINE cloudth_v3
@@ -978,5 +975,5 @@
       ENDIF
       sigma1s = sigma1s_fraca + sigma1s_ratqs
-      IF (iflag_ratqs==11) then
+      IF (iflag_ratqs==11) THEN
          sigma1s = ratqs(ind1,ind2)*po(ind1)*aenv
       ENDIF
@@ -987,5 +984,5 @@
 !      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2) 
 !      sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+ratqs(ind1,ind2)*zqta(ind1,ind2)
-!       if (paprs(ind1,ind2).gt.90000) then
+!       if (paprs(ind1,ind2).gt.90000) THEN
 !       ratqs(ind1,ind2)=0.002
 !       else 
@@ -1073,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
@@ -1089,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
@@ -1157,6 +1154,6 @@
       ENDIF ! of if (iflag_cloudth_vert==1 or 3 or 4)
 
-!      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 (ctot(ind1,ind2).lt.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.
@@ -1201,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)
@@ -1223,5 +1220,5 @@
 
       enddo       ! from the loop on ngrid l.333
-      return
+      RETURN
 !     end
 END SUBROUTINE cloudth_vert_v3
@@ -1233,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
@@ -1398,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.
@@ -1459,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.
@@ -1497,6 +1494,6 @@
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
-      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_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
@@ -1689,5 +1686,5 @@
  
            sigma1s = sigma1s_fraca + sigma1s_ratqs
-           IF (iflag_ratqs==11) then
+           IF (iflag_ratqs==11) THEN
               sigma1s = ratqs(ind1)*qt(ind1)*aenv
            ENDIF
@@ -1978,5 +1975,5 @@
 !            ! Environment
 !            !=============
-!            ! In the environment/downdrafts, only liquid clouds
+!            ! In the environment/downdrafts, ONLY liquid clouds
 !            ! See Shupe et al. 2008, JAS
 
@@ -1995,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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp.F90	(revision 5116)
@@ -134,5 +134,5 @@
     INTEGER, INTENT(IN) :: iflag_cld_th    ! flag that determines the distribution of convective clouds
     INTEGER, INTENT(IN) :: iflag_ice_thermo! flag to activate the ice thermodynamics
-    ! CR: if iflag_ice_thermo=2, only convection is active
+    ! CR: if iflag_ice_thermo=2, ONLY convection is active
     LOGICAL, INTENT(IN) :: ok_ice_sursat   ! flag to determine if ice sursaturation is activated
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5116)
@@ -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 
@@ -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
@@ -722,6 +722,6 @@
 
 !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
-!         write(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
+!       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."
 !         stop
@@ -756,6 +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
@@ -771,5 +770,5 @@
            ! ----------------------------------------------------------------
            do i=1,klon
-              if(zq(i)<1.e-15) then
+              IF(zq(i)<1.e-15) THEN
                  ncoreczq=ncoreczq+1
                  zq(i)=1.e-15
@@ -777,7 +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, &
@@ -786,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, &
@@ -795,5 +793,5 @@
               !Version these Jean Jouhaud, Decembre 2018 
               !----------------------------------              
-              elseif (iflag_cloudth_vert==6) then
+              elseif (iflag_cloudth_vert==6) THEN
                CALL cloudth_v6(klon,klev,k,ztv, &
                    zq,zqta,fraca, &
@@ -811,7 +809,7 @@
            endif
 
-           if (iflag_cld_th <= 4) then
+           if (iflag_cld_th <= 4) THEN
               lognormale = .TRUE.
-           elseif (iflag_cld_th >= 6) then
+           elseif (iflag_cld_th >= 6) THEN
               ! lognormale en l'absence des thermiques
               lognormale = fraca(:,k) < 1e-10
@@ -846,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) 
              ! -----------------------------------------------------
@@ -856,5 +854,5 @@
                  ! ------------------------------
                  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
 
@@ -868,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
@@ -884,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
@@ -906,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)
@@ -915,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)
@@ -930,11 +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
@@ -949,12 +946,11 @@
                  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)
@@ -964,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
@@ -980,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)
@@ -1010,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:
@@ -1068,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)
@@ -1104,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
@@ -1118,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)
@@ -1139,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))) &
@@ -1276,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
@@ -1292,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))
@@ -1355,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)
@@ -1420,5 +1416,5 @@
 !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
+!           if (.not.ice_thermo) THEN
 !           d_ql(i,k) = zoliq(i)
 !           d_qi(i,k) = 0.
@@ -1467,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)))
@@ -1565,5 +1561,5 @@
      DO i = 1,klon
 
-        if(zcond(i)>zoliq(i)+1.e-10) then
+        IF(zcond(i)>zoliq(i)+1.e-10) THEN
          beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
         else
@@ -1667,5 +1663,5 @@
   ENDIF
 
-  if (ncoreczq>0) then
+  if (ncoreczq>0) THEN
      WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
   endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_tools.F90	(revision 5116)
@@ -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,6 +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    
@@ -576,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90	(revision 5116)
@@ -31,5 +31,5 @@
 real, intent(in) :: RG_in,RV_in,RD_in,RCPD_in,RLSTT_in,RLVTT_in,RTT_in
 
-integer :: i,k
+INTEGER :: i,k
 
 nbsrf   =nbsrf_in
@@ -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
@@ -76,5 +76,5 @@
 !--------------------------------------------------------
 
-IF (klon==1) then
+IF (klon==1) THEN
     do k=1,klev
       do i=1,klon 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90	(revision 5116)
@@ -71,8 +71,8 @@
 !   ----------------
 !   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
-            if(ptconv(i,k)) then
+            IF(ptconv(i,k)) THEN
               ratqsc(i,k)=ratqsbas &
               +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
@@ -86,11 +86,11 @@
 !  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.
-         if(prt_level>=9) PRINT*,'avant clouds_gno thermique'
+         IF(prt_level>=9) PRINT*,'avant clouds_gno thermique'
          CALL clouds_gno &
          (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
-         if(prt_level>=9) PRINT*,' CLOUDS_GNO OK'
+         IF(prt_level>=9) PRINT*,' CLOUDS_GNO OK'
        
        endif
@@ -99,6 +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
@@ -116,11 +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
@@ -130,11 +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
@@ -144,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) &
@@ -150,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) &
@@ -158,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
@@ -173,6 +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
@@ -193,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, &
@@ -205,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
@@ -213,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_)
@@ -234,6 +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
@@ -241,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
@@ -248,7 +243,7 @@
 
 !   les ratqs sont une combinaison de ratqss et ratqsc
-       if(prt_level>=9) write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
-
-         if (tau_ratqs>1.e-10) then
+       IF(prt_level>=9) WRITE(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
+
+         if (tau_ratqs>1.e-10) THEN
             facteur=exp(-pdtphys/tau_ratqs)
          else
@@ -263,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(:,:)
@@ -271,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90	(revision 5116)
@@ -61,5 +61,5 @@
 REAL :: taup0 = 70000
 REAL :: taudp = 500
-integer :: lev_out=10
+INTEGER :: lev_out=10
 REAL, DIMENSION (klon,klev) :: zmasse,entr0,detr0,detraincv,dqp,detrain_p,q0,qd0,tau_diss
 REAL, DIMENSION (klon,klev+1) :: fm0
@@ -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
@@ -172,5 +172,5 @@
                  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
@@ -195,5 +195,5 @@
       do k=1,klev
         do i=1,klon
-           if(q_seri(i,k)>=1E-7) then
+           IF(q_seri(i,k)>=1E-7) THEN
                ratqs_inter_(i,k) = abs(povariance(i,k))**0.5/q_seri(i,k)    
                sigma_therm(i,k) = abs(varq_therm(i,k))**0.5     ! sigma dans les thermiques
@@ -205,5 +205,5 @@
       enddo
       
-return
+RETURN
 end             
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90	(revision 5116)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5116)
@@ -103,5 +103,5 @@
       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 :: zdp
       real, dimension(ngrid) :: alp_int,dp_int
       real, dimension(ngrid) :: fm_tot
@@ -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)
@@ -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)
@@ -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)
@@ -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.
@@ -399,5 +399,5 @@
       do l=2,nlay
         do ig=1,ngrid
-           if(l<=lmax(ig)) THEN
+           IF(l<=lmax(ig)) THEN
            zdp=pplay(ig,l-1)-pplay(ig,l)
            alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l)*zdp
@@ -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
@@ -424,5 +424,5 @@
 
 
-      return
+      RETURN
       end
 END MODULE lmdz_thermcell_alp
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90	(revision 5116)
@@ -40,8 +40,8 @@
     real, dimension(ngrid, nlay + 1) :: fup, fdn, fc, fthu, fthd, fthe, fthtot
     real, dimension(ngrid, nlay) :: tracu, tracd, traci, tracold
-    real :: www, mstar_inv
+    REAL :: www, mstar_inv
     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
+    INTEGER :: iflag_impl = 1 ! 0 pour explicite, 1 pour implicite "classique", 2 pour implicite avec entrainement et detrainement
 
     fdn(:, :) = 0.
@@ -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
@@ -126,10 +126,10 @@
     !Boucle pour calculer le flux du traceur flux updraft, flux downdraft, flux compensatoire
     !Methode explicite :
-    if(iflag_impl==0) then
+    IF(iflag_impl==0) THEN
       do ilay = 2, nlay, 1
         do ig = 1, ngrid
           !!!!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)
@@ -152,6 +152,6 @@
 
       !!! Reecriture du schéma explicite avec les notations du schéma implicite
-    else if(iflag_impl==-1) then
-      write(*, *) 'nouveau schéma explicite !!!'
+    else IF(iflag_impl==-1) THEN
+      WRITE(*, *) 'nouveau schéma explicite !!!'
       !!! Calcul de s1
       do ilay = 1, nlay
@@ -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,6 +193,6 @@
       do ilay = nlay - 1, 1, -1
         do ig = 1, ngrid
-          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
+          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)
           else
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dq.F90	(revision 5116)
@@ -44,6 +44,5 @@
 
     ! Old explicite scheme
-    IF (impl<=-1) then
-
+    IF (impl<=-1) THEN
       CALL thermcell_dq_o(ngrid, nlay, impl, ptimestep, fm, entr, &
               masse, q, dq, qa, lev_out)
@@ -58,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'
@@ -76,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.
@@ -82,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
@@ -99,5 +98,5 @@
         do ig = 1, ngrid
           if ((fm(ig, k + 1) + detr(ig, k)) * ptimestep>  &
-                  1.e-5 * masse(ig, k)) then
+                  1.e-5 * masse(ig, k)) THEN
             qa(ig, k) = (fm(ig, k) * qa(ig, k - 1) + entr(ig, k) * q(ig, k))  &
                     / (fm(ig, k + 1) + detr(ig, k))
@@ -105,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
@@ -122,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)) &
@@ -201,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'
@@ -231,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.
@@ -237,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
@@ -254,5 +253,5 @@
         do ig = 1, ngrid
           if ((fm(ig, k + 1) + detr(ig, k)) * ztimestep>  &
-                  1.e-5 * masse(ig, k)) then
+                  1.e-5 * masse(ig, k)) THEN
             qa(ig, k) = (fm(ig, k) * qa(ig, k - 1) + entr(ig, k) * q(ig, k))  &
                     / (fm(ig, k + 1) + detr(ig, k))
@@ -260,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
@@ -282,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
@@ -292,5 +291,5 @@
 #endif
 
-          if (wqd(ig, k)<0.) then
+          if (wqd(ig, k)<0.) THEN
             !               PRINT*,'wqd<0!!!'
           endif
@@ -309,5 +308,5 @@
                   - wqd(ig, k) + wqd(ig, k + 1))  &
                   * ztimestep / masse(ig, k)
-          !            if (dq(ig,k).lt.0.) then
+          !            if (dq(ig,k).lt.0.) THEN
           !               PRINT*,'dq<0!!!'
           !            endif
@@ -326,5 +325,5 @@
     enddo
 
-    return
+    RETURN
   end
 END MODULE lmdz_thermcell_dq
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90	(revision 5116)
@@ -73,6 +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.
@@ -93,6 +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)
@@ -104,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'
@@ -112,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))
@@ -119,5 +117,5 @@
 !            endif
 !CR:zmax continu 06/05/12: calcul de linter quand le thermique est stoppe par le detrainement
-            elseif (f_star(ig,l+1)<0.) then
+            elseif (f_star(ig,l+1)<0.) THEN
                linter(ig)=(l*(f_star(ig,l+1)-f_star(ig,l))  &
              -f_star(ig,l))/(f_star(ig,l+1)-f_star(ig,l))
@@ -128,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
@@ -144,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90	(revision 5116)
@@ -27,5 +27,5 @@
 
 
-      real :: zzm
+      REAL :: zzm
 
       integer ig,k
@@ -70,9 +70,9 @@
 
 
-    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>  &
-           1.e-5*masse(ig,k)) then
+           1.e-5*masse(ig,k)) THEN
          qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
            /(fm(ig,k+1)+detr(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
@@ -120,5 +120,5 @@
 END DO
 
-      return
+      RETURN
       end
 END MODULE lmdz_thermcell_dtke
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 5116)
@@ -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)) )  &
@@ -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)
@@ -177,5 +177,5 @@
 !----------------------
 
-   if(prt_level>=10) then
+   IF(prt_level>=10) THEN
       do k=1,nlay
          do ig=1,ngrid
@@ -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'
@@ -193,5 +193,5 @@
      endif
 
-      return
+      RETURN
       end
 END MODULE lmdz_thermcell_dv2
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90	(revision 5116)
@@ -70,12 +70,12 @@
     fm(:, :) = 0.
 
-    if (prt_level>=10) then
-      write(lunout1, *) 'Dans thermcell_flux 0'
-      write(lunout1, *) 'flux base ', f(igout)
-      write(lunout1, *) 'lmax ', lmax(igout)
-      write(lunout1, *) 'lalim ', lalim(igout)
-      write(lunout1, *) 'ig= ', igout
-      write(lunout1, *) ' l E*    A*     D*  '
-      write(lunout1, '(i4,3e15.5)') (l, entr_star(igout, l), alim_star(igout, l), detr_star(igout, l) &
+    if (prt_level>=10) THEN
+      WRITE(lunout1, *) 'Dans thermcell_flux 0'
+      WRITE(lunout1, *) 'flux base ', f(igout)
+      WRITE(lunout1, *) 'lmax ', lmax(igout)
+      WRITE(lunout1, *) 'lalim ', lalim(igout)
+      WRITE(lunout1, *) 'ig= ', igout
+      WRITE(lunout1, *) ' l E*    A*     D*  '
+      WRITE(lunout1, '(i4,3e15.5)') (l, entr_star(igout, l), alim_star(igout, l), detr_star(igout, l) &
               , l = 1, lmax(igout))
     endif
@@ -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,12 +124,12 @@
     enddo
 
-    if (prt_level>=10) then
-      write(lunout1, *) 'Dans thermcell_flux 1'
-      write(lunout1, *) 'flux base ', f(igout)
-      write(lunout1, *) 'lmax ', lmax(igout)
-      write(lunout1, *) 'lalim ', lalim(igout)
-      write(lunout1, *) 'ig= ', igout
-      write(lunout1, *) ' l   E    D     W2'
-      write(lunout1, '(i4,3e15.5)') (l, entr(igout, l), detr(igout, l) &
+    if (prt_level>=10) THEN
+      WRITE(lunout1, *) 'Dans thermcell_flux 1'
+      WRITE(lunout1, *) 'flux base ', f(igout)
+      WRITE(lunout1, *) 'lmax ', lmax(igout)
+      WRITE(lunout1, *) 'lalim ', lalim(igout)
+      WRITE(lunout1, *) 'ig= ', igout
+      WRITE(lunout1, *) ' l   E    D     W2'
+      WRITE(lunout1, '(i4,3e15.5)') (l, entr(igout, l), detr(igout, l) &
               , zw2(igout, l + 1), l = 1, lmax(igout))
     endif
@@ -138,7 +138,7 @@
     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
+        elseif(l==lmax(ig)) THEN
           fm(ig, l + 1) = 0.
           detr(ig, l) = fm(ig, l) + entr(ig, l)
@@ -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,7 +182,7 @@
 
       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
+        elseif(l==lmax(ig)) THEN
           fm(ig, l + 1) = 0.
           detr(ig, l) = fm(ig, l) + entr(ig, l)
@@ -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
@@ -209,5 +209,5 @@
 
       if (prt_level>=10) &
-              write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
+              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
+                  .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
@@ -234,5 +234,5 @@
 
       if (prt_level>=10) &
-              write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
+              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)
@@ -255,5 +255,5 @@
 
       if (prt_level>=10) &
-              write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
+              WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
 
@@ -263,11 +263,10 @@
       !-------------------------------------------------------------------------
 
-      if(1==1) then
-
+      IF(1==1) THEN
         !     do l=1,nlay
 
         labort_physic = .FALSE.
         do ig = 1, ngrid
-          if (entr(ig, l)<0.) then
+          if (entr(ig, l)<0.) THEN
             labort_physic = .TRUE.
             igout = ig
@@ -276,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'
@@ -283,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)
@@ -291,5 +290,5 @@
             ! detrainement est plus fort que le flux de masse, on stope le thermique.
             !test:on commente
-            !               if (l.gt.lalim(ig)) then
+            !               if (l.gt.lalim(ig)) THEN
             !                  lmax(ig)=l
             !                  fm(ig,l+1)=0.
@@ -300,5 +299,5 @@
           endif
 
-          if(l>lmax(ig)) then
+          IF(l>lmax(ig)) THEN
             detr(ig, l) = 0.
             fm(ig, l + 1) = 0.
@@ -309,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)
@@ -328,5 +327,5 @@
 
       if (prt_level>=10) &
-              write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
+              WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
 
@@ -337,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.
@@ -346,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)
@@ -362,5 +361,5 @@
 
       if (prt_level>=10) &
-              write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
+              WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
 
@@ -386,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
@@ -402,5 +401,5 @@
 
       if (prt_level>=10) &
-              write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
+              WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &
                       entr(igout, l), detr(igout, l), fm(igout, l + 1)
 
@@ -418,5 +417,5 @@
     !-----------------------------------------------------------------------
 
-    if (1==1) then
+    if (1==1) THEN
       labort_physic = .FALSE.
       do l = 1, nlay - 1
@@ -426,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)
@@ -436,8 +435,8 @@
               !   l'entrainement est trop fort mais l'exces doit etre compense en partie
               !   par un entrainement plus fort dans la couche superieure
-              if(l==lmax(ig)) then
+              IF(l==lmax(ig)) THEN
                 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
@@ -453,5 +452,5 @@
         enddo
       enddo
-      if (labort_physic) then
+      if (labort_physic) THEN
         ig = igout
         l = lout
@@ -488,6 +487,5 @@
 
     !IM 090508 beg
-    !     if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then
-
+    !     if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) THEN
     !         PRINT*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',&
     !   &     ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', &
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90	(revision 5116)
@@ -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
@@ -82,6 +82,6 @@
       enddo
 
-!     if (iflag_thermals_ed.ge.1) then
-      if (1==0) then
+!     if (iflag_thermals_ed.ge.1) 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,5 +128,5 @@
 ! 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)))  &
@@ -134,6 +134,5 @@
           -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))  &
           *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig)))))>1e-10)  &
-          then
-
+          THEN
             zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))  &
           *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)  &
@@ -152,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'
@@ -162,5 +161,5 @@
          do l=1,nlay
             if (zmix(ig)>=zlev(ig,l).and.  &
-            zmix(ig)<zlev(ig,l+1)) then
+            zmix(ig)<zlev(ig,l+1)) THEN
               lmix(ig)=l
              endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90	(revision 5116)
@@ -56,5 +56,5 @@
 
 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
@@ -101,34 +101,34 @@
 
 
-write(lunout,*) 'thermcell_ini ,prt_level                =',  prt_level                   
-write(lunout,*) 'thermcell_ini ,RG                       =',  RG                      
-write(lunout,*) 'thermcell_ini ,RD                       =',  RD                       
-write(lunout,*) 'thermcell_ini ,RCPD                     =',  RCPD                    
-write(lunout,*) 'thermcell_ini ,RKAPPA                   =',  RKAPPA                  
-write(lunout,*) 'thermcell_ini ,RLVTT                    =',  RLVTT                   
-write(lunout,*) 'thermcell_ini ,RLvCp                    =',  RLvCp                   
-write(lunout,*) 'thermcell_ini ,RETV                     =',  RETV                    
-write(lunout,*) 'thermcell_ini ,tau_thermals             =',  tau_thermals            
-write(lunout,*) 'thermcell_ini ,lunout                   =',  lunout                  
-write(lunout,*) 'thermcell_ini ,r_aspect_thermals        =',  r_aspect_thermals       
-write(lunout,*) 'thermcell_ini ,tau_thermals             =',  tau_thermals            
-write(lunout,*) 'thermcell_ini ,fact_thermals_ed_dz      =',  fact_thermals_ed_dz
-write(lunout,*) 'thermcell_ini ,fact_thermals_ed_dz      =',  fact_thermals_ed_dz
-write(lunout,*) 'thermcell_ini ,iflag_thermals_ed        =',  iflag_thermals_ed       
-write(lunout,*) 'thermcell_ini ,iflag_thermals_optflux   =',  iflag_thermals_optflux
-write(lunout,*) 'thermcell_ini ,iflag_thermals_closure   =',  iflag_thermals_closure
-write(lunout,*) 'thermcell_ini ,iflag_thermals_down      =',  iflag_thermals_down
-write(lunout,*) 'thermcell_ini ,fact_thermals_down       =',  fact_thermals_down
-write(lunout,*) 'thermcell_ini ,fact_epsilon             =',  fact_epsilon            
-write(lunout,*) 'thermcell_ini ,betalpha                 =',  betalpha                
-write(lunout,*) 'thermcell_ini ,afact                    =',  afact                   
-write(lunout,*) 'thermcell_ini ,fact_shell               =',  fact_shell              
-write(lunout,*) 'thermcell_ini ,detr_min                 =',  detr_min                
-write(lunout,*) 'thermcell_ini ,entr_min                 =',  entr_min                
-write(lunout,*) 'thermcell_ini ,detr_q_coef              =',  detr_q_coef             
-write(lunout,*) 'thermcell_ini ,detr_q_power             =',  detr_q_power            
-write(lunout,*) 'thermcell_ini ,mix0                     =',  mix0                    
-write(lunout,*) 'thermcell_ini ,thermals_flag_alim       =',  thermals_flag_alim
-write(lunout,*) 'thermcell_ini ,iflag_thermals_tenv      =',  iflag_thermals_tenv
+WRITE(lunout,*) 'thermcell_ini ,prt_level                =',  prt_level
+WRITE(lunout,*) 'thermcell_ini ,RG                       =',  RG
+WRITE(lunout,*) 'thermcell_ini ,RD                       =',  RD
+WRITE(lunout,*) 'thermcell_ini ,RCPD                     =',  RCPD
+WRITE(lunout,*) 'thermcell_ini ,RKAPPA                   =',  RKAPPA
+WRITE(lunout,*) 'thermcell_ini ,RLVTT                    =',  RLVTT
+WRITE(lunout,*) 'thermcell_ini ,RLvCp                    =',  RLvCp
+WRITE(lunout,*) 'thermcell_ini ,RETV                     =',  RETV
+WRITE(lunout,*) 'thermcell_ini ,tau_thermals             =',  tau_thermals
+WRITE(lunout,*) 'thermcell_ini ,lunout                   =',  lunout
+WRITE(lunout,*) 'thermcell_ini ,r_aspect_thermals        =',  r_aspect_thermals
+WRITE(lunout,*) 'thermcell_ini ,tau_thermals             =',  tau_thermals
+WRITE(lunout,*) 'thermcell_ini ,fact_thermals_ed_dz      =',  fact_thermals_ed_dz
+WRITE(lunout,*) 'thermcell_ini ,fact_thermals_ed_dz      =',  fact_thermals_ed_dz
+WRITE(lunout,*) 'thermcell_ini ,iflag_thermals_ed        =',  iflag_thermals_ed
+WRITE(lunout,*) 'thermcell_ini ,iflag_thermals_optflux   =',  iflag_thermals_optflux
+WRITE(lunout,*) 'thermcell_ini ,iflag_thermals_closure   =',  iflag_thermals_closure
+WRITE(lunout,*) 'thermcell_ini ,iflag_thermals_down      =',  iflag_thermals_down
+WRITE(lunout,*) 'thermcell_ini ,fact_thermals_down       =',  fact_thermals_down
+WRITE(lunout,*) 'thermcell_ini ,fact_epsilon             =',  fact_epsilon
+WRITE(lunout,*) 'thermcell_ini ,betalpha                 =',  betalpha
+WRITE(lunout,*) 'thermcell_ini ,afact                    =',  afact
+WRITE(lunout,*) 'thermcell_ini ,fact_shell               =',  fact_shell
+WRITE(lunout,*) 'thermcell_ini ,detr_min                 =',  detr_min
+WRITE(lunout,*) 'thermcell_ini ,entr_min                 =',  entr_min
+WRITE(lunout,*) 'thermcell_ini ,detr_q_coef              =',  detr_q_coef
+WRITE(lunout,*) 'thermcell_ini ,detr_q_power             =',  detr_q_power
+WRITE(lunout,*) 'thermcell_ini ,mix0                     =',  mix0
+WRITE(lunout,*) 'thermcell_ini ,thermals_flag_alim       =',  thermals_flag_alim
+WRITE(lunout,*) 'thermcell_ini ,iflag_thermals_tenv      =',  iflag_thermals_tenv
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90	(revision 5116)
@@ -197,5 +197,5 @@
 
     !PRINT*,'thermcell_main debut'
-    !     write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
+    !     WRITE(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
     do ig = 1, ngrid
       f0(ig) = max(f0(ig), 1.e-2)
@@ -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,6 +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)
@@ -315,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
@@ -412,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, &
@@ -420,5 +419,5 @@
               , lev_out, lunout1, igout)
 
-    elseif (iflag_thermals_ed<=19) then
+    elseif (iflag_thermals_ed<=19) THEN
       !        PRINT*,'THERM RIO et al 2010, version d Arnaud'
       CALL thermcell_plume_5B(itap, ngrid, nlay, ptimestep, ztv, zthl, p_o, zl, rhobarz, &
@@ -441,10 +440,10 @@
 
     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)
-      write(lunout1, *) 'lalim ', lalim(igout)
-      write(lunout1, *) ' ig l alim_star entr_star detr_star f_star '
-      write(lunout1, '(i6,i4,4e15.5)') (igout, l, alim_star(igout, l), entr_star(igout, l), detr_star(igout, l) &
+    if (prt_level>=10) THEN
+      WRITE(lunout1, *) 'Dans thermcell_main 2'
+      WRITE(lunout1, *) 'lmin ', lmin(igout)
+      WRITE(lunout1, *) 'lalim ', lalim(igout)
+      WRITE(lunout1, *) ' ig l alim_star entr_star detr_star f_star '
+      WRITE(lunout1, '(i6,i4,4e15.5)') (igout, l, alim_star(igout, l), entr_star(igout, l), detr_star(igout, l) &
               , f_star(igout, l + 1), l = 1, nint(linter(igout)) + 5)
     endif
@@ -482,10 +481,10 @@
 
     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)
-      write(lunout1, *) 'lalim ', lalim(igout)
-      write(lunout1, *) ' ig l alim_star entr_star detr_star f_star '
-      write(lunout1, '(i6,i4,e15.5)') (igout, l, alim_star(igout, l) &
+    if (prt_level>=10) THEN
+      WRITE(lunout1, *) 'Dans thermcell_main 1b'
+      WRITE(lunout1, *) 'lmin ', lmin(igout)
+      WRITE(lunout1, *) 'lalim ', lalim(igout)
+      WRITE(lunout1, *) ' ig l alim_star entr_star detr_star f_star '
+      WRITE(lunout1, '(i6,i4,e15.5)') (igout, l, alim_star(igout, l) &
               , l = 1, lalim(igout) + 4)
     endif
@@ -500,6 +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)
@@ -508,6 +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)
@@ -517,7 +514,7 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-    if(prt_level>=1)PRINT*, 'thermcell_closure apres thermcell_closure'
-
-    if (tau_thermals>1.) then
+    IF(prt_level>=1)PRINT*, 'thermcell_closure apres thermcell_closure'
+
+    if (tau_thermals>1.) THEN
       lambda = exp(-ptimestep / tau_thermals)
       f0 = (1. - lambda) * f + lambda * f0
@@ -527,5 +524,5 @@
 
     ! Test valable seulement en 1D mais pas genant
-    if (.not. (f0(1)>=0.)) then
+    if (.not. (f0(1)>=0.)) THEN
       abort_message = '.not. (f0(1).ge.0.)'
       CALL abort_physic (modname, abort_message, 1)
@@ -552,5 +549,5 @@
     !------------------------------------------------------------------
 
-    if (tau_thermals>1.) then
+    if (tau_thermals>1.) THEN
       lambda = exp(-ptimestep / tau_thermals)
       fm0 = (1. - lambda) * fm + lambda * fm0
@@ -572,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
@@ -635,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')
@@ -641,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')
@@ -647,5 +644,5 @@
         enddo
       enddo !DO  ll=1,nlay 
-      write(*,*) 'thermcell_main 600 tmp: apres thermcell_dq'
+      WRITE(*,*) 'thermcell_main 600 tmp: apres thermcell_dq'
 #endif      
 #endif
@@ -657,6 +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
@@ -691,5 +687,5 @@
     !calcul de fraca pour les sorties
 
-    if (sorties) then
+    if (sorties) THEN
       if (prt_level>=1) PRINT*, '14a OK convect8'
       ! calcul du niveau de condensation
@@ -709,5 +705,5 @@
         do ig = 1, ngrid
           if ((pcon(ig)<=pplay(ig, k))  &
-                  .and.(pcon(ig)>pplay(ig, k + 1))) then
+                  .and.(pcon(ig)>pplay(ig, k + 1))) THEN
             zcon2(ig) = zlay(ig, k) - (pcon(ig) - pplay(ig, k)) / (RG * rho(ig, k)) / 100.
           endif
@@ -717,10 +713,10 @@
       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
         endif
       enddo
-      !      if (ierr==1) then
+      !      if (ierr==1) THEN
       !           abort_message = 'thermcellV0_main: les thermiques vont trop haut '
       !           CALL abort_physic (modname,abort_message,1)
@@ -730,5 +726,5 @@
       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)
@@ -749,5 +745,5 @@
       enddo
       if (prt_level>=1) PRINT*, '14d OK convect8'
-      if (prt_level>=10)write(lunout, *)                                &
+      if (prt_level>=10)WRITE(lunout, *)                                &
               'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
       do l = 1, nlay
@@ -757,5 +753,5 @@
 
           thetath2(ig, l) = zf2 * (ztla(ig, l) - zthl(ig, l))**2
-          if(zw2(ig, l)>1.e-10) then
+          IF(zw2(ig, l)>1.e-10) THEN
             wth2(ig, l) = zf2 * (zw2(ig, l))**2
           else
@@ -786,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
@@ -796,5 +792,5 @@
       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)
@@ -843,15 +839,15 @@
     !  test sur la hauteur des thermiques ...
     do i = 1, ngrid
-      !IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
-      if (prt_level>=10) then
+      !IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) 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'
         do k = 1, nlay
-          write(6, '(i3,7f10.3)') k, pplay(i, k), ztv(i, k), 1000 * p_o(i, k), ztva(i, k), 1000 * zqla(i, k), f_star(i, k), zw2(i, k)
+          WRITE(6, '(i3,7f10.3)') k, pplay(i, k), ztv(i, k), 1000 * p_o(i, k), ztva(i, k), 1000 * zqla(i, k), f_star(i, k), zw2(i, k)
         enddo
       endif
     enddo
 
-    return
+    RETURN
   end
 
@@ -927,9 +923,9 @@
     !!!
 
-    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>  &
-                  1.e-5 * masse(ig, k)) then
+                  1.e-5 * masse(ig, k)) THEN
             qa(ig, k) = (fm(ig, k) * qa(ig, k - 1) + entr(ig, k) * q(ig, k))  &
                     / (fm(ig, k + 1) + detr(ig, k))
@@ -937,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
@@ -951,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
@@ -974,5 +970,5 @@
     therm_tke_max(:, :) = q(:, :)
 
-    return
+    RETURN
     !!! fin nrlmd le 10/04/2012
   end
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_old.F90	(revision 5116)
@@ -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,5 +388,5 @@
         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)
@@ -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)
@@ -452,14 +452,14 @@
     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)
@@ -667,9 +667,9 @@
   ! do l=1,nlay
   ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! IF(abs(pdtadj(ig,l))*86400..gt.500.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
   ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
@@ -708,5 +708,5 @@
 
 
-  ! if(wa_moy(1,4).gt.1.e-10) stop
+  ! IF(wa_moy(1,4).gt.1.e-10) stop
 
   ! PRINT*,'19 OK convect8'
@@ -1013,5 +1013,5 @@
         ! si sature: ql est surestime, d'ou la sous-relax
         dt = 0.5*rlvcp*qlbef
-        ! write(18,*) 'DT0=',DT
+        ! WRITE(18,*) 'DT0=',DT
         ! on pourra enchainer 2 ou 3 calculs sans Do while
         DO WHILE (abs(dt)>ddt0)
@@ -1241,5 +1241,5 @@
   ! pas de thermique si couche 1 stable
   DO ig = 1, ngrid
-    ! if (lmin(ig).gt.1) then
+    ! if (lmin(ig).gt.1) THEN
     ! CRnouveau test
     IF (alim_star(ig,1)<1.E-10) THEN
@@ -1427,5 +1427,5 @@
           entr_star(ig, l) - detr_star(ig, l)
         ! test
-        ! if (f_star(ig,l+1).lt.0.) then
+        ! if (f_star(ig,l+1).lt.0.) THEN
         ! f_star(ig,l+1)=0.
         ! entr_star(ig,l)=0.
@@ -1434,10 +1434,10 @@
         ! test sur le signe de f_star
         IF (f_star(ig,l+1)>1.E-10) THEN
-          ! then
+          ! THEN
           ! test
-          ! if (((f_star(ig,l+1)+detr_star(ig,l)).gt.1.e-10)) then
+          ! if (((f_star(ig,l+1)+detr_star(ig,l)).gt.1.e-10)) THEN
           ! AM on melange Tl et qt du thermique
           ! on rajoute un excès de T dans la couche alim
-          ! if (l.lt.lentr(ig)) then
+          ! if (l.lt.lentr(ig)) THEN
           ! ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+
           ! s
@@ -1450,5 +1450,5 @@
           ! endif
           ! on rajoute un excès de q dans la couche alim
-          ! if (l.lt.lentr(ig)) then
+          ! if (l.lt.lentr(ig)) THEN
           ! zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+
           ! s           (alim_star(ig,l)+entr_star(ig,l))*(po(ig,l)+0.001))
@@ -1473,5 +1473,5 @@
             qlbef = max(0., zqta(ig,l)-qsatbef(ig))
             dt = 0.5*rlvcp*qlbef
-            ! write(17,*)'DT0=',DT
+            ! WRITE(17,*)'DT0=',DT
             DO WHILE (abs(dt)>ddt0)
               ! PRINT*,'aie'
@@ -1494,5 +1494,5 @@
               END IF
               dt = num/denom
-              ! write(17,*)'DT=',DT
+              ! WRITE(17,*)'DT=',DT
             END DO
             zqla(ig, l) = max(0., zqta(ig,l)-qsatbef(ig))
@@ -1509,5 +1509,5 @@
           ! on rajoute le calcul de zha pour diagnostiques (temp potentielle)
           zha(ig, l) = ztva(ig, l)
-          ! if (l.lt.lentr(ig)) then
+          ! if (l.lt.lentr(ig)) THEN
           ! ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)
           ! s              -zqla(ig,l))-zqla(ig,l)) + 0.1
@@ -1523,5 +1523,5 @@
           ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
           ! s              -zqla(ig,l)/(1.-retv*zqla(ig,l)))
-          ! write(13,*)zqla(ig,l),zqla(ig,l)/(1.-retv*zqla(ig,l))
+          ! WRITE(13,*)zqla(ig,l),zqla(ig,l)/(1.-retv*zqla(ig,l))
           ! on ecrit zqsat
           zqsatth(ig, l) = qsatbef(ig)
@@ -1529,9 +1529,9 @@
           ! DO ig=1,ngrid
           ! if (zw2(ig,l).ge.1.e-10.and.
-          ! s               f_star(ig,l)+entr_star(ig,l).gt.1.e-10) then
+          ! 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
           ! consideree commence avec une vitesse nulle).
 
-          ! if (f_star(ig,l+1).gt.1.e-10) then
+          ! if (f_star(ig,l+1).gt.1.e-10) THEN
           zw2(ig, l+1) = zw2(ig, l)* & ! s
                                        ! ((f_star(ig,l)-detr_star(ig,l))**2)
@@ -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)
@@ -1683,5 +1683,5 @@
   ! do ig=1,ngrid
   ! do l=1,lentr(ig)
-  ! if ((alim(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
+  ! if ((alim(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) THEN
   ! alim(ig,l+1)=alim(ig,l+1)+alim(ig,l)
   ! s                       -0.9*masse(ig,l)/ptimestep
@@ -1709,5 +1709,5 @@
   ! do l=1,klev
   ! if (((detr(ig,l)+entr(ig,l)+alim(ig,l))*ptimestep).gt.
-  ! s          (masse(ig,l))) then
+  ! s          (masse(ig,l))) THEN
   ! 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)
@@ -1732,5 +1732,5 @@
         ! 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)
@@ -1738,5 +1738,5 @@
       ! endif
 
-      ! 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)
@@ -1745,6 +1745,5 @@
       ! 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
@@ -1783,5 +1782,5 @@
 
       ! test pour ne pas avoir f=0 et d=e/=0
-      ! if (fmc(ig,l+1).lt.1.e-10) then
+      ! if (fmc(ig,l+1).lt.1.e-10) THEN
       ! detr(ig,l+1)=0.
       ! entr(ig,l+1)=0.
@@ -1803,5 +1802,5 @@
         END IF
       END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+      ! WRITE(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
       ! endif test
       ! endif
@@ -1809,5 +1808,5 @@
   END DO
   DO ig = 1, ngrid
-    ! if (fmc(ig,lmax(ig)+1).ne.0.) then
+    ! if (fmc(ig,lmax(ig)+1).ne.0.) THEN
     fmc(ig, lmax(ig)+1) = 0.
     entr(ig, lmax(ig)) = 0.
@@ -1933,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
@@ -1945,11 +1944,11 @@
           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)
@@ -2045,7 +2044,7 @@
             THEN
           fm(ig, l) = fm(ig, l-1)
-          ! write(1,*)'ajustement fm, l',l
+          ! WRITE(1,*)'ajustement fm, l',l
         END IF
-        ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+        ! WRITE(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
         ! RC
       END IF
@@ -2140,5 +2139,5 @@
           fm(ig, l+1) = fm(ig, l) + alim(ig, l)
           detr(ig, l) = 0.
-          ! write(11,*)'l,ig,entr',l,ig,entr(ig,l)
+          ! WRITE(11,*)'l,ig,entr',l,ig,entr(ig,l)
           ! PRINT*,'WARNING !!! detrainement negatif ',ig,l
         END IF
@@ -2213,9 +2212,9 @@
   ! do l=1,nlay
   ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! IF(abs(pdtadj(ig,l))*86400..gt.500.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
   ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
@@ -2259,5 +2258,5 @@
           zcon(ig) = zlev(ig, k)
         END IF
-        ! if (zcon(ig).gt.1.e-10) then
+        ! if (zcon(ig).gt.1.e-10) THEN
         ! nuage=.TRUE.
         ! else
@@ -2278,5 +2277,5 @@
         q2(ig, l) = zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
         ! test: on calcul q2/po=ratqsc
-        ! if (nuage) then
+        ! if (nuage) THEN
         ratqscth(ig, l) = sqrt(q2(ig,l))/(po(ig,l)*1000.)
         ! else
@@ -2306,5 +2305,5 @@
       DO ig = 1, ngrid
         ratqsdiff(ig, l) = sqrt(sumdiff)/(po(ig,l)*1000.)
-        ! write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
+        ! WRITE(11,*)'ratqsdiff=',ratqsdiff(ig,l)
       END DO
     END DO
@@ -2980,14 +2979,14 @@
     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)
@@ -3094,7 +3093,7 @@
       IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
         fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+        ! WRITE(1,*)'ajustement fm, l',l
+      END IF
+      ! WRITE(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
       ! RC
     END DO
@@ -3228,9 +3227,9 @@
   ! do l=1,nlay
   ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! IF(abs(pdtadj(ig,l))*86400..gt.500.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
   ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
@@ -3709,5 +3708,5 @@
         entr_star_tot(ig)
       ! test
-      ! if (first) then
+      ! if (first) THEN
       ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
       ! s             *wmax(ig))
@@ -3758,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
@@ -3764,11 +3763,11 @@
         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)
@@ -3897,7 +3896,7 @@
       IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
         fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+        ! WRITE(1,*)'ajustement fm, l',l
+      END IF
+      ! WRITE(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
       ! RC
     END DO
@@ -4038,9 +4037,9 @@
   ! do l=1,nlay
   ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! IF(abs(pdtadj(ig,l))*86400..gt.500.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
   ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
@@ -4068,5 +4067,5 @@
     ! do ig=1,ngrid
     ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
-    ! if (detr(ig,l).lt.0.) then
+    ! if (detr(ig,l).lt.0.) THEN
     ! entr(ig,l)=entr(ig,l)-detr(ig,l)
     ! detr(ig,l)=0.
@@ -4120,5 +4119,5 @@
   END IF
 
-  ! if(wa_moy(1,4).gt.1.e-10) stop
+  ! IF(wa_moy(1,4).gt.1.e-10) stop
 
   ! PRINT*,'19 OK convect8'
@@ -4211,5 +4210,5 @@
       dq(ig, k) = (detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)-wqd(ig,k)+wqd(ig,k+ &
         1))/masse(ig, k)
-      ! if (dq(ig,k).lt.0.) then
+      ! if (dq(ig,k).lt.0.) THEN
       ! PRINT*,'dq<0!!!'
       ! endif
@@ -4980,5 +4979,5 @@
         entr_star_tot(ig)
       ! test
-      ! if (first) then
+      ! if (first) THEN
       ! f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
       ! s             *wmax(ig))
@@ -5040,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
@@ -5053,11 +5052,11 @@
         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)
@@ -5186,7 +5185,7 @@
       IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
         fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+        ! WRITE(1,*)'ajustement fm, l',l
+      END IF
+      ! WRITE(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
       ! RC
     END DO
@@ -5327,9 +5326,9 @@
   ! do l=1,nlay
   ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! IF(abs(pdtadj(ig,l))*86400..gt.500.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
   ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
@@ -5701,13 +5700,13 @@
   END DO
   ! nouveau test
-  ! if (therm) then
+  ! if (therm) THEN
   DO l = 1, klev - 1
     DO ig = 1, ngrid
       IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lalim(ig) .AND. &
           zalim(ig)>1.E-10) THEN
-        ! if (l.le.lentr(ig)) then
+        ! if (l.le.lentr(ig)) THEN
         ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
         ! s                         /zalim(ig)))**(3./2.)
-        ! write(10,*)zlev(ig,l),entr_star(ig,l)
+        ! WRITE(10,*)zlev(ig,l),entr_star(ig,l)
       END IF
     END DO
@@ -5868,5 +5867,5 @@
   END DO
   DO ig = 1, ngrid
-    ! write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
+    ! WRITE(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
   END DO
   ! on stope après les calculs de zmax et wmax
@@ -5892,5 +5891,5 @@
       ! s            *entr_star_tot(ig)
       ! test
-      ! if (first) then
+      ! if (first) THEN
       f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
       ! endif
@@ -5913,5 +5912,5 @@
   ! do ig=1,ngrid
   ! do l=1,lentr(ig)
-  ! if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
+  ! if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) THEN
   ! entr(ig,l+1)=entr(ig,l+1)+entr(ig,l)
   ! s                       -0.9*masse(ig,l)/ptimestep
@@ -5954,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
@@ -5967,11 +5966,11 @@
         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)
@@ -6100,7 +6099,7 @@
       IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
         fm(ig, l) = fm(ig, l-1)
-        ! write(1,*)'ajustement fm, l',l
-      END IF
-      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+        ! WRITE(1,*)'ajustement fm, l',l
+      END IF
+      ! WRITE(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
       ! RC
     END DO
@@ -6243,9 +6242,9 @@
   ! do l=1,nlay
   ! do ig=1,ngrid
-  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
+  ! IF(abs(pdtadj(ig,l))*86400..gt.500.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdtadj=',pdtadj(ig,l)
   ! endif
-  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
+  ! IF(abs(pdoadj(ig,l))*86400..gt.1.) THEN
   ! PRINT*,'WARN!!! ig=',ig,'  l=',l
   ! s         ,'   pdoadj=',pdoadj(ig,l)
@@ -6273,5 +6272,5 @@
     ! do ig=1,ngrid
     ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
-    ! if (detr(ig,l).lt.0.) then
+    ! if (detr(ig,l).lt.0.) THEN
     ! entr(ig,l)=entr(ig,l)-detr(ig,l)
     ! detr(ig,l)=0.
@@ -6327,5 +6326,5 @@
   END IF
 
-  ! if(wa_moy(1,4).gt.1.e-10) stop
+  ! IF(wa_moy(1,4).gt.1.e-10) stop
 
   ! PRINT*,'19 OK convect8'
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90	(revision 5116)
@@ -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)
@@ -216,5 +216,5 @@
       do ig = 1, ngrid
         !       PRINT*,'active',active(ig),ig,l
-        if(active(ig)) then
+        IF(active(ig)) THEN
           zqla_est(ig, l) = max(0., zqta(ig, l - 1) - zqsat(ig))
           ztva_est(ig, l) = ztla(ig, l - 1) * zpspsk(ig, l) + RLvCp * zqla_est(ig, l)
@@ -284,6 +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)
@@ -302,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)               &
@@ -316,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.
@@ -333,5 +332,5 @@
       activetmp(:) = active(:) .and. f_star(:, l + 1)>1.e-10
       do ig = 1, ngrid
-        if (activetmp(ig)) then
+        if (activetmp(ig)) THEN
           Zsat = .FALSE.
           ztla(ig, l) = (f_star(ig, l) * ztla(ig, l - 1) + &
@@ -348,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
@@ -378,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'
@@ -386,10 +385,10 @@
         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))
           zw2(ig, l + 1) = 0.
           !+CR:04/05/12:correction calcul linter pour calcul de zmax continu
-        elseif (f_star(ig, l + 1)<0.) then
+        elseif (f_star(ig, l + 1)<0.) THEN
           linter(ig) = (l * (f_star(ig, l + 1) - f_star(ig, l))  &
                   - f_star(ig, l)) / (f_star(ig, l + 1) - f_star(ig, l))
@@ -400,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
@@ -411,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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90	(revision 5116)
@@ -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)
@@ -217,5 +217,5 @@
       do ig = 1, ngrid
         !       PRINT*,'active',active(ig),ig,l
-        if(active(ig)) then
+        IF(active(ig)) THEN
           zqla_est(ig, l) = max(0., zqta(ig, l - 1) - zqsat(ig))
           ztva_est(ig, l) = ztla(ig, l - 1) * zpspsk(ig, l) + RLvCp * zqla_est(ig, l)
@@ -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,6 +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
@@ -293,9 +292,9 @@
               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) &
                         + (1. - fact_shell) * zbuoy(ig, l)
-              elseif (zlmelup>=zinv) then
+              elseif (zlmelup>=zinv) THEN
                 ztv_est2 = atv2 * 0.5 * (zlmelup + zinv) + btv2
                 ztv_est1 = atv1 * 0.5 * (zinv + zlmeldwn) + btv1
@@ -312,7 +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)
@@ -330,7 +328,6 @@
               !    &          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
-
-          else  !   if (iflag_thermals_ed.lt.8) 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
             zlt = zlev(ig, lt)
@@ -349,6 +346,5 @@
                     ztv(ig, lt)) / ztv(ig, lt) + (1. - coefzlmel) * (ztva_est(ig, l) - &
                     ztv(ig, lt - 1)) / ztv(ig, lt - 1)) + 0. * zbuoy(ig, l)
-          endif !   if (iflag_thermals_ed.lt.8) then
-
+          endif !   if (iflag_thermals_ed.lt.8) THEN
           !------------------------------------------------
           !AJAM:nouveau calcul de w?
@@ -377,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)* &
@@ -408,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
@@ -431,5 +427,5 @@
           !--------------------------------------------------
 
-          !             if (w_est(ig,l+1).lt.0.) then
+          !             if (w_est(ig,l+1).lt.0.) THEN
           !               w_est(ig,l+1)=zw2(ig,l)
           !                w_est(ig,l+1)=0.0001
@@ -445,6 +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)
@@ -476,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
@@ -513,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
@@ -536,5 +531,5 @@
       activetmp(:) = active(:) .and. f_star(:, l + 1)>1.e-10
       do ig = 1, ngrid
-        if (activetmp(ig)) then
+        if (activetmp(ig)) THEN
           Zsat = .FALSE.
           ztla(ig, l) = (f_star(ig, l) * ztla(ig, l - 1) + &
@@ -551,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
@@ -582,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
@@ -591,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
@@ -620,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'
@@ -628,10 +623,10 @@
         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))
           zw2(ig, l + 1) = 0.
           !+CR:04/05/12:correction calcul linter pour calcul de zmax continu
-        elseif (f_star(ig, l + 1)<0.) then
+        elseif (f_star(ig, l + 1)<0.) THEN
           linter(ig) = (l * (f_star(ig, l + 1) - f_star(ig, l))  &
                   - f_star(ig, l)) / (f_star(ig, l + 1) - f_star(ig, l))
@@ -642,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
@@ -653,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
@@ -772,5 +767,5 @@
 
     ! Initialisations des variables reeles
-    if (1==1) then
+    if (1==1) THEN
       ztva(:, :) = ztv(:, :)
       ztva_est(:, :) = ztva(:, :)
@@ -824,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))
@@ -834,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
@@ -853,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)
@@ -898,5 +893,5 @@
       do ig = 1, ngrid
         !       PRINT*,'active',active(ig),ig,l
-        if(active(ig)) then
+        IF(active(ig)) THEN
           zqla_est(ig, l) = max(0., zqta(ig, l - 1) - zqsat(ig))
           ztva_est(ig, l) = ztla(ig, l - 1) * zpspsk(ig, l) + RLvCp * zqla_est(ig, l)
@@ -916,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
@@ -928,6 +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)
@@ -948,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.
@@ -966,5 +960,5 @@
       activetmp(:) = active(:) .and. f_star(:, l + 1)>1.e-10
       do ig = 1, ngrid
-        if (activetmp(ig)) then
+        if (activetmp(ig)) THEN
           Zsat = .FALSE.
           ztla(ig, l) = (f_star(ig, l) * ztla(ig, l - 1) + &
@@ -982,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
@@ -1010,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'
@@ -1018,9 +1012,9 @@
         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))
           zw2(ig, l + 1) = 0.
-        elseif (f_star(ig, l + 1)<0.) then
+        elseif (f_star(ig, l + 1)<0.) THEN
           linter(ig) = (l * (f_star(ig, l + 1) - f_star(ig, l))  &
                   - f_star(ig, l)) / (f_star(ig, l + 1) - f_star(ig, l))
@@ -1031,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
@@ -1042,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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5116)
@@ -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)))
@@ -95,5 +95,5 @@
 END DO
 
-return
+RETURN
 end
 END MODULE lmdz_thermcell_qsat
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90	(revision 5116)
@@ -623,24 +623,24 @@
   DO k = 1, klev
     DO i = 1, klon
-      ! write(*,*)'wake 1',i,k,RD,tb(i,k)
+      ! WRITE(*,*)'wake 1',i,k,RD,tb(i,k)
       rho(i, k) = p(i, k)/(RD*tb(i,k))
-      ! write(*,*)'wake 2',rho(i,k)
+      ! WRITE(*,*)'wake 2',rho(i,k)
       IF (k==1) THEN
-        ! write(*,*)'wake 3',i,k,rd,tb(i,k)
+        ! WRITE(*,*)'wake 3',i,k,rd,tb(i,k)
         rhoh(i, k) = ph(i, k)/(RD*tb(i,k))
-        ! write(*,*)'wake 4',i,k,rd,tb(i,k)
+        ! WRITE(*,*)'wake 4',i,k,rd,tb(i,k)
         zhh(i, k) = 0
       ELSE
-        ! write(*,*)'wake 5',rd,(tb(i,k)+tb(i,k-1))
+        ! WRITE(*,*)'wake 5',rd,(tb(i,k)+tb(i,k-1))
         rhoh(i, k) = ph(i, k)*2./(RD*(tb(i,k)+tb(i,k-1)))
-        ! write(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
+        ! WRITE(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
         zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG) + zhh(i, k-1)
       END IF
-      ! write(*,*)'wake 7',ppi(i,k)
+      ! WRITE(*,*)'wake 7',ppi(i,k)
       thb(i, k) = tb(i, k)/ppi(i, k)
       thx(i, k) = (tb(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
       tx(i, k) = tb(i, k) - deltatw(i, k)*sigmaw(i)
       qx(i, k) = qb(i, k) - deltaqw(i, k)*sigmaw(i)
-      ! write(*,*)'wake 8',(RD*(tb(i,k)+deltatw(i,k)))
+      ! WRITE(*,*)'wake 8',(RD*(tb(i,k)+deltatw(i,k)))
       dth(i, k) = deltatw(i, k)/ppi(i, k)
     END DO
@@ -1438,9 +1438,9 @@
           ! Jingmei
 
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
+          ! WRITE(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
           ! &  Tgw(i,k),deltatw(i,k)
           d_deltat_gw(i, k) = d_deltat_gw(i, k) - tgw(i, k)*deltatw(i, k)* &
             dtimesub
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
+          ! WRITE(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
           ff(i) = d_deltatw(i, k)/dtimesub
 
@@ -2477,5 +2477,5 @@
 
 
-IF (iflag_wk_new_ptop==0) then
+IF (iflag_wk_new_ptop==0) THEN
     delta_t_min=delta_t_min_in
 else
@@ -2594,5 +2594,5 @@
     ! nouveau calcul de hw et ptop
     ! -----------------------------------------------------------------------
-!if (iflag_wk_new_ptop>0) then
+!if (iflag_wk_new_ptop>0) THEN
 DO i=1,klon
    ptop1(i)=ph(i,1)
@@ -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,6 +2661,6 @@
     ! 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 (1==0) 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.
              ptop(i)=ph(i,1)
@@ -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
@@ -2738,5 +2738,5 @@
 ENDIF ! (iflag_wk_new_ptop/=0)
 
-!if (iflag_wk_new_ptop==2) then
+!if (iflag_wk_new_ptop==2) THEN
 IF (iflag_wk_new_ptop>0) THEN 
    do i=1,klon
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/lsc_scav.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/lsc_scav.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/lsc_scav.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/minmaxqfi.F90	(revision 5116)
@@ -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/nflxtr.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/nflxtr.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/nflxtr.F90	(revision 5116)
@@ -133,5 +133,5 @@
      DO i=1, klon
         zmfe=-zmfu(i,k)-zmfd(i,k)
-        IF (zmfe<=0.) then
+        IF (zmfe<=0.) THEN
            zmfex(i,k)= zmfe*x(i,k)
         ELSE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/nuage.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/nuage.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/nuage.F90	(revision 5116)
@@ -5,5 +5,5 @@
     temp_cltop, cldtaupi, re, fl)
   USE dimphy
-  USE lmdz_lscp_tools, only: icefrac_lscp
+  USE lmdz_lscp_tools, ONLY: icefrac_lscp
   USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
   USE lmdz_lscp_ini, ONLY: iflag_t_glace
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90	(revision 5116)
@@ -17,9 +17,9 @@
     ! 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 nrtype, ONLY: pi
 
     integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
@@ -115,8 +115,8 @@
     ! 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
@@ -167,5 +167,5 @@
     o3_prod = c + b * q + a6_mass * sigma_mass
 
-  end function o3_prod
+  END FUNCTION o3_prod
 
 end module o3_chem_m
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90	(revision 5116)
@@ -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"
@@ -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:
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90	(revision 5116)
@@ -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
@@ -225,5 +225,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!          write(*,*) 'ocean_forced_mod 176: sortie de ocean_forced_noice'
+!          WRITE(*,*) 'ocean_forced_mod 176: sortie de ocean_forced_noice'
     IF (iso_eau > 0) THEN
       DO i = 1, knon               
@@ -463,6 +463,6 @@
 ! isotopes: tout est externalisé
 !#ifdef ISOVERIF
-!        write(*,*) 'ocean_forced_mod 377: CALL calcul_iso_surf_sic_vectall'
-!        write(*,*) 'klon,knon=',klon,knon
+!        WRITE(*,*) 'ocean_forced_mod 377: CALL calcul_iso_surf_sic_vectall'
+!        WRITE(*,*) 'klon,knon=',klon,knon
 !#endif
     CALL calcul_iso_surf_sic_vectall(klon,knon, &
@@ -475,5 +475,5 @@
      )
 #ifdef ISOVERIF
-        !write(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
+        !WRITE(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
     IF (iso_eau > 0) THEN
       DO i = 1, knon  
@@ -482,5 +482,5 @@
              errmax,errmaxrel)
       ENDDO ! DO j=1,knon
-    ENDIF !IF (iso_eau > 0) then
+    ENDIF !IF (iso_eau > 0) THEN
 #endif 
 !#ifdef ISOVERIF
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/orografi.F90	(revision 5116)
@@ -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
@@ -881,5 +881,5 @@
       lo = (ptau(jl, klev + 1)<gtsec) .OR. (kcrit(jl)>=kknu(jl)) .OR. &
               (pvph(jl, klev + 1)<gvcrit)
-      ! if(lo) ptau(jl,klev+1)=0.0
+      ! IF(lo) ptau(jl,klev+1)=0.0
 
     ELSE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/orografi_strato.F90	(revision 5116)
@@ -287,5 +287,5 @@
 
   ! ztmst=twodt
-  ! if(nstep.eq.nstart) ztmst=0.5*twodt
+  ! IF(nstep.eq.nstart) ztmst=0.5*twodt
   ztmst = ptsphy
 
@@ -1036,5 +1036,5 @@
       ! 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
+      ! IF(lo) ptau(jl,klev+1)=0.0
 
       ! print *,jl,ptau(jl,klev+1)
@@ -1048,5 +1048,5 @@
   END DO
 
-  ! write(21)(ptau(jl,klev+1),jl=kidia,kfdia)
+  ! WRITE(21)(ptau(jl,klev+1),jl=kidia,kfdia)
 
 END SUBROUTINE gwstress_strato
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/output_physiqex_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/output_physiqex_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/output_physiqex_mod.F90	(revision 5116)
@@ -35,12 +35,12 @@
 real,intent(in) :: ptke(klon,klev) !tke
 
-real :: t_ops ! frequency of the IOIPSL operations (eg average over...)
-real :: t_wrt ! frequency of the IOIPSL outputs
-integer :: zvertid ! vertical coordinate ID
-real :: dtime
+REAL :: t_ops ! frequency of the IOIPSL operations (eg average over...)
+REAL :: t_wrt ! frequency of the IOIPSL outputs
+INTEGER :: zvertid ! vertical coordinate ID
+REAL :: dtime
 
 integer,save :: iwrite_phys=1 ! output every iwrite_phys physics step
 !$OMP THREADPRIVATE(iwrite_phys)
-integer :: nhori ! horizontal coordinate ID
+INTEGER :: nhori ! horizontal coordinate ID
 integer,save :: nid_hist ! output file ID
 !$OMP THREADPRIVATE(nid_hist)
@@ -53,6 +53,5 @@
 PRINT*,'nnnnnnn ',nid_hist,debut,itau
 
-IF(debut)then
-
+IF(debut)THEN
    CALL getin_p("iwrite_phys",iwrite_phys)
 
@@ -67,5 +66,5 @@
 itau=itau+1
 
-IF (modulo(itau,iwrite_phys)==0) then
+IF (modulo(itau,iwrite_phys)==0) THEN
      CALL iophys_ecrit('temp',klev,'Temperature','K',t)
      CALL iophys_ecrit('u',klev,'zonal wind','m/s',u)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/ozonecm_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/ozonecm_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ozonecm_m.F90	(revision 5116)
@@ -21,6 +21,6 @@
     ! middle atmosphere, Handbook for MAP, vol. 16, 205-229.
 
-    USE dimphy, only: klon, klev
-    use lmdz_assert, only: assert
+    USE dimphy, ONLY: klon, klev
+    use lmdz_assert, ONLY: assert
 
     REAL, INTENT (IN) :: rlat(:) ! (klon)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/paramlmdz_phy_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/paramlmdz_phy_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/paramlmdz_phy_mod.F90	(revision 5116)
@@ -10,8 +10,8 @@
     USE iophy 
     USE dimphy
-    USE ioipsl, only: histbeg, histvert, histdef, histend, ymds2ju
+    USE ioipsl, ONLY: histbeg, histvert, histdef, histend, ymds2ju
     USE lmdz_phys_mpi_data, ONLY: is_mpi_root
     USE lmdz_geometry, ONLY: longitude_deg, latitude_deg
-    USE lmdz_grid_phy, only: nbp_lon, nbp_lat, klon_glo
+    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
     USE time_phylmdz_mod, ONLY: annee_ref, day_ref, itau_phy, pdtphys
     USE lmdz_phys_transfert_para, ONLY: gather, bcast
@@ -145,5 +145,5 @@
     USE lmdz_phys_mpi_data, ONLY: is_mpi_root
     USE time_phylmdz_mod, ONLY: day_step_phy, annee_ref, itau_phy, start_time
-    USE lmdz_grid_phy, only: nbp_lon, nbp_lat, klon_glo
+    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
 
     USE iophy
@@ -230,5 +230,5 @@
       ENDIF
 
-      ENDIF !(is_mpi_root) then      
+      ENDIF !(is_mpi_root) THEN
 !$OMP END MASTER
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5116)
@@ -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
@@ -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
@@ -404,14 +404,14 @@
 #endif
 #ifdef ISOTRAC
-        USE isotrac_mod, only: index_iso
+        USE isotrac_mod, ONLY: index_iso
 #endif
 #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 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 netcdf, only: missing_val_netcdf => nf90_fill_real
+    USE netcdf, ONLY: missing_val_netcdf => nf90_fill_real
 
     IMPLICIT NONE
@@ -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))
@@ -2465,10 +2465,10 @@
 #endif
 #ifdef ISOVERIF
-!        write(*,*) 'pbl_surface_mod 1038: sortie surf_land'
+!        WRITE(*,*) 'pbl_surface_mod 1038: sortie surf_land'
         DO j=1,knon
           IF (iso_eau >= 0) THEN
                  CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
                                     ysnow(j),'pbl_surf_mod 1043')
-          ENDIF !if (iso_eau.gt.0) then
+          ENDIF !if (iso_eau.gt.0) THEN
         ENDDO !DO i=1,klon
 #endif
@@ -2535,5 +2535,5 @@
 #endif
 #ifdef ISOVERIF
-             !write(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
+             !WRITE(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
              do j=1,knon
                IF (iso_eau >= 0) THEN
@@ -2634,5 +2634,5 @@
 #endif
 #ifdef ISOVERIF
-        !write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice'
+        !WRITE(*,*) 'pbl_surface_mod 1077: sortie surf_seaice'
         DO j=1,knon
           IF (iso_eau >= 0) THEN
@@ -3089,5 +3089,5 @@
             !FC
             IF  (nsrf == is_ter .and. ifl_pbltree >= 1) THEN
-              !            if (y_d_u_frein(j,k).ne.0. ) 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, &
@@ -3263,5 +3263,5 @@
           CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
            'pbl_surf_mod 1230',errmax,errmaxrel)
-        ENDIF !if (iso_eau.gt.0) then
+        ENDIF !if (iso_eau.gt.0) THEN
 #endif
 #endif
@@ -3392,5 +3392,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       !write(*,*) 'pbl_surface 2858'
+       !WRITE(*,*) 'pbl_surface 2858'
        DO i = 1, klon
          DO ixt=1,niso
@@ -3404,5 +3404,5 @@
                 y_d_xt,y_d_q, &
                 'pbl_surface_mod 1261',ntraciso,klon,klev)
-     ENDIF !if (iso_eau.gt.0) then
+     ENDIF !if (iso_eau.gt.0) THEN
 #endif
 #endif
@@ -3467,8 +3467,8 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!        write(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19)
-!        write(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
-!        write(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1)
-!        write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
+!        WRITE(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19)
+!        WRITE(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
+!        WRITE(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1)
+!        WRITE(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
         CALL iso_verif_noNaN_vect2D( &
              d_xt, &
@@ -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)
@@ -3873,5 +3873,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!        write(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
+!        WRITE(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
     IF (iso_eau >= 0) THEN
         CALL iso_verif_egalite_vect2D( &
@@ -3968,5 +3968,5 @@
 
     ! if blowing snow
-    if (ok_bs) then
+    if (ok_bs) THEN
       DO nsrf = 1, nbsrf
         DO k = 1, klev
@@ -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 >= 1) THEN
                 if (activate_ocean_skin == 2 &
-                        .and. type_ocean == "couple") then
+                        .and. type_ocean == "couple") THEN
                   delta_sal(i) = 0.
                   delta_sst(i) = 0.
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90	(revision 5116)
@@ -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)
@@ -227,5 +227,5 @@
 
     ! Si alb_ocean on calcule un albedo oceanique moyen
-    ! if (alb_ocean) then
+    ! if (alb_ocean) THEN
     ! Voir pourquoi on avait ca.
     ! CALL ini_alb_oce(phy_alb)
@@ -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_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_mod.F90	(revision 5116)
@@ -10,5 +10,5 @@
   SUBROUTINE phyetat0(fichnom, clesphy0, tabcntr0)
 
-    USE dimphy, only: klon, zmasq, klev
+    USE dimphy, ONLY: klon, zmasq, klev
     USE iophy, ONLY: init_iophy_new
     USE ocean_cpl_mod, ONLY: ocean_cpl_init
@@ -40,6 +40,6 @@
     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 netcdf, ONLY: missing_val_netcdf => nf90_fill_real
+    use config_ocean_skin_m, ONLY: activate_ocean_skin
 
     IMPLICIT none
@@ -307,5 +307,5 @@
     !===================================================================
 
-    if (iflag_physiq <= 1) then
+    if (iflag_physiq <= 1) THEN
       !===================================================================
       ! Lecture des temperatures du sol profond:
@@ -444,9 +444,9 @@
     !==================================
 
-    IF (iflag_pbl>1) then
+    IF (iflag_pbl>1) THEN
       found = phyetat0_srf(pbl_tke, "TKE", "Turb. Kinetic. Energ. ", 1.e-8)
     ENDIF
 
-    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
+    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) THEN
       found = phyetat0_srf(wake_delta_pbl_tke, "DELTATKE", "Del TKE wk/env", 0.)
       !!    found=phyetat0_srf(delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phyredem.F90	(revision 5116)
@@ -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
 
@@ -76,5 +76,5 @@
   ! 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
@@ -167,5 +167,5 @@
     CALL put_field_srf1(pass, "TS", "Temperature", ftsol(:, :))
 
-    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
+    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) THEN
       CALL put_field_srf1(pass, "DELTATS", &
               "w-x surface temperature difference", delta_tsurf(:, :))
@@ -274,5 +274,5 @@
     ! DEB TKE PBL !
 
-    IF (iflag_pbl>1) then
+    IF (iflag_pbl>1) THEN
       CALL put_field_srf3(pass, "TKE", "Energ. Cineti. Turb.", &
               pbl_tke(:, :, :))
@@ -379,6 +379,6 @@
             "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_cal_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_cal_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_cal_mod.F90	(revision 5116)
@@ -71,5 +71,5 @@
     ! This SUBROUTINE updates the module saved variables.
 
-    USE IOIPSL, only: ju2ymds, ymds2ju, ioget_mon_len, ioget_year_len
+    USE IOIPSL, ONLY: ju2ymds, ymds2ju, ioget_mon_len, ioget_year_len
     IMPLICIT NONE
     REAL, INTENT(IN) :: julian_date
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90	(revision 5116)
@@ -42,5 +42,5 @@
     USE surface_data, ONLY: landice_opt
     USE phys_output_ctrlout_mod
-    USE lmdz_grid_phy, only: klon_glo, nbp_lon, nbp_lat
+    USE lmdz_grid_phy, ONLY: klon_glo, nbp_lon, nbp_lat
     USE lmdz_print_control, ONLY: prt_level, lunout
     USE lmdz_vertical_layers, ONLY: ap, bp, preff, presnivs, aps, bps, pseudoalt, presinter
@@ -52,5 +52,5 @@
     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))
@@ -537,5 +537,5 @@
 
         IF (CPPKEY_STRATAER) THEN
-          if(tracers(iq)%name(1:3)=='BIN') then
+          IF(tracers(iq)%name(1:3)=='BIN') THEN
             itrb = itrb + 1
             flag = [11, 11, 11, 11, 11, 11, 11, 11, 11, 1]
@@ -551,5 +551,5 @@
 
 #ifdef ISO
-    write(*,*) 'phys_output_mid 589'
+    WRITE(*,*) 'phys_output_mid 589'
     do ixt=1,ntraciso
       outiso = TRIM(isoName(ixt))
@@ -601,5 +601,5 @@
       END IF
     enddo !do ixt=1,niso
-    write(*,*) 'phys_output_mid 596'
+    WRITE(*,*) 'phys_output_mid 596'
 #endif
 
@@ -643,5 +643,5 @@
     CHARACTER(LEN = 10) :: type
     INTEGER :: ipos, il
-    real :: ttt, xxx, timestep, dayseconde, dtime
+    REAL :: ttt, xxx, timestep, dayseconde, dtime
     parameter (dayseconde = 86400.)
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_var_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_var_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_var_mod.F90	(revision 5116)
@@ -186,5 +186,5 @@
   SUBROUTINE phys_output_var_init
     use dimphy
-    use config_ocean_skin_m, only: activate_ocean_skin
+    use config_ocean_skin_m, ONLY: activate_ocean_skin
 
     IMPLICIT NONE
@@ -221,5 +221,5 @@
 ! Variables de sortie simulateur AIRS
 
-!     if (ok_airs) then
+!     if (ok_airs) THEN
       allocate (map_prop_hc(klon),map_prop_hist(klon))
       allocate (alt_tropo(klon))
@@ -285,5 +285,5 @@
 ! Variables de sortie simulateur AIRS
 
- !    if (ok_airs) then
+ !    if (ok_airs) THEN
       deallocate (map_prop_hc,map_prop_hist)
       deallocate (alt_tropo)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_write_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_write_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_write_mod.F90	(revision 5116)
@@ -585,6 +585,6 @@
          !$OMP MASTER
          IF (vars_defined) THEN
-            IF (prt_level >= 10) then
-               write(lunout,*)"phys_output_write: CALL xios_update_calendar, itau_w=",itau_w
+            IF (prt_level >= 10) THEN
+               WRITE(lunout,*)"phys_output_write: CALL xios_update_calendar, itau_w=",itau_w
             ENDIF
 !            CALL xios_update_calendar(itau_w)
@@ -600,8 +600,8 @@
 
        zx_tmp_fi2d = cell_area
-       IF (is_north_pole_phy) then
+       IF (is_north_pole_phy) THEN
          zx_tmp_fi2d(1) = cell_area(1)/nbp_lon
        ENDIF
-       IF (is_south_pole_phy) then
+       IF (is_south_pole_phy) THEN
          zx_tmp_fi2d(klon) = cell_area(klon)/nbp_lon
        ENDIf
@@ -655,5 +655,5 @@
 !!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Simulateur AIRS
-       IF (ok_airs) then
+       IF (ok_airs) THEN
          CALL histwrite_phy(o_alt_tropo,alt_tropo)
  
@@ -1695,5 +1695,5 @@
        IF (vars_defined) THEN
           DO i=1, klon
-             IF (zt2m(i)<=273.15) then
+             IF (zt2m(i)<=273.15) THEN
                 zx_tmp_fi2d(i)=MAX(0.,rh2m(i)*100.)
              ELSE
@@ -1944,5 +1944,5 @@
        ENDIF
        ! Champs 3D:
-       IF (ok_ade .OR. ok_aie) then
+       IF (ok_ade .OR. ok_aie) THEN
           IF (type_trac/='inca' .OR. config_inca=='aeNP') THEN 
              CALL histwrite_phy(o_ec550aer, ec550aer)
@@ -2721,6 +2721,5 @@
   ENDIF !using_xios
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-       IF (iflag_phytrac == 1 ) then
-
+       IF (iflag_phytrac == 1 ) THEN
          IF (type_trac == 'co2i') THEN
            itr = 0
@@ -2728,5 +2727,5 @@
              IF(.NOT.tracers(iq)%isInPhysics) CYCLE
              itr = itr + 1
-!            write(*,*) 'phys_output_write_mod 2370: itr=',itr
+!            WRITE(*,*) 'phys_output_write_mod 2370: itr=',itr
              !--3D fields
              CALL histwrite_phy(o_trac(itr), tr_seri(:,:,itr))
@@ -2786,5 +2785,5 @@
              IF(.NOT.tracers(iq)%isInPhysics) CYCLE
              itr = itr + 1
-!            write(*,*) 'phys_output_write_mod 2337: itr=',itr
+!            WRITE(*,*) 'phys_output_write_mod 2337: itr=',itr
              !--3D fields
              CALL histwrite_phy(o_trac(itr), tr_seri(:,:,itr))
@@ -2815,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)
@@ -2829,10 +2828,10 @@
 
 #ifdef ISO
-    !write(*,*) 'tmp phys_output_write: ntiso=',ntiso
+    !WRITE(*,*) 'tmp phys_output_write: ntiso=',ntiso
     !! runoff land bucket - ajout S. Nguyen 25 avril 2024
     CALL histwrite_phy(o_runoff_diag, runoff_diag)
 
     do ixt=1,ntiso
-        !write(*,*) 'ixt,o_xtovap(ixt)=',ixt,o_xtovap(ixt)
+        !WRITE(*,*) 'ixt,o_xtovap(ixt)=',ixt,o_xtovap(ixt)
         IF (vars_defined) zx_tmp_fi2d(:) = xtrain_fall(ixt,:) + xtsnow_fall(ixt,:)
         CALL histwrite_phy(o_xtprecip(ixt), zx_tmp_fi2d)
@@ -2895,5 +2894,5 @@
         ENDIF
 
-    !write(*,*) 'phys_output_write_mod 2531'
+    !WRITE(*,*) 'phys_output_write_mod 2531'
     ENDDO
 #endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_state_var_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_state_var_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phys_state_var_mod.F90	(revision 5116)
@@ -10,5 +10,5 @@
 ! Declaration des variables
       USE dimphy
-      USE netcdf, only: nf90_fill_real
+      USE netcdf, ONLY: nf90_fill_real
       INTEGER, PARAMETER :: nlevSTD=17
       INTEGER, PARAMETER :: nlevSTD8=8
@@ -40,5 +40,5 @@
 !$OMP THREADPRIVATE(treedrg)
 
-!      character(len=6), SAVE :: ocean
+!      CHARACTER(LEN=6), SAVE :: ocean
 !!!!!!$OMP THREADPRIVATE(ocean)
 !      logical, SAVE :: ok_veget 
@@ -540,6 +540,6 @@
 #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
 
@@ -690,5 +690,5 @@
 !albedo SB <<<
 
-      if (read_climoz <= 1) then
+      if (read_climoz <= 1) THEN
          ALLOCATE(wo(klon,klev, 1))
       else
@@ -783,5 +783,5 @@
       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))
@@ -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"
@@ -943,5 +943,5 @@
       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") &
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5116)
@@ -736,5 +736,5 @@
 
     !JLD    !---D\'eclenchement stochastique
-    !JLD    integer :: tau_trig(klon)
+    !JLD    INTEGER :: tau_trig(klon)
 
     REAL, SAVE :: random_notrig_max = 1.
@@ -1169,5 +1169,5 @@
     include "ini_COSP.h"
 #endif
-    real :: mr_ozone(klon, klev), phicosp(klon, klev)
+    REAL :: mr_ozone(klon, klev), phicosp(klon, klev)
 
     !IM stations CFMIP
@@ -1300,20 +1300,20 @@
     IF (prt_level>=1) THEN
       igout = klon / 2 + 1 / klon
-      write(lunout, *) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
-      write(lunout, *) 'igout, lat, lon ', igout, latitude_deg(igout), &
+      WRITE(lunout, *) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
+      WRITE(lunout, *) 'igout, lat, lon ', igout, latitude_deg(igout), &
               longitude_deg(igout)
-      write(lunout, *) &
+      WRITE(lunout, *) &
               'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
-      write(lunout, *) &
+      WRITE(lunout, *) &
               nlon, klev, nqtot, debut, lafin, jD_cur, jH_cur, pdtphys
 
-      write(lunout, *) 'paprs, play, phi, u, v, t'
+      WRITE(lunout, *) 'paprs, play, phi, u, v, t'
       DO k = 1, klev
-        write(lunout, *) paprs(igout, k), pplay(igout, k), pphi(igout, k), &
+        WRITE(lunout, *) paprs(igout, k), pplay(igout, k), pphi(igout, k), &
                 u(igout, k), v(igout, k), t(igout, k)
       ENDDO
-      write(lunout, *) 'ovap (g/kg),  oliq (g/kg)'
+      WRITE(lunout, *) 'ovap (g/kg),  oliq (g/kg)'
       DO k = 1, klev
-        write(lunout, *) qx(igout, k, 1) * 1000, qx(igout, k, 2) * 1000.
+        WRITE(lunout, *) qx(igout, k, 1) * 1000, qx(igout, k, 2) * 1000.
       ENDDO
     ENDIF
@@ -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
@@ -1823,5 +1823,5 @@
               RVTMP2, RTT, RD, RG, RV, RPI)
       ! Test de coherence sur oc_cdnc utilisé uniquement par cloud_optics_prop
-      IF (ok_newmicro) then
+      IF (ok_newmicro) THEN
         IF (iflag_rrtm==1) THEN
 #ifdef CPP_RRTM
@@ -2062,5 +2062,5 @@
       tave = 'ave(X)'
       !IM cf. AM 081204 BEG
-      write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con
+      WRITE(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con
       !IM cf. AM 081204 END
 
@@ -2559,8 +2559,8 @@
       IF (read_climoz <= 0) THEN
         ! Once per day, update ozone from Royer:
-        IF (solarlong0<-999.) then
+        IF (solarlong0<-999.) THEN
           ! Generic case with evolvoing season
           zzz = real(days_elapsed + 1)
-        ELSE IF (abs(solarlong0 - 1000.)<1.e-4) then
+        ELSE IF (abs(solarlong0 - 1000.)<1.e-4) THEN
           ! Particular case with annual mean insolation
           zzz = real(90) ! could be revisited
@@ -2652,5 +2652,5 @@
     ENDIF
 
-    IF (prt_level>=1) write(lunout, *)'Longitude solaire ', zlongi, solarlong0, dist
+    IF (prt_level>=1) WRITE(lunout, *)'Longitude solaire ', zlongi, solarlong0, dist
 
 
@@ -2796,8 +2796,8 @@
         jlr_g_c = (((19.8 * (pr_et(1:klon)**2)) / (1.5 + pr_et(1:klon) + pr_et(1:klon)**2))**(0.4))**2
         gustiness(1:klon) = jlr_g_c + jlr_g_s
-        !!       write(*,*) "rain ",pr_et
-        !!       write(*,*) "jlr_g_c",jlr_g_c
-        !!       write(*,*) "wstar",wstar(1,3)
-        !!       write(*,*) "jlr_g_s",jlr_g_s
+        !!       WRITE(*,*) "rain ",pr_et
+        !!       WRITE(*,*) "jlr_g_c",jlr_g_c
+        !!       WRITE(*,*) "wstar",wstar(1,3)
+        !!       WRITE(*,*) "jlr_g_s",jlr_g_s
         ! ELSE IF (iflag_gusts==2) THEN
         !    do i = 1, klon
@@ -2987,6 +2987,6 @@
 
     IF (prt_level>=1) THEN
-      write(lunout, *) 'L   qsat (g/kg) avant clouds_gno'
-      write(lunout, '(i4,f15.4)') (k, 1000. * zqsat(igout, k), k = 1, klev)
+      WRITE(lunout, *) 'L   qsat (g/kg) avant clouds_gno'
+      WRITE(lunout, '(i4,f15.4)') (k, 1000. * zqsat(igout, k), k = 1, klev)
     ENDIF
 
@@ -3009,5 +3009,5 @@
     ENDDO
 
-    IF (prt_level>=1) write(lunout, *) 'omega(igout, :) = ', &
+    IF (prt_level>=1) WRITE(lunout, *) 'omega(igout, :) = ', &
             omega(igout, :)
 
@@ -3095,5 +3095,5 @@
         ! The corresponding tendencies are added to the convective tendencies
         ! after the CALL to the convective scheme.
-        IF (iflag_wake>=1) then
+        IF (iflag_wake>=1) THEN
           IF (iflag_adjwk >= 1) THEN
             limbas(:) = 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
@@ -3314,11 +3314,11 @@
           IF (itop_con(i)>klev - 3) THEN
             IF (prt_level >= 9) THEN
-              write(lunout, *)'La convection monte trop haut '
-              write(lunout, *)'itop_con(,', i, ',)=', itop_con(i)
+              WRITE(lunout, *)'La convection monte trop haut '
+              WRITE(lunout, *)'itop_con(,', i, ',)=', itop_con(i)
             ENDIF
           ENDIF
         ENDDO
       ELSE IF (iflag_con==0) THEN
-        write(lunout, *) 'On n appelle pas la convection'
+        WRITE(lunout, *) 'On n appelle pas la convection'
         clwcon0 = 0.
         rnebcon0 = 0.
@@ -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
@@ -3807,8 +3807,8 @@
 
     !+JLD
-    !    write(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
+    !    WRITE(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
     !        & ,((rcw-rcpd)*rain_lsc + (rcs-rcpd)*snow_lsc)*t_seri(1,1)-rlvtt*rain_lsc+rlstt*snow_lsc &
     !        & ,rain_lsc,snow_lsc
-    !    write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
+    !    WRITE(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
     !-JLD
     CALL add_phys_tend(du0, dv0, d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, dqbs0, paprs, &
@@ -4067,5 +4067,5 @@
       tpot(i) = zt2m(i) * (100000. / paprs(i, 1))**RKAPPA
       IF (thermcep) THEN
-        IF(zt2m(i)<RTT) then
+        IF(zt2m(i)<RTT) THEN
           Lheat = RLSTT
         ELSE
@@ -4583,5 +4583,5 @@
         ! a declarer comme iflag_rrtm et a lire dans physiq.def
 #ifdef CPP_ECRAD
-          IF (ok_3Deffect) then
+          IF (ok_3Deffect) THEN
 !                PRINT*,'ok_3Deffect = ',ok_3Deffect
                 namelist_ecrad_file='namelist_ecrad_s2'
@@ -4806,5 +4806,5 @@
     ENDIF ! fin de test sur ok_orolf
 
-    IF (ok_hines) then
+    IF (ok_hines) THEN
       !  HINES GWD PARAMETRIZATION
       east_gwstress = 0.
@@ -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, &
@@ -5159,8 +5159,7 @@
     ! Marine
 
-    IF (ok_airs) then
-
+    IF (ok_airs) 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
+        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, &
                 map_prop_hc, map_prop_hist, &
@@ -5509,39 +5508,39 @@
 
     IF (prt_level>=1) THEN
-      write(lunout, *) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
-      write(lunout, *) &
+      WRITE(lunout, *) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
+      WRITE(lunout, *) &
               'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
-      write(lunout, *) &
+      WRITE(lunout, *) &
               nlon, klev, nqtot, debut, lafin, jD_cur, jH_cur, pdtphys, &
               pctsrf(igout, is_ter), pctsrf(igout, is_lic), pctsrf(igout, is_oce), &
               pctsrf(igout, is_sic)
-      write(lunout, *) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
+      WRITE(lunout, *) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
       DO k = 1, klev
-        write(lunout, *) d_t_dyn(igout, k), d_t_con(igout, k), &
+        WRITE(lunout, *) d_t_dyn(igout, k), d_t_con(igout, k), &
                 d_t_lsc(igout, k), d_t_ajsb(igout, k), d_t_ajs(igout, k), &
                 d_t_eva(igout, k)
       ENDDO
-      write(lunout, *) 'cool,heat'
+      WRITE(lunout, *) 'cool,heat'
       DO k = 1, klev
-        write(lunout, *) cool(igout, k), heat(igout, k)
+        WRITE(lunout, *) cool(igout, k), heat(igout, k)
       ENDDO
 
       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
-      !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
+      !jyg!     WRITE(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
       !jyg!     do k=1,klev
-      !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
+      !jyg!        WRITE(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
       !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
       !jyg!     enddo
-      write(lunout, *) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
+      WRITE(lunout, *) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
       DO k = 1, klev
-        write(lunout, *) d_t_vdf(igout, k), &
+        WRITE(lunout, *) d_t_vdf(igout, k), &
                 d_t_oro(igout, k), d_t_lif(igout, k), d_t_ec(igout, k)
       ENDDO
       !>jyg
 
-      write(lunout, *) 'd_ps ', d_ps(igout)
-      write(lunout, *) 'd_u, d_v, d_t, d_qx1, d_qx2 '
+      WRITE(lunout, *) 'd_ps ', d_ps(igout)
+      WRITE(lunout, *) 'd_u, d_v, d_t, d_qx1, d_qx2 '
       DO k = 1, klev
-        write(lunout, *) d_u(igout, k), d_v(igout, k), d_t(igout, k), &
+        WRITE(lunout, *) d_u(igout, k), d_v(igout, k), d_t(igout, k), &
                 d_qx(igout, k, 1), d_qx(igout, k, 2)
       ENDDO
@@ -5631,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
@@ -5658,5 +5657,5 @@
       CALL phyredem ("restartphy.nc")
       !         open(97,form="unformatted",file="finbin")
-      !         write(97) u_seri,v_seri,t_seri,q_seri
+      !         WRITE(97) u_seri,v_seri,t_seri,q_seri
       !         close(97)
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/physiqex_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/physiqex_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/physiqex_mod.F90	(revision 5116)
@@ -19,5 +19,5 @@
       USE ioipsl, ONLY: ymds2ju
       USE phys_state_var_mod, ONLY: phys_state_var_init
-      USE phyetat0_mod, only: phyetat0
+      USE phyetat0_mod, ONLY: phyetat0
       USE output_physiqex_mod, ONLY: output_physiqex
 
@@ -57,6 +57,6 @@
 
 
-real :: temp_newton(klon,klev)
-integer :: k
+REAL :: temp_newton(klon,klev)
+INTEGER :: k
 logical, save :: first=.TRUE.
 !$OMP THREADPRIVATE(first)
@@ -66,6 +66,6 @@
 
 ! For I/Os
-integer :: itau0
-real :: zjulian
+INTEGER :: itau0
+REAL :: zjulian
 
 
@@ -131,5 +131,5 @@
 
 ! if lastcall, then it is time to write "restartphy.nc" file
-IF (lafin) then
+IF (lafin) THEN
   CALL phyredem("restartphy.nc")
 END IF
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/phytrac_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/phytrac_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/phytrac_mod.F90	(revision 5116)
@@ -439,5 +439,5 @@
       iflag_con_trac = iflag_con_trac_omp
       iflag_the_trac = iflag_the_trac_omp
-      write(lunout, *) 'phytrac passage dans routine conv avec lessivage', convscav
+      WRITE(lunout, *) 'phytrac passage dans routine conv avec lessivage', convscav
 
       !Config Key  = iflag_lscav
@@ -595,5 +595,5 @@
       WRITE(lunout, *) 'pbl_flg        =', pbl_flg
       WRITE(lunout, *) 'lessivage      =', lessivage
-      write(lunout, *)  'flag_cvltr    = ', flag_cvltr
+      WRITE(lunout, *)  'flag_cvltr    = ', flag_cvltr
 
       IF (lessivage .AND. ANY(type_trac == ['inca', 'inco'])) &
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/press_coefoz_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/press_coefoz_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/press_coefoz_m.F90	(revision 5116)
@@ -23,9 +23,9 @@
     ! 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:
@@ -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)
 
@@ -57,5 +57,5 @@
     ! 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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/print_debug_phys.F90	(revision 5116)
@@ -14,5 +14,5 @@
 PRINT*,'l    u, v, T, q, ql'
 DO k = 1, klev
-   write(*,'(i3,2f8.4,3f14.4,2e14.2)') k,longitude_deg(i),latitude_deg(i), &
+   WRITE(*,'(i3,2f8.4,3f14.4,2e14.2)') k,longitude_deg(i),latitude_deg(i), &
    u_seri(i,k),v_seri(i,k),t_seri(i,k),q_seri(i,k),ql_seri(i,k)
 ENDDO
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5116)
@@ -82,6 +82,6 @@
     USE phys_state_var_mod, ONLY: pctsrf
     USE indice_sol_mod
-    USE time_phylmdz_mod, only: current_time
-    USE phys_cal_mod, only: day_cur
+    USE time_phylmdz_mod, ONLY: current_time
+    USE phys_cal_mod, ONLY: day_cur
     USE interface_lmdz_ecrad
 #endif
@@ -798,7 +798,7 @@
         ENDDO
 
-      ELSE IF (iflag_rrtm == 1) then
+      ELSE IF (iflag_rrtm == 1) THEN
 #ifdef CPP_RRTM
-          !      if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.' 
+          !      if (prt_level.gt.10)WRITE(lunout,*)'CPP_RRTM=.T.'
           !===== iflag_rrtm=1, on passe dans SW via RECMWFL ===============
 
@@ -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)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/ran0_vec.F90	(revision 5116)
@@ -17,7 +17,7 @@
 
   ! do j=1,npoints
-  ! if (idum(j).eq.0) then
-  ! write(6,*) 'idum=',idum
-  ! write(6,*) 'ZERO seed not allowed'
+  ! if (idum(j).eq.0) THEN
+  ! WRITE(6,*) 'idum=',idum
+  ! WRITE(6,*) 'ZERO seed not allowed'
   ! stop
   ! endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_interp.F90	(revision 5116)
@@ -8,7 +8,7 @@
   ! CALL to this routine only treats the aerosol "id_aero".
 
-  ! 1) Read in data for the whole year, only at first time step
-  ! 2) Interpolate to the actual day, only at new day
-  ! 3) Interpolate to the model vertical grid (target grid), only at new day
+  ! 1) Read in data for the whole year, ONLY at first time step
+  ! 2) Interpolate to the actual day, ONLY at new day
+  ! 3) Interpolate to the model vertical grid (target grid), ONLY at new day
   ! 4) Test for negative mass values
 
@@ -102,5 +102,5 @@
   ! Calculation to find if it is a new day
 
-  IF(mpi_rank == 0 .AND. debug)then
+  IF(mpi_rank == 0 .AND. debug)THEN
     PRINT*, 'CONTROL PANEL REGARDING TIME STEPING'
   ENDIF
@@ -125,5 +125,5 @@
   ENDIF
 
-  IF(mpi_rank == 0 .AND. debug)then
+  IF(mpi_rank == 0 .AND. debug)THEN
     ! 0.02 is about 0.5/24, namly less than half an hour
     OLDNEWDAY = (r_day - REAL(iday) < 0.02)
@@ -280,7 +280,7 @@
     month_mid(:) = month_start (:) + month_len(:) / 2.
 
-    if (debug) then
-      write(lunout, *)' month_len = ', month_len
-      write(lunout, *)' month_mid = ', month_mid
+    if (debug) THEN
+      WRITE(lunout, *)' month_len = ', month_len
+      WRITE(lunout, *)' month_mid = ', month_mid
     endif
 
@@ -300,5 +300,5 @@
     ! Find which months and days to use for time interpolation
     nbr_tsteps = 12
-    IF (nbr_tsteps == 12) then
+    IF (nbr_tsteps == 12) THEN
       IF (jDay < month_mid(im + 1)) THEN
         im2 = im - 1
@@ -319,5 +319,5 @@
         ENDIF
       ENDIF
-    ELSE IF (nbr_tsteps == 14) then
+    ELSE IF (nbr_tsteps == 14) THEN
       im = im + 1
       IF (jDay < month_mid(im)) THEN
@@ -335,6 +335,6 @@
       CALL abort_physic('readaerosol_interp', 'number of months undefined', 1)
     ENDIF
-    if (debug) then
-      write(lunout, *)' jDay, day1, day2, im, im2 = ', jDay, day1, day2, im, im2
+    if (debug) THEN
+      WRITE(lunout, *)' jDay, day1, day2, im, im2 = ', jDay, day1, day2, im, im2
     endif
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_optic.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_optic.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosol_optic.F90	(revision 5116)
@@ -13,5 +13,5 @@
   USE dimphy
   USE aero_mod
-  USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
+  USE phys_local_var_mod, ONLY: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, &
       concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
       load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/readaerosolstrato.F90	(revision 5116)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/readchlorophyll.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/readchlorophyll.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/readchlorophyll.F90	(revision 5116)
@@ -102,5 +102,5 @@
       WRITE(lunout, *)"chrolophyll current month", mth_cur
       DO i = 1, klon_glo
-        !      if(isnan(chlorocon_mois_glo(i)))then ! isnan() is not in the Fortran standard...
+        !      IF(isnan(chlorocon_mois_glo(i)))then ! isnan() is not in the Fortran standard...
         !      Another way to check for NaN:
         IF (chlorocon_mois_glo(i)/=chlorocon_mois_glo(i)) chlorocon_mois_glo(i) = 0.
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_horiz_time_climoz_m.F90	(revision 5116)
@@ -1,5 +1,5 @@
 MODULE regr_horiz_time_climoz_m
 
-  USE interpolation, ONLY: locate
+  use lmdz_interpolation, ONLY: locate
   USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
   USE nrtype, ONLY: pi
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 5116)
@@ -41,11 +41,11 @@
 
     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 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, &
          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 nrtype, ONLY: pi
+    use lmdz_regular_lonlat, ONLY: boundslat_reg, south
 
     ! Variables local to the procedure:
@@ -94,8 +94,8 @@
     integer, parameter:: n_o3_param = 8 ! number of ozone parameters
 
-    character(len=11) name_in(n_o3_param)
+    CHARACTER(LEN=11) name_in(n_o3_param)
     ! (name of NetCDF primary variable in the input file)
 
-    character(len=9) name_out(n_o3_param)
+    CHARACTER(LEN=9) name_out(n_o3_param)
     ! (name of NetCDF primary variable in the output file)
 
@@ -241,14 +241,14 @@
 
     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_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 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
+    CHARACTER(LEN=*), intent(in):: name_out(:) ! of NetCDF variables
     integer, intent(out):: ncid_out, varid_out(:), varid_plev, varid_time
 
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_comb_coefoz_m.F90	(revision 5116)
@@ -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,13 +71,13 @@
     !    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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90	(revision 5116)
@@ -24,15 +24,15 @@
     ! 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 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
     ! (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
+    CHARACTER(LEN=*), intent(in):: name ! of the NetCDF variable
     integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
 
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90	(revision 5116)
@@ -25,11 +25,11 @@
     ! 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 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
 
     REAL, intent(in):: p3d(:, :, :) ! pressure at layer interfaces, in Pa
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_time_av_m.F90	(revision 5116)
@@ -119,5 +119,5 @@
     USE lmdz_assert_eq, ONLY: assert_eq
     !!  USE comvert_mod,    ONLY: scaleheight
-    USE interpolation, ONLY: locate
+    use lmdz_interpolation, ONLY: locate
     USE regr_conserv_m, ONLY: regr_conserv
     USE regr_lint_m, ONLY: regr_lint
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/simu_airs.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/simu_airs.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/simu_airs.F90	(revision 5116)
@@ -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
@@ -64,5 +64,5 @@
     if (first_point<=0) P_tropo = 65.4321
     if (first_point==1) P_tropo = 64.5432
-    if (first_point>1) then
+    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,9 +72,9 @@
 
     ! Ajout Marine
-    if (P_tropo < 60. .or. P_tropo > 470.) then
+    if (P_tropo < 60. .or. P_tropo > 470.) THEN
       P_tropo = 999.
     endif
 
-  end function search_tropopause
+  END FUNCTION search_tropopause
 
 
@@ -119,5 +119,5 @@
     CHARACTER (len = 160) :: abort_message
 
-    write(lunout, *) 'dans cloud_structure'
+    WRITE(lunout, *) 'dans cloud_structure'
 
     CALL ordonne(len_cs, rneb_cs, rneb_ord)
@@ -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
@@ -299,10 +299,10 @@
 
     if (cc_tot_cs > maxval(rneb_cs) .and. &
-            abs(cc_tot_cs - maxval(rneb_cs)) > 1.e-4)  then
+            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)
       CALL abort_physic(modname, abort_message, 1)
     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)
@@ -317,5 +317,5 @@
     REAL, intent(inout) :: num
 
-    if (den /= 0) then
+    if (den /= 0) THEN
       num = num / den
     else
@@ -332,5 +332,5 @@
     REAL, intent(out) :: res
 
-    if (den /= 0.) then
+    if (den /= 0.) THEN
       res = num / den
     else
@@ -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
@@ -403,6 +403,5 @@
       ideb = iend + 1
 
-      if (ibeg > 0) then
-
+      if (ibeg > 0) THEN
         nuage = nuage + 1
 
@@ -428,6 +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, &
@@ -440,6 +438,5 @@
       rad = som_rad
 
-      if (pcld > p_thresh) then
-
+      if (pcld > p_thresh) THEN
         shc = 0.
         shist = 0.
@@ -451,17 +448,17 @@
 
         if (emis < em_min .or. emis > em_max  &
-                .or. tcld > 230.) then
+                .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
@@ -490,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)
@@ -525,7 +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.
@@ -580,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
@@ -586,11 +582,11 @@
     enddo
 
-    if (som_dz /= 0.) then
+    if (som_dz /= 0.) THEN
       som_rad = som_rad / som_dz
     else
-      write(*, *) 'som_dez = 0 stop '
-      write(*, *) 'ibeg, iend =', ibeg, iend
+      WRITE(*, *) 'som_dez = 0 stop '
+      WRITE(*, *) 'ibeg, iend =', ibeg, iend
       do i = ibeg, iend
-        write(*, *) dz_cs(i), rhodz_cs(i)
+        WRITE(*, *) dz_cs(i), rhodz_cs(i)
       enddo
       abort_message = 'see above'
@@ -600,5 +596,5 @@
     ! Determination de Pcld et Tcld
 
-    if (ibase < ibeg) then
+    if (ibase < ibeg) THEN
       ibase = ibeg
     endif
@@ -625,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
@@ -660,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
@@ -788,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
@@ -987,5 +983,5 @@
 
       if (cc_tot_mesh > tsom_tot .and. &
-              abs(cc_tot_mesh - tsom_tot) > 1.e-4) then
+              abs(cc_tot_mesh - tsom_tot) > 1.e-4) THEN
         WRITE(abort_message, *)'cc_tot_mesh > tsom_tot', cc_tot_mesh, tsom_tot
         CALL abort_physic(modname, abort_message, 1)
@@ -993,5 +989,5 @@
 
       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
+              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))
         CALL abort_physic(modname, abort_message, 1)
@@ -999,5 +995,5 @@
 
       if (cc_hc_mesh > tsom_hc .and. &
-              abs(cc_hc_mesh - tsom_hc) > 1.e-4) then
+              abs(cc_hc_mesh - tsom_hc) > 1.e-4) THEN
         WRITE(abort_message, *) 'cc_hc_mesh > tsom_hc', cc_hc_mesh, tsom_hc
         CALL abort_physic(modname, abort_message, 1)
@@ -1005,5 +1001,5 @@
 
       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
+              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))
         CALL abort_physic(modname, abort_message, 1)
@@ -1011,10 +1007,10 @@
 
       if (cc_hist_mesh > tsom_hist .and. &
-              abs(cc_hist_mesh - tsom_hist) > 1.e-4) then
+              abs(cc_hist_mesh - tsom_hist) > 1.e-4) THEN
         WRITE(abort_message, *) 'cc_hist_mesh > tsom_hist', cc_hist_mesh, tsom_hist
         CALL abort_physic(modname, abort_message, 1)
       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)
@@ -1025,5 +1021,5 @@
               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))
@@ -1035,5 +1031,5 @@
               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))
@@ -1045,5 +1041,5 @@
               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
+              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)), &
                 minval(test_em(1:N_CS))
@@ -1094,5 +1090,5 @@
     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)
@@ -1164,7 +1160,7 @@
   REAL, DIMENSION(klon), intent(out) :: map_Cb, map_ThCi, map_Anv
 
-  write(*, *) 'simu_airs'
-  write(*, *) 'itap, klon, klev', itap, klon, klev
-  write(*, *) 'RG, RD =', RG, RD
+  WRITE(*, *) 'simu_airs'
+  WRITE(*, *) 'itap, klon, klev', itap, klon, klev
+  WRITE(*, *) 'RG, RD =', RG, RD
 
 
@@ -1184,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
@@ -1219,6 +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, &
@@ -1232,11 +1227,11 @@
             em_hist_mesh, iwp_hist_mesh, deltaz_hist_mesh, rad_hist_mesh)
 
-    write(*, *) '===================================='
-    write(*, *) 'itap, i:', itap, i
-    write(*, *) 'cc_tot, cc_hc, cc_hist, pcld_hc, tcld_hc, em_hc, &
+    WRITE(*, *) '===================================='
+    WRITE(*, *) 'itap, i:', itap, i
+    WRITE(*, *) 'cc_tot, cc_hc, cc_hist, pcld_hc, tcld_hc, em_hc, &
             iwp_hc, em_hist, iwp_hist ='
-    write(*, *) cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
-    write(*, *) pcld_hc_mesh, tcld_hc_mesh, em_hc_mesh, iwp_hc_mesh
-    write(*, *)  em_hist_mesh, iwp_hist_mesh
+    WRITE(*, *) cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
+    WRITE(*, *) pcld_hc_mesh, tcld_hc_mesh, em_hc_mesh, iwp_hc_mesh
+    WRITE(*, *)  em_hist_mesh, iwp_hist_mesh
 
     !        endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/slab_heat_transp_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/slab_heat_transp_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/slab_heat_transp_mod.F90	(revision 5116)
@@ -111,5 +111,5 @@
     ! Sanity check on dimensions
     if ((ip1jm/=((nbp_lon + 1) * (nbp_lat - 1))).or. &
-            (ip1jmp1/=((nbp_lon + 1) * nbp_lat))) then
+            (ip1jmp1/=((nbp_lon + 1) * nbp_lat))) THEN
       abort_message = "ini_slab_transp_geom Error: wrong array sizes"
       CALL abort_physic(modname, abort_message, 1)
@@ -145,5 +145,5 @@
   SUBROUTINE ini_slab_transp(zmasq)
 
-    !    USE lmdz_ioipsl_getin_p, only: getin_p
+    !    USE lmdz_ioipsl_getin_p, ONLY: getin_p
     USE IOIPSL, ONLY: getin
     IMPLICIT NONE
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5116)
@@ -129,5 +129,5 @@
 
 ! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
-     IF (ok_prescr_ust) then
+     IF (ok_prescr_ust) THEN
       DO i = 1, knon
        print *,'cdram avant=',cdram(i)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90	(revision 5116)
@@ -97,5 +97,5 @@
 
 IF (ifil>0 .AND. prt_level >5) THEN
-  write(lunout,*)'Tropopause: number of undetermined values =', ifil
+  WRITE(lunout,*)'Tropopause: number of undetermined values =', ifil
 ENDIF
 
@@ -178,6 +178,6 @@
        pmk2 = .5 * (p(jj-1)**rkappa+p(jj)**rkappa)    ! p mean ^kappa
        pm2 = pmk2**(1/rkappa)                      ! p mean
-       if(pm2>ptph) go to 110                ! doesn't happen
-       if(pm2<p2km) go to 888                ! ptropo is valid
+       IF(pm2>ptph) go to 110                ! doesn't happen
+       IF(pm2<p2km) go to 888                ! ptropo is valid
 
        a2 = (t(jj-1)-t(jj))                     ! a
@@ -227,5 +227,5 @@
 ZTRP = ZS + TDLNP*RD/RG
 
-!!if (ZTRP .lt. 0) then
+!!if (ZTRP .lt. 0) THEN
 !!  PRINT*,'ZTRP=',ZTRP
 !!  PRINT*,'PS=',PS
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/suphel.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/suphel.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/suphel.F90	(revision 5116)
@@ -76,7 +76,7 @@
   WRITE (UNIT=6, FMT='(''  sideral day = '',E13.7,'' s'')') rsiday
   WRITE (UNIT=6, FMT='(''        omega = '',E13.7,'' s-1'')') romega
-  ! write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
-  ! write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
-  ! write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
+  ! WRITE(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
+  ! WRITE(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
+  ! WRITE(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl
 
   ! ------------------------------------------------------------------
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_bucket_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_bucket_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_bucket_mod.F90	(revision 5116)
@@ -126,5 +126,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        !write(*,*) 'surf_land_bucket 152'
+        !WRITE(*,*) 'surf_land_bucket 152'
         DO i=1,knon
           IF (iso_eau > 0) THEN
@@ -144,5 +144,5 @@
           ENDDO !do ixt=1,niso
         ENDDO !do i=1,knon
-        !write(*,*) 'surf_land_bucket 152'
+        !WRITE(*,*) 'surf_land_bucket 152'
 #endif
 #endif
@@ -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
@@ -198,5 +198,5 @@
    ! verif
 #ifdef ISOVERIF
-    !write(*,*) 'surf_land_bucket 211'
+    !WRITE(*,*) 'surf_land_bucket 211'
     DO i=1,knon
       IF (iso_eau > 0) THEN
@@ -204,5 +204,5 @@
              snow(i),'surf_land_bucket 522', &
              errmax,errmaxrel)
-      ENDIF !IF (iso_eau > 0) then
+      ENDIF !IF (iso_eau > 0) THEN
     ENDDO !DO i=1,knon 
 #endif
@@ -223,5 +223,5 @@
     ENDDO !DO i=1,knon 
 #ifdef ISOVERIF
-    ! write(*,*) 'surf_land_bucket 235'
+    ! WRITE(*,*) 'surf_land_bucket 235'
     DO i=1,knon  
       IF (iso_eau > 0) THEN
@@ -253,5 +253,5 @@
 #endif
 #ifdef ISOVERIF
-        !write(*,*) 'surf_land_bucket 235'
+        !WRITE(*,*) 'surf_land_bucket 235'
         DO i=1,knon
           IF (iso_eau > 0) THEN
@@ -265,6 +265,6 @@
              ! xtsnow
              ! c'est fait plus tard dans gestion_neige
-!            write(*,*) 'surf_land_bucket 287: i=',i
-!            write(*,*) 'snow(i)=',snow(i)
+!            WRITE(*,*) 'surf_land_bucket 287: i=',i
+!            WRITE(*,*) 'snow(i)=',snow(i)
             CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
                                      snow_prec(i),'surf_land_bucket 245', &
@@ -279,6 +279,6 @@
           ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
         ENDDO  !DO i=1,knon 
-        !write(*,*) 'surf_land_mod 291'
-        !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
+        !WRITE(*,*) 'surf_land_mod 291'
+        !WRITE(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
 #endif          
         CALL calcul_iso_surf_ter_vectall(klon,knon, &
@@ -293,5 +293,5 @@
      )
 !#ifdef ISOVERIF
-!        write(*,*) 'surf_land_bucket 303'
+!        WRITE(*,*) 'surf_land_bucket 303'
 !#endif
 #endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90	(revision 5116)
@@ -164,5 +164,5 @@
       real, dimension(klon) :: snow_evap_diag 
       real, dimension(klon) :: fqcalving_diag 
-      integer :: ixt
+      INTEGER :: ixt
 #endif 
 !****************************************************************************************
@@ -177,7 +177,7 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!        write(*,*) 'surf_land_mod 162'
+!        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', &
@@ -190,5 +190,5 @@
 #endif 
 #ifdef ISOVERIF
-!       write(*,*) 'surf_land 169: ok_veget=',ok_veget
+!       WRITE(*,*) 'surf_land 169: ok_veget=',ok_veget
         do i=1,knon
          do ixt=1,ntiso
@@ -250,10 +250,10 @@
 #ifdef ISO
 #ifdef ISOVERIF
-     write(*,*) 'surf_land 193: apres surf_land_orchidee'   
+     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)
-        endif !if (iso_eau.gt.0) then      
+        endif !if (iso_eau.gt.0) THEN
       enddo !do i=1,knon  
 #endif
@@ -273,5 +273,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!       write(*,*) 'surf_land 247'
+!       WRITE(*,*) 'surf_land 247'
         CALL iso_verif_egalite_vect1D( &
              xtsnow,snow,'surf_land_mod 207',niso,klon)
@@ -280,8 +280,8 @@
 
 #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
-        !write(*,*) 'surf_land 258'
+        !WRITE(*,*) 'surf_land 258'
 #endif
        CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
@@ -322,10 +322,10 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!     write(*,*) 'surf_land 237: sortie'   
+!     WRITE(*,*) 'surf_land 237: sortie'
       DO i=1,knon
         IF (iso_eau >= 0) THEN
              CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
               'surf_land 241',errmax,errmaxrel)
-        ENDIF !if (iso_eau.gt.0) then      
+        ENDIF !if (iso_eau.gt.0) THEN
       ENDDO !do i=1,knon  
 #endif
@@ -391,8 +391,8 @@
     ENDIF
 
-!    write(*,*) 'surf_land 314: knon=',knon
-!    write(*,*) 'rlat=',rlat
-!    write(*,*) 'rlon=',rlon
-!    write(*,*) 'region_nudge_qsol=',region_nudge_qsol
+!    WRITE(*,*) 'surf_land 314: knon=',knon
+!    WRITE(*,*) 'rlat=',rlat
+!    WRITE(*,*) 'rlon=',rlon
+!    WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol
 
     DO i=1,knon
@@ -401,5 +401,5 @@
          (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=', &
+!        WRITE(*,*) 'surf_land 324: bon domaine: rlat,rlon,qsol=', &
 !  &             rlat(knindex(i)),rlon(knindex(i)),qsol(knindex(i))
         qsol_new=qsol(i)
@@ -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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_mod.F90	(revision 5116)
@@ -493,5 +493,5 @@
     !     cdrag = 0.01
     !   endwhere
-    !  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
+    !  WRITE(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
 
     IF (debut) THEN
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nofrein_mod.F90	(revision 5116)
@@ -398,5 +398,5 @@
 !     cdrag = 0.01
 !   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
+!  WRITE(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
 
   
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nolic_mod.F90	(revision 5116)
@@ -490,5 +490,5 @@
 !     cdrag = 0.01
 !   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
+!  WRITE(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
 
   
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 5116)
@@ -399,9 +399,9 @@
 !     cdrag = 0.01
 !   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
+!  WRITE(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
 
 ! Init Orchidee
 
-!  if (pole_nord) then 
+!  if (pole_nord) THEN
 !    offset=0
 !    ktindex(:)=ktindex(:)+nbp_lon-1
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_nounstruct_mod.F90	(revision 5116)
@@ -388,5 +388,5 @@
 !     cdrag = 0.01
 !   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
+!  WRITE(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
 
   
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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noz0h_mod.F90	(revision 5116)
@@ -395,5 +395,5 @@
 !     cdrag = 0.01
 !   endwhere
-!  write(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
+!  WRITE(*,*)'Cdrag = ',minval(cdrag),maxval(cdrag)
 
   
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90	(revision 5116)
@@ -211,5 +211,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!     write(*,*) 'surf_land_ice 1499'   
+!     WRITE(*,*) 'surf_land_ice 1499'
   DO i=1,knon
     IF (iso_eau > 0) THEN
@@ -381,5 +381,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-     !write(*,*) 'surf_land_ice 1499'   
+     !WRITE(*,*) 'surf_land_ice 1499'
      DO i=1,knon
        IF (iso_eau > 0) THEN
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/surf_ocean_mod.F90	(revision 5116)
@@ -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
@@ -189,5 +189,5 @@
             snow(i),'surf_ocean_mod 127', &
             errmax,errmaxrel)
-      ENDIF !IF (iso_eau > 0) then
+      ENDIF !IF (iso_eau > 0) THEN
     ENDDO !DO i=1,klon
 #endif      
@@ -378,5 +378,5 @@
     ENDIF
 
-    if (activate_ocean_skin >= 1) then
+    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, &
@@ -391,5 +391,5 @@
       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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/traclmdz_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/traclmdz_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/traclmdz_mod.F90	(revision 5116)
@@ -158,5 +158,5 @@
     !!jyg(20130206) : le choix d activation du lessivage est fait dans phytrac avec iflag_lscav
     !!    CALL getin('lessivage',lessivage)
-    !!    if(lessivage) then
+    !!    IF(lessivage) THEN
     !!     PRINT*,'lessivage lsc ON'
     !!    else
@@ -544,5 +544,5 @@
 
     DO it = 1, nbtr
-      IF(radio(it)) then
+      IF(radio(it)) THEN
         DO k = 1, klev
           DO i = 1, klon
@@ -558,5 +558,5 @@
     !======================================================================
 
-    IF (id_o3 /= 0) then
+    IF (id_o3 /= 0) THEN
       lmt_pas = NINT(86400. / pdtphys)
       IF (MOD(nstep - 1, lmt_pas) == 0) THEN
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/tracreprobus_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/tracreprobus_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/tracreprobus_mod.F90	(revision 5116)
@@ -52,5 +52,5 @@
 !    pdt_rep=pdtphys/2.
     niter=pdtphys/pdt_rep
-    write(*,*)'nb d appel de REPROBUS',niter
+    WRITE(*,*)'nb d appel de REPROBUS',niter
     
     DO k = 1, klev
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/vdif_kcay.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/vdif_kcay.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/vdif_kcay.F90	(revision 5116)
@@ -384,5 +384,5 @@
 
       ! 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
@@ -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,5 +561,5 @@
       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
@@ -606,5 +606,5 @@
     ! CALL vdif_q2(dt,g,rconst,plev,temp,km,q2)
     ! do ilev=1,klev+1
-    ! write(iii+49,*) q2(1,ilev),zlev(1,ilev)
+    ! WRITE(iii+49,*) q2(1,ilev),zlev(1,ilev)
     ! enddo
     ! enddo
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ave.h
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ave.h	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ave.h	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/write_bilKP_ins.h	(revision 5116)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/write_histREGDYN.h	(revision 5116)
@@ -2,9 +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
@@ -55,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/write_histday_seri.h	(revision 5116)
@@ -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/yamada4.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada4.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada4.F90	(revision 5116)
@@ -5,5 +5,5 @@
 
   USE dimphy, ONLY: klev, klon
-  USE phys_local_var_mod, only: wprime
+  USE phys_local_var_mod, ONLY: wprime
   USE yamada_ini_mod, ONLY: new_yamada4, yamada4_num, hboville
   USE yamada_ini_mod, ONLY: prt_level, lunout, pbl_lmixmin_alpha, b1, kap, viscom, viscoh
@@ -231,5 +231,5 @@
         rif(ig, k) = rifc
       END IF
-      IF (new_yamada4) then
+      IF (new_yamada4) THEN
         alpha(ig, k) = max(falpha(rif(ig, k)), seuilalpha)
         sm(ig, k) = max(fsm(rif(ig, k)), seuilsm)
@@ -353,5 +353,5 @@
         END IF
         ! else ! iflag_pbl=9
-        ! if (aa(ig,k)*qpre.gt.0.9) then
+        ! if (aa(ig,k)*qpre.gt.0.9) THEN
         ! q2(ig,k)=(qpre*10.)**2
         ! else
@@ -859,6 +859,6 @@
   USE dimphy, ONLY: klev, klon
   USE yamada_ini_mod, ONLY: l0
-  USE phys_state_var_mod, only: zstd, zsig, zmea
-  USE phys_local_var_mod, only: l_mixmin, l_mix
+  USE phys_state_var_mod, ONLY: zstd, zsig, zmea
+  USE phys_local_var_mod, ONLY: l_mixmin, l_mix
   USE yamada_ini_mod, ONLY: kap, kapb
 
@@ -867,5 +867,5 @@
   ! zsig: pente moyenne de le maille
 
-  USE lmdz_geometry, only: cell_area
+  USE lmdz_geometry, ONLY: cell_area
   ! aire_cell: aire de la maille
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90	(revision 5116)
@@ -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))
@@ -147,5 +147,5 @@
 
 #ifdef IOPHYS
-IF (okiophys) then
+IF (okiophys) THEN
 CALL iophys_ecrit('q2i',klev,'q2 debut my','m2/s2',q2(:,1:klev))
 CALL iophys_ecrit('kmi',klev,'Kz debut my','m/s2',km(:,1:klev))
@@ -212,5 +212,5 @@
 
 #ifdef IOPHYS
-IF (okiophys) then
+IF (okiophys) THEN
       CALL iophys_ecrit('zlay',klev,'Geop','m',zlay)
       CALL iophys_ecrit('teta',klev,'teta','K',teta)
@@ -277,10 +277,10 @@
 !        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
             rif(ig,k)=rifc
          endif
-         if(rif(ig,k)<0.16) then
+         IF(rif(ig,k)<0.16) THEN
             alpha(ig,k)=falpha(rif(ig,k))
             sm(ig,k)=fsm(rif(ig,k))
@@ -300,6 +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
@@ -347,5 +346,5 @@
 
 #ifdef IOPHYS
-IF (okiophys) then
+IF (okiophys) THEN
 CALL iophys_ecrit('rif',klev,'Flux Richardson','m',rif(:,1:klev))
 CALL iophys_ecrit('m2',klev,'m2 ','m/s',m2(:,1:klev))
@@ -356,5 +355,5 @@
 
 
-IF (iflag_pbl<20) then
+IF (iflag_pbl<20) THEN
       ! For diagnostics only
       RETURN
@@ -393,5 +392,5 @@
  
 #ifdef IOPHYS
-IF (okiophys) then
+IF (okiophys) THEN
       CALL iophys_ecrit('km2',klev,'m2 conserv','m/s',km2(:,1:klev))
       CALL iophys_ecrit('kn2',klev,'n2 conserv','m/s',kn2(:,1:klev))
@@ -451,5 +450,5 @@
 
 #ifdef IOPHYS
-IF (okiophys) then
+IF (okiophys) THEN
 CALL iophys_ecrit('q2b',klev,'KTE inter','m2/s',q2(:,1:klev))
 END IF
@@ -469,5 +468,5 @@
 
 #ifdef IOPHYS
-IF (okiophys) then
+IF (okiophys) THEN
 CALL iophys_ecrit('mixingl',klev,'Mixing length','m',leff(:,1:klev))
 CALL iophys_ecrit('rife',klev,'Flux Richardson','m',rif(:,1:klev))
Index: /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90	(revision 5116)
@@ -12,12 +12,12 @@
   REAL :: viscom,viscoh,pbl_lmixmin_alpha
   !$OMP THREADPRIVATE( hboville,viscom,viscoh,pbl_lmixmin_alpha)
-  real :: ric, yun,ydeux,lmixmin,b1,kap,kapb
+  REAL :: ric, yun,ydeux,lmixmin,b1,kap,kapb
   !$OMP THREADPRIVATE(ric, yun,ydeux,lmixmin,b1,kap,kapb)
-  integer :: iflag_vdif_q2
+  INTEGER :: iflag_vdif_q2
   !$OMP THREADPRIVATE(iflag_vdif_q2)
 
   real, dimension(:), allocatable, save :: l0
   !$OMP THREADPRIVATE(l0)
-  integer :: lunout,prt_level
+  INTEGER :: lunout,prt_level
   !$OMP THREADPRIVATE(lunout,prt_level)
 
@@ -31,5 +31,5 @@
 ! local
   integer, intent(in) :: klon,lunout_in,prt_level_in
-  real :: ric0
+  REAL :: ric0
   real frif,falpha,fsm,ri
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90	(revision 5116)
@@ -249,5 +249,5 @@
 ! Initialisations
 
-     IF (prt_level >= 5) then
+     IF (prt_level >= 5) THEN
         write (*,*) "In add_phys_tend, after ",text
         CALL flush
@@ -255,7 +255,7 @@
 
      ! if flag_inhib_tend != 0, tendencies are not added
-     IF (flag_inhib_tend /= 0) then
+     IF (flag_inhib_tend /= 0) THEN
         ! If requiered, diagnostics are shown
-        IF (flag_inhib_tend > 0) then
+        IF (flag_inhib_tend > 0) THEN
            ! print some diagnostics if xxx_seri have changed
            CALL cmp_seri(flag_inhib_tend,text)
@@ -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, &
@@ -326,5 +326,5 @@
                 xtl_seri,ql_seri, &
                 'add_phys_tend 321b: '//text,ntraciso,klon,klev)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_vect(xt_seri,klon,klev, &
@@ -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, &
@@ -392,5 +392,5 @@
                 xtl_seri,ql_seri, &
                 'add_phys_tend 138: '//text,ntraciso,klon,klev)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_vect(xt_seri,klon,klev, &
@@ -410,10 +410,10 @@
       DO j = 1, jbad
          i=jadrs(j)
-         if(prt_level>=debug_level) THEN
+         IF(prt_level>=debug_level) THEN
           PRINT*,'PLANTAGE POUR LE POINT i lon lat =',&
                  i,longitude_deg(i),latitude_deg(i),text
           PRINT*,'l    T     dT       Q     dQ    '
           DO k = 1, klev
-             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+             WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
           ENDDO
           CALL print_debug_phys(i,debug_level,text)
@@ -429,10 +429,10 @@
       DO j = 1, jqbad
         i=jqadrs(j)
-          if(prt_level>=debug_level) THEN
+          IF(prt_level>=debug_level) THEN
            PRINT*,'WARNING  : EAU POUR LE POINT i lon lat =',&
                   i,longitude_deg(i),latitude_deg(i),text
            PRINT*,'l    T     dT       Q     dQ    '
            DO k = 1, klev
-              write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+              WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
            ENDDO
           endif
@@ -464,5 +464,5 @@
               enddo
 #endif
-              if(prt_level>=debug_level) THEN
+              IF(prt_level>=debug_level) THEN
                PRINT*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', &
                                     i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int
@@ -486,7 +486,7 @@
             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(prt_level>=debug_level) 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)
                   endif
@@ -504,5 +504,5 @@
               endif
 !              zq=q_seri(i,k)+zdq(i,k)
-!              if (zq.lt.1.e-15) then
+!              if (zq.lt.1.e-15) THEN
 !                 zdq(i,k)=(1.e-15-q_seri(i,k))
 !              endif
@@ -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, &
@@ -523,5 +523,5 @@
                 zdxt,zdq, &
                         'add_phys_tend 175'//text,ntraciso,klon,klev)
-      endif !if (iso_eau.gt.0) then
+      endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_vect(xt_seri,klon,klev, &
@@ -536,16 +536,16 @@
       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
-!            if(prt_level.ge.debug_level) THEN
+!            IF(prt_level.ge.debug_level) THEN
 !             PRINT*,'cas2 i k t_seri zdt',i,k,t_seri(i,k),zdt(i,k)
 !            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
             kqadrs(jqbad) = k
-!            if(prt_level.ge.debug_level) THEN
+!            IF(prt_level.ge.debug_level) THEN
 !             PRINT*,'cas2 i k q_seri zdq',i,k,q_seri(i,k),zdq(i,k)
 !            endif
@@ -557,12 +557,12 @@
          i=jadrs(j)
          k=kadrs(j)
-         if(prt_level>=debug_level) THEN
+         IF(prt_level>=debug_level) THEN
           PRINT*,'PLANTAGE2 POUR LE POINT i itap lon lat txt jbad zdt t',&
                  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
-             write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+             WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
           ENDDO
           CALL print_debug_phys(i,debug_level,text)
@@ -575,12 +575,12 @@
          i=jqadrs(j)
          k=kqadrs(j)
-         if(prt_level>=debug_level) THEN
+         IF(prt_level>=debug_level) THEN
           PRINT*,'WARNING  : EAU2 POUR LE POINT i itap lon lat txt jqbad zdq q zdql ql',&
                  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
-            write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
+            WRITE(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
           ENDDO
           CALL print_debug_phys(i,debug_level,text)
@@ -611,6 +611,5 @@
 !======================================================================
 
-  if (fl_ebil > 0) then
-  
+  if (fl_ebil > 0) THEN
     ! ------------------------------------------------
     ! Compute vertical sum for each atmospheric column
@@ -739,5 +738,5 @@
 ! Initialisations
 
-     IF (prt_level >= 5) then
+     IF (prt_level >= 5) THEN
         write (*,*) "In diag_phys_tend, after ",text
         CALL flush
@@ -745,5 +744,5 @@
 
      debug_level=10
-     if (first) then
+     if (first) THEN
         print *,"TestJLD rcpv, rcw, rcs",rcpv, rcw, rcs
         first=.FALSE.
@@ -759,5 +758,5 @@
   END DO
 
-  if (fl_ebil > 0) then
+  if (fl_ebil > 0) THEN
     ! ------------------------------------------------
     ! Compute vertical sum for each atmospheric column
@@ -790,6 +789,5 @@
 !======================================================================
 
-  if (fl_ebil > 0) then
-  
+  if (fl_ebil > 0) THEN
     ! ------------------------------------------------
     ! Compute vertical sum for each atmospheric column
@@ -938,6 +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.
@@ -975,5 +972,5 @@
 ! Print diagnostics
 ! =================
-  if ( (bilq_ok == 0).and.(bilh_ok == 0) ) then
+  if ( (bilq_ok == 0).and.(bilh_ok == 0) ) THEN
     status="enerbil-OK"
   else
@@ -981,32 +978,32 @@
   end if
 
-  if ( prt_level >= 3) then
-    write(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error,"  H", bilh_error
+  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
-    write(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1)
+  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
-    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)
-    write(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1),d_h_qbs_col(1)
+  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)
+    WRITE(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1),d_h_qbs_col(1)
   end if
 
   specific_diag: SELECT CASE (text)
   CASE("vdf") specific_diag
-    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)
+    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
-      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)
+    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
-      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)
+    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)
     end if
   END SELECT specific_diag
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_wake_tend.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_wake_tend.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_wake_tend.F90	(revision 5116)
@@ -44,5 +44,5 @@
 
 
-     IF (prt_level >= 5) then
+     IF (prt_level >= 5) THEN
         write (*,*) "In add_wake_tend, after ",text
         CALL flush
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/ajsec.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/ajsec.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/ajsec.F90	(revision 5116)
@@ -63,8 +63,8 @@
       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)
-           endif !if (iso_eau.gt.0) then
+           endif !if (iso_eau.gt.0) THEN
          enddo !do k=limbas,limhau
       enddo !do i=1,klon
@@ -136,8 +136,8 @@
         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)
-        endif !if (iso_eau.gt.0) then      
+        endif !if (iso_eau.gt.0) THEN
 #endif
 #endif
@@ -152,8 +152,8 @@
         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)
-        endif !if (iso_eau.gt.0) then      
+        endif !if (iso_eau.gt.0) THEN
 #endif
 #endif
@@ -198,8 +198,8 @@
              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)
-           endif !if (iso_eau.gt.0) then
+           endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC      
            CALL iso_verif_traceur(zxt(1,i,k),'ajsec 181')
@@ -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
@@ -361,8 +361,8 @@
              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)
-           endif !if (iso_eau.gt.0) then
+           endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC      
            CALL iso_verif_traceur(xt(1,i,k),'ajsec 327')
@@ -490,8 +490,8 @@
              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)
-           endif !if (iso_eau.gt.0) then
+           endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC      
            CALL iso_verif_traceur(zxt(1,i,k),'ajsec 436')
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/calwake.F90	(revision 5116)
@@ -258,8 +258,8 @@
 #ifdef ISOVERIF
 ! verif des inputs des wakes
-        write(*,*) 'calwake 257: verif des inputs des wakes'
-  DO l = 1, klev
-    DO i = 1, klon
-      if (iso_eau.gt.0) then
+        WRITE(*,*) 'calwake 257: verif des inputs des wakes'
+  DO l = 1, klev
+    DO i = 1, klon
+      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')
@@ -288,8 +288,8 @@
 #ifdef ISOVERIF
 ! verif des ouputs des wakes
-        write(*,*) 'calwake 286: verif des outputs des wakes'
-  DO l = 1, klev
-    DO i = 1, klon
-      if (iso_eau.gt.0) then
+        WRITE(*,*) 'calwake 286: verif des outputs des wakes'
+  DO l = 1, klev
+    DO i = 1, klon
+      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/clift.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/clift.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/clift.F90	(revision 5116)
@@ -42,6 +42,6 @@
 
   include "YOMCST.h"
-  real :: p,t,rr,rs,plcl,dplcldt,dplcldq,cpd,cpv,cl,cpvmcl,eps,alv0,a,b
-  real :: rh,chi,alv
+  REAL :: p,t,rr,rs,plcl,dplcldt,dplcldq,cpd,cpv,cl,cpvmcl,eps,alv0,a,b
+  REAL :: rh,chi,alv
 
   cpd = rcpd
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90	(revision 5116)
@@ -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
@@ -140,5 +140,5 @@
           enddo
        enddo
-   endif ! if (iso_eau.gt.0) then
+   endif ! if (iso_eau.gt.0) THEN
 #endif
 #endif
@@ -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
@@ -334,5 +334,5 @@
                         'climb_hq 234b',errmax,errmaxrel)
          enddo !DO i = 1, knon
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif
 #endif  
@@ -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')
@@ -674,11 +674,11 @@
        DO i = 1, knon     
         do ixt=1,ntraciso
-         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
-               write(*,*) 'Ccoef_XT(ixt,i,k)=',Ccoef_XT(ixt,i,k)
-               write(*,*) 'Dcoef_XT(ixt,i,k)=',Dcoef_XT(ixt,i,k)
+         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
+               WRITE(*,*) 'Ccoef_XT(ixt,i,k)=',Ccoef_XT(ixt,i,k)
+               WRITE(*,*) 'Dcoef_XT(ixt,i,k)=',Dcoef_XT(ixt,i,k)
              endif
              stop
@@ -689,24 +689,24 @@
 #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  
+     endif !if (iso_eau.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 (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
-                  write(*,*) 'i,k,q_new(i,k)=',i,k,q_new(i,k)                       
+                    'climb_hq_mod 690').eq.1) THEN
+                  WRITE(*,*) 'i,k,q_new(i,k)=',i,k,q_new(i,k)
                   stop
               endif !  if (iso_verif_o18_aberrant_nostop 
-            endif !if (q_seri(i,k).gt.errmax) then   
+            endif !if (q_seri(i,k).gt.errmax) THEN
           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')
@@ -786,6 +786,6 @@
 #ifdef ISO
 #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
+!        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
          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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90	(revision 5116)
@@ -54,5 +54,5 @@
 #endif
 #ifdef ISOTRAC
-      USE isotrac_routines_mod, only: iso_verif_traceur_jbid_vect
+      USE isotrac_routines_mod, ONLY: iso_verif_traceur_jbid_vect
 #ifdef ISOVERIF
       USE isotopes_verif_mod, ONLY: iso_verif_traceur_vect, &
@@ -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   
@@ -483,14 +483,14 @@
         enddo !do i = 1, klon
        enddo !do k = 1, klev   
-       endif !if (iso_eau.gt.0) then
-       if (iso_HDO.gt.0) then
+       endif !if (iso_eau.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 
+         endif ! if (q(i,k).gt.ridicule) THEN
         enddo
        enddo   
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         do k = 1, klev
@@ -500,5 +500,5 @@
         enddo
 #endif       
-       write(*,*) 'concvl 170: avant appel cv_driver'
+       WRITE(*,*) 'concvl 170: avant appel cv_driver'
 #endif
         ! ISOVERIF ! end verif       
@@ -534,13 +534,13 @@
       ! verif
 #ifdef ISOVERIF
-       write(*,*) 'concvl 463: après appel cv_driver'
+       WRITE(*,*) 'concvl 463: après appel cv_driver'
        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')
             CALL iso_verif_egalite(d_xt(iso_eau,i,k),d_q(i,k), &
                   'concvl 452')
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
 #ifdef DIAGISO
          do ixt=1,ntraciso
@@ -577,5 +577,5 @@
     nloc = klon
 #ifdef ISOVERIF
-        write(*,*) 'concvl 581: juste avant appel de cva_driver'
+        WRITE(*,*) 'concvl 581: juste avant appel de cva_driver'
 #endif
     CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
@@ -647,20 +647,20 @@
 !        k=1
 !        i=  538
-        write(*,*) 'concvl 640'
-!        write(*,*) 'q(i,k),d_q(i,k)=', q(i,k),d_q(i,k)
-!        write(*,*) 'xt(iso_HDO,i,k),d_xt(iso_HDO,i,k)=', &
+        WRITE(*,*) 'concvl 640'
+!        WRITE(*,*) 'q(i,k),d_q(i,k)=', q(i,k),d_q(i,k)
+!        WRITE(*,*) 'xt(iso_HDO,i,k),d_xt(iso_HDO,i,k)=', &
 !     &          xt(iso_HDO,i,k),d_xt(iso_HDO,i,k)
   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 
+             endif !if (q_seri(i,k).gt.ridicule) THEN
+          endif !if (iso_HDO.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)
-          endif !if (iso_HDO.gt.0) then 
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur_justmass(d_xt(1,i,k),'concvl 316')
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv30_routines.F90	(revision 5116)
@@ -226,5 +226,5 @@
   ! @         do 190 i=1,len
   ! @          if((hm(i,k).lt.work(i)).and.
-  ! @      &      (hm(i,k).lt.hm(i,k-1)))then
+  ! @      &      (hm(i,k).lt.hm(i,k-1)))THEN
   ! @            work(i)=hm(i,k)
   ! @            ihmin(i)=k
@@ -234,5 +234,5 @@
   ! @       do 210 i=1,len
   ! @         ihmin(i)=min(ihmin(i),nlm)
-  ! @         if(ihmin(i).le.minorig)then
+  ! @         IF(ihmin(i).le.minorig)THEN
   ! @           iflag(i)=6
   ! @         endif
@@ -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
@@ -449,5 +449,5 @@
 
 #ifdef ISOVERIF
-        write(*,*) 'cv30_routine undilute 1 413: entree'
+        WRITE(*,*) 'cv30_routine undilute 1 413: entree'
 #endif
 
@@ -544,5 +544,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
@@ -566,5 +566,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
@@ -612,19 +612,19 @@
        enddo
 #ifdef ISOVERIF
-        write(*,*) 'cv30_routine undilute1 573: avant condiso' 
-        write(*,*) 't(1,1)=',t(1,1)                 
+        WRITE(*,*) 'cv30_routine undilute1 573: avant condiso'
+        WRITE(*,*) 't(1,1)=',t(1,1)
         do i=1,len
            CALL iso_verif_positif(t(i,icbs(i))-Tmin_verif, &
               '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')
-           endif  !if (qnk(i).gt.ridicule) then
+           endif  !if (qnk(i).gt.ridicule) THEN
          enddo        
-        endif !if (iso_HDO.gt.0) then 
-!        write(*,*) 'i=1, clw_k,qnk=',clw_k(1),qnk(1)
+        endif !if (iso_HDO.gt.0) THEN
+!        WRITE(*,*) 'i=1, clw_k,qnk=',clw_k(1),qnk(1)
 #endif
        CALL condiso_liq_ice_vectall(xt_k(1,1),qnk(1), &
@@ -633,5 +633,5 @@
 #ifdef ISOTRAC
 #ifdef ISOVERIF
-        write(*,*) 'cv30_routines 658: CALL condiso_liq_ice_vectall_trac'
+        WRITE(*,*) 'cv30_routines 658: CALL condiso_liq_ice_vectall_trac'
 #endif
         CALL condiso_liq_ice_vectall_trac(xt_k(1,1),qnk(1), &
@@ -647,12 +647,12 @@
 
 #ifdef ISOVERIF
-            write(*,*) 'cv30_routine undilute 1 598: apres condiso'
+            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)), &
                clw(i,icbs(i)),'cv30_routines 577',errmax,errmaxrel)
             enddo !do i=1,len
-          endif !if (iso_eau.gt.0) then 
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC   
         do i=1,len
@@ -712,5 +712,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
@@ -734,5 +734,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-    ! ori          if(tc.ge.0.0)then
+    ! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
     ! ori          else
@@ -784,11 +784,11 @@
         enddo !do i=1,len
 #ifdef ISOVERIF 
-        write(*,*) 'cv30_routines 739: avant condiso'
-        if (iso_HDO.gt.0) then            
+        WRITE(*,*) 'cv30_routines 739: avant condiso'
+        if (iso_HDO.gt.0) THEN
          do i=1,len
            CALL iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), &
                   'cv30_routines 725')
          enddo        
-        endif !if (iso_HDO.gt.0) then 
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC   
         do i=1,len
@@ -813,10 +813,10 @@
 
 #ifdef ISOVERIF            
-!write(*,*) 'DEBUG ISO B'
+!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)
-            endif ! if (iso_eau.gt.0) then 
+            endif ! if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC   
            CALL iso_verif_traceur(xtclw(1,i,icb(i)+1), &
@@ -824,5 +824,5 @@
 #endif            
           enddo !do i=1,len
-            !write(*,*) 'FIN DEBUG ISO B'
+            !WRITE(*,*) 'FIN DEBUG ISO B'
 #endif  
 #endif
@@ -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
@@ -905,5 +905,5 @@
   ! oct3         iflag(i)=4 ! pour version vectorisee
   ! oct3c convect3         iflag(i)=0
-  ! oct3cccc         return
+  ! oct3cccc         RETURN
   ! oct3       endif
   ! oct3
@@ -1009,10 +1009,10 @@
         do k=1,nd
           do i=1,nloc
-            if (essai_convergence) then
+            if (essai_convergence) THEN
             else
               q(i,k)=0.0
               clw(i,k)=0.0 ! mise en commentaire le 5 avril pour verif
 !            convergence
-            endif  !f (negation(essai_convergence)) then
+            endif  !f (negation(essai_convergence)) THEN
             do ixt=1,ntraciso
               xt(ixt,i,k)=0.0
@@ -1021,5 +1021,5 @@
           enddo !do i=1,len
         enddo !do k=1,nd
-!        write(*,*) 'q(1,1),xt(iso_eau,1,1)=',q(1,1),xt(iso_eau,1,1)
+!        WRITE(*,*) 'q(1,1),xt(iso_eau,1,1)=',q(1,1),xt(iso_eau,1,1)
 #endif
 
@@ -1052,5 +1052,5 @@
            xtclw(ixt,nn,k)=xtclw1(ixt,i,k)
         enddo
-!        write(*,*) 'nn,i,k,q(nn,k),xt(iso_eau,nn,k)=', &
+!        WRITE(*,*) 'nn,i,k,q(nn,k),xt(iso_eau,nn,k)=', &
 !                & nn,i,k,q(nn, k),xt(ixt,nn,k)
 #endif
@@ -1063,5 +1063,5 @@
   ! 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)
@@ -1101,8 +1101,8 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       if (iso_eau.gt.0) then
+       if (iso_eau.gt.0) THEN
         do k = 1, nd
          do i = 1, nloc  
-        !write(*,*) 'i,k=',i,k                 
+        !WRITE(*,*) 'i,k=',i,k
         CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
                   'compress 973',errmax,errmaxrel)
@@ -1111,5 +1111,5 @@
          enddo
         enddo
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
        do k = 1, nd
          do i = 1, nn
@@ -1167,5 +1167,5 @@
   ! - vertical profile of buoyancy computed here (use of buoybase)
   ! - the determination of inb is different
-  ! - no inb1, only inb in output
+  ! - no inb1, ONLY inb in output
   ! ---------------------------------------------------------------------
 
@@ -1244,5 +1244,5 @@
   DO k = minorig + 1, nl
     DO i = 1, ncum
-      ! ori	    if(k.ge.(icb(i)+1))then
+      ! ori	    IF(k.ge.(icb(i)+1))THEN
       IF (k>=(icbs(i)+1)) THEN ! convect3
         tg = t(i, k)
@@ -1265,5 +1265,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0) ! convect3
-        ! ori	       if(tc.ge.0.0)then
+        ! ori	       IF(tc.ge.0.0)THEN
         es = 6.112*exp(17.67*tc/denom)
         ! ori	       else
@@ -1285,5 +1285,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0) ! convect3
-        ! ori	       if(tc.ge.0.0)then
+        ! ori	       IF(tc.ge.0.0)THEN
         es = 6.112*exp(17.67*tc/denom)
         ! ori	       else
@@ -1326,17 +1326,17 @@
        enddo !do i=1,ncum
 #ifdef ISOVERIF
-        !write(*,*) 'cv30_routine 1259: avant condiso'
-        if (iso_HDO.gt.0) then            
+        !WRITE(*,*) 'cv30_routine 1259: avant condiso'
+        if (iso_HDO.gt.0) THEN
          do i=1,ncum
            CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
                   'cv30_routines 1231')
          enddo        
-        endif !if (iso_HDO.gt.0) then 
-        if (iso_eau.gt.0) then            
+        endif !if (iso_HDO.gt.0) THEN
+        if (iso_eau.gt.0) THEN
          do i=1,ncum
            CALL iso_verif_egalite(xtnk(iso_eau,i),qnk(i), &
                   'cv30_routines 1373')
          enddo        
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
         do i=1,ncum
          if ((iso_verif_positif_nostop(qnk(i)-clw_k(i), &
@@ -1345,8 +1345,8 @@
              'cv30_routines 1297a').eq.1).or.  &
              (iso_verif_positif_nostop(Tmax_verif-tg_k(i), &
-             '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)
-          write(*,*) 'icbs(i)=',icbs(i)
+             '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)
+          WRITE(*,*) 'icbs(i)=',icbs(i)
           stop
          endif ! if ((iso_verif_positif_nostop
@@ -1363,5 +1363,5 @@
 #ifdef ISOTRAC
 #ifdef ISOVERIF
-        write(*,*) 'cv30_routines 1283: condiso pour traceurs'
+        WRITE(*,*) 'cv30_routines 1283: condiso pour traceurs'
 #endif
         CALL condiso_liq_ice_vectall_trac(xtnk(1,1),qnk(1), &
@@ -1376,10 +1376,10 @@
         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), &
                 clw(i,k),'cv30_routines 1223',errmax,errmaxrel)
           enddo
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC   
         do i=1,ncum
@@ -1405,7 +1405,7 @@
       ep(i, k) = amin1(ep(i,k), epmax)
       sigp(i, k) = spfac
-      ! ori          if(k.ge.(nk(i)+1))then
+      ! ori          IF(k.ge.(nk(i)+1))THEN
       ! ori            tca=tp(i,k)-t0
-      ! ori            if(tca.ge.0.0)then
+      ! ori            IF(tca.ge.0.0)THEN
       ! ori              elacrit=elcrit
       ! ori            else
@@ -1431,5 +1431,5 @@
   ! ori      do 340 k=minorig+1,nl
   ! ori        do 330 i=1,ncum
-  ! ori        if(k.ge.(icb(i)+1))then
+  ! ori        IF(k.ge.(icb(i)+1))THEN
   ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
   ! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
@@ -1508,10 +1508,10 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
@@ -1535,9 +1535,9 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
@@ -1565,11 +1565,11 @@
   ! ori      do 530 k=minorig+1,nl-1
   ! 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(cape(i).lt.0.0)lcape(i)=.FALSE.
+  ! 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)
   ! ori            cape(i)=cape(i)+by
-  ! ori            if(by.ge.0.0)inb1(i)=k+1
-  ! ori            if(cape(i).gt.0.0)then
+  ! ori            IF(by.ge.0.0)inb1(i)=k+1
+  ! ori            IF(cape(i).gt.0.0)THEN
   ! ori              inb(i)=k+1
   ! ori              capem(i)=cape(i)
@@ -1691,5 +1691,5 @@
   END DO
 
-  !      if(inb.lt.(nl-1))then
+  !      IF(inb.lt.(nl-1))THEN
   !         do 85 i=inb+1,nl-1
   !            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
@@ -1841,8 +1841,8 @@
 #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, &
@@ -1923,6 +1923,6 @@
 #ifdef ISO
 #ifdef ISOVERIF
-      write(*,*) 'cv30_routines 1820: entree dans cv3_mixing'
-      if (iso_eau.gt.0) then
+      WRITE(*,*) 'cv30_routines 1820: entree dans cv3_mixing'
+      if (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D( &
                  xtclw,clw, &
@@ -2046,16 +2046,16 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        !write(*,*) 'cv30_routines tmp 2078'
+        !WRITE(*,*) 'cv30_routines tmp 2078'
 #endif
        do il=1,ncum
          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,14 +2099,14 @@
 
 #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
-                write(*,*) 'cv30_routines tmp 2194, il,i,j=',il,i,j
-                write(*,*) 'qent,elij=',qent(il,i,j),elij(il,i,j)
-                write(*,*) 'tgsave,zfice=',t(il,j),zfice(il)
-                write(*,*) 'deltaDqent=',deltaD(xtent(iso_HDO,il,i,j)/qent(il,i,j))
-                write(*,*) 'deltaDelij=',deltaD(xtelij(iso_HDO,il,i,j)/elij(il,i,j))
-                write(*,*) 'deltaDice=',deltaD(zxtice(iso_HDO,il)/(zfice(il)*elij(il,i,j)))
-                write(*,*) 'deltaDliq=',deltaD(zxtliq(iso_HDO,il)/(1.0-zfice(il)*elij(il,i,j)))
+        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)
+                WRITE(*,*) 'tgsave,zfice=',t(il,j),zfice(il)
+                WRITE(*,*) 'deltaDqent=',deltaD(xtent(iso_HDO,il,i,j)/qent(il,i,j))
+                WRITE(*,*) 'deltaDelij=',deltaD(xtelij(iso_HDO,il,i,j)/elij(il,i,j))
+                WRITE(*,*) 'deltaDice=',deltaD(zxtice(iso_HDO,il)/(zfice(il)*elij(il,i,j)))
+                WRITE(*,*) 'deltaDliq=',deltaD(zxtliq(iso_HDO,il)/(1.0-zfice(il)*elij(il,i,j)))
         endif
         endif
@@ -2114,29 +2114,29 @@
 
 #ifdef ISOTRAC    
-!        write(*,*) 'cv30_routines tmp 1987,option_traceurs=',
+!        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),',
+!        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
 !     :           'tcond(il),rs(il,j)=',
 !     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
         ! 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
-!             write(*,*) 'cv3 2002: il,i,j  =',il,i,j   
+            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)
             enddo     
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
         enddo !do il=1,ncum
 #ifdef ISOVERIF
@@ -2148,15 +2148,15 @@
         enddo !do il=1,ncum 
 #endif        
-        endif !if (option_tmin.ge.1) then       
+        endif !if (option_tmin.ge.1) THEN
 #endif
 
 ! fractionation:
 #ifdef ISOVERIF 
-!        write(*,*) 'cv30_routines 2050: avant condiso'
+!        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
+            (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')
@@ -2173,7 +2173,7 @@
                   xtelij(iso_HDO,il,i,j),elij(il,i,j), &
                   ridicule,deltalim,'cv30_routines 1993')
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC  
-!        write(*,*) 'cv30_routines tmp 2039 il=',il
+!        WRITE(*,*) 'cv30_routines tmp 2039 il=',il
            CALL iso_verif_traceur(xtent(1,il,i,j), &
                          'cv30_routines 2031')
@@ -2182,9 +2182,9 @@
 #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
-!        write(*,*) 'cv30_routine tmp 1984: cond=',elij(il,i,j)
+!        WRITE(*,*) 'cv30_routine tmp 1984: cond=',elij(il,i,j)
          
         
@@ -2196,6 +2196,6 @@
     ! 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)
@@ -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,18 +2233,18 @@
 
 #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)
-       endif !if (iso_eau.gt.0) then 
+       endif !if (iso_eau.gt.0) THEN
 #endif
 
 #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)=',
+!        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)
@@ -2270,6 +2270,5 @@
             enddo
 #endif            
-          endif !if (cond.gt.0.0) then
-          
+          endif !if (cond.gt.0.0) THEN
 #ifdef ISOVERIF          
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
@@ -2278,5 +2277,5 @@
           CALL iso_verif_traceur(xtelij(1,il,i,i),'cv30_routines 2096')
 #endif        
-        endif !if (option_tmin.ge.1) then    
+        endif !if (option_tmin.ge.1) THEN
 #endif
 
@@ -2289,5 +2288,5 @@
   ! 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
@@ -2467,18 +2466,18 @@
 
 #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)
-      endif  !if (iso_eau.gt.0) then
+      endif  !if (iso_eau.gt.0) THEN
 #endif
 
 #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)=',
+!        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), &
@@ -2486,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), &
@@ -2492,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)
@@ -2504,5 +2503,5 @@
             enddo
 #endif               
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
 #ifdef ISOVERIF          
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
@@ -2511,5 +2510,5 @@
           CALL iso_verif_traceur(xtelij(1,il,i,i),'cv30_routines 2323')
 #endif        
-        endif !if (option_tmin.ge.1) then
+        endif !if (option_tmin.ge.1) THEN
 #endif
       END IF
@@ -2519,5 +2518,5 @@
     ! 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
+    ! :     .and. csum(il,i).lt.m(il,i) ) THEN
     ! traent(il,i,i,j)=tra(il,nk(il),j)
     ! endif
@@ -2561,10 +2560,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),'cv30_mixing 2110',errmax,errmaxrel)
             CALL iso_verif_egalite_choix(xtent(iso_eau,il,im,jm),  &
                qent(il,im,jm),'cv30_mixing 2112',errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(xtelij(1,il,im,jm), &
@@ -2580,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
@@ -2586,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
@@ -2605,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
@@ -2618,8 +2617,8 @@
         if (iso_verif_positif_nostop(xtclw(itZonIso( &
                  izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-                 ,'cv30_routines 909').eq.1) then
-               write(*,*) 'i,k=',i,k
-               write(*,*) 'xtclw=',xtclw(:,i,k)
-               write(*,*) 'niso,ntraciso,index_zone,izone_cond=', &
+                 ,'cv30_routines 909').eq.1) THEN
+               WRITE(*,*) 'i,k=',i,k
+               WRITE(*,*) 'xtclw=',xtclw(:,i,k)
+               WRITE(*,*) 'niso,ntraciso,index_zone,izone_cond=', &
                    niso,ntraciso,index_zone,izone_cond
                stop
@@ -2628,6 +2627,6 @@
          enddo !do il = 1, ncum   
          enddo !do im = 1, nd
-!         write(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
-        endif !if (option_tmin.eq.1) then
+!         WRITE(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
+        endif !if (option_tmin.eq.1) THEN
 #endif
 #endif
@@ -2658,5 +2657,5 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, only: option_cond,izone_cond
+    use isotrac_mod, ONLY: option_cond,izone_cond
     use infotrac_phy, ONLY: itZonIso
 #ifdef ISOVERIF
@@ -2739,5 +2738,5 @@
   ! ------------------------------------------------------
 !#ifdef ISOVERIF
-!        write(*,*) 'cv30_routines 2382: entree dans cv3_unsat'
+!        WRITE(*,*) 'cv30_routines 2382: entree dans cv3_unsat'
 !#endif
 
@@ -2775,10 +2774,10 @@
 !-- debug
 #ifdef ISOVERIF
-            if(iso_eau.gt.0) then
+            IF(iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xt(iso_eau,il,i),rr(il,i), &
                         'cv30_unsat 2245 ',errmax,errmaxrel)
              CALL iso_verif_egalite_choix(xtp(iso_eau,il,i),rp(il,i), &
                          'cv30_unsat 2247 ',errmax,errmaxrel)
-            endif !if(iso_eau.gt.0) then
+            endif !IF(iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xt(1,il,i),'cv30_routine 2410')
@@ -2853,8 +2852,8 @@
 !--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)
-             endif !if (iso_eau.gt.0) then
+             endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtwdtrain(1,il),'cv30_routine 2480')
@@ -2887,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))
@@ -2900,8 +2899,8 @@
 
 #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)
-              endif !if (iso_eau.gt.0) then
+              endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtawat(1),'cv30_routine 2522')
@@ -2925,26 +2924,26 @@
            enddo !!do ixt=1,ntraciso
 #endif
-            END IF !if (cvflag_grav) then
+            END IF !if (cvflag_grav) THEN
 #ifdef ISO
 !--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)
-              endif !if (iso_eau.gt.0) then
+              endif !if (iso_eau.gt.0) THEN
 #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( &
                 xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
                 -xtwdtrain(iso_eau,il), &
-                'cv30_routines 2795').eq.1) then
-          write(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
-          write(*,*) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i)
-          write(*,*) 'xtclw(:,il,i)=',xtclw(:,il,i)
+                'cv30_routines 2795').eq.1) THEN
+          WRITE(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
+          WRITE(*,*) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i)
+          WRITE(*,*) 'xtclw(:,il,i)=',xtclw(:,il,i)
           stop
           endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
-        endif !if (option_cond.ge.1) then
+        endif !if (option_cond.ge.1) THEN
 #endif              
 #endif
@@ -3004,5 +3003,5 @@
         ! jyg1
         ! cc        sigt=1.0
-        ! cc        if(i.ge.icb)sigt=sigp(i)
+        ! cc        IF(i.ge.icb)sigt=sigp(i)
         ! prise en compte de la variation progressive de sigt dans
         ! les couches icb et icb-1:
@@ -3190,18 +3189,18 @@
 #ifdef ISOVERIF
 ! verif des inputs a appel stewart
-!        write(*,*) 'cv30_routines 2842 tmp: appel de appel_stewart'
+!        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)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
 !#ifdef ISOTRAC
-!        if (option_tmin.ge.1) then
+!        if (option_tmin.ge.1) THEN
 !           CALL iso_verif_positif(xtwater(
 !     :           itZonIso(izone_cond,iso_eau),il,i+1)
 !     :           -xtwater(iso_eau,il,i+1),
 !     :          'cv30_routines 3083')
-!        endif !if (option_tmin.ge.1) then
+!        endif !if (option_tmin.ge.1) THEN
 !#endif
         endif
@@ -3209,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, &
@@ -3221,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
@@ -3227,12 +3226,10 @@
                 evap,water,rpprec,rr,wdtrain, &
                 xtevap,xtwater,xtp,xt,xtwdtrain)
-        endif ! if (1.eq.0) then
-
-
-#ifdef ISOVERIF
-!        write(*,*) 'cv30_routines 2864 tmp: sortie de appel_stewart'
+        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')
@@ -3240,23 +3237,23 @@
           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)
           CALL iso_verif_egalite_choix(xtwater(iso_eau,il,i), &
                  water(il,i),'cv30_unsat 2747',errmax,errmaxrel)
-!         write(*,*) 'xtwater(4,il,i)=',xtwater(4,il,i)
-!         write(*,*) 'water(il,i)=',water(il,i)
+!         WRITE(*,*) 'xtwater(4,il,i)=',xtwater(4,il,i)
+!         WRITE(*,*) 'water(il,i)=',water(il,i)
           CALL iso_verif_egalite_choix(xtevap(iso_eau,il,i), &
                  evap(il,i),'cv30_unsat 2751',errmax,errmaxrel)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
          if ((iso_HDO.gt.0).and. &
-                 (rp(il,i).gt.ridicule)) then
+                 (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.
 #ifdef ISOTRAC
-!        if (il.eq.602) then
-!        write(*,*) 'cv30_routine tmp: il,i=',il,i
-!        write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
+!        if (il.eq.602) THEN
+!        WRITE(*,*) 'cv30_routine tmp: il,i=',il,i
+!        WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
 !     :          xtp(iso_eau:ntraciso:3,il,i)
 !        endif
@@ -3268,12 +3265,12 @@
         CALL iso_verif_traceur_justmass(xtevap(1,il,i), &
                           'cv30_routine 2854')
-!        if (option_tmin.ge.1) then
+!        if (option_tmin.ge.1) THEN
 !         CALL iso_verif_positif(xtwater(
 !     :           itZonIso(izone_cond,iso_eau),il,i)
 !     :           -xtwater(iso_eau,il,i),
 !     :          'cv30_routines 3143')
-!        endif !if (option_tmin.ge.1) then
+!        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
@@ -3281,9 +3278,8 @@
 ! 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
-                write(*,*) 'cv3unsat 2640'
+        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
             endif
@@ -3296,6 +3292,6 @@
            CALL iso_verif_noNaN(xtp(ixt,il,i),'cv3unsat 2641')
            enddo !do ixt=1,niso
-           if (iso_eau.gt.0) then
-!             write(*,*) 'xtp(iso_eau,il,i)=',xtp(iso_eau,il,i)  
+           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), &
                         'cv3unsat 2653',errmax,errmaxrel)
@@ -3304,8 +3300,8 @@
            endif  
            if ((iso_HDO.gt.0).and. &
-                 (rp(il,i).gt.ridicule)) then
+                 (rp(il,i).gt.ridicule)) 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)=', &
+                        'cv3unsat 2658').eq.1) THEN
+                WRITE(*,*) 'rpprec(il,i),rs(il,i),rp(il,i)=', &
                          rpprec(il,i),rs(il,i),rp(il,i)
                 stop
@@ -3317,5 +3313,5 @@
 #endif
           rpprec(il,i)=rs(il,i)            
-         endif !if (rp(il,i).gt.rs(il,i)) then           
+         endif !if (rp(il,i).gt.rs(il,i)) THEN
          endif !if (i.lt.INB et lwork)
         enddo ! il=1,ncum
@@ -3327,12 +3323,12 @@
 ! fin de la boucle en i (altitude)
 #ifdef ISO   
-      write(*,*) 'nl=',nl,'nd=',nd,'; ncum=',ncum  
+      WRITE(*,*) 'nl=',nl,'nd=',nd,'; ncum=',ncum
 #ifdef ISOVERIF
       do i=1,nl !nl
         do il=1,ncum
-        if (iso_eau.gt.0) then
-!            write(*,*) 'cv30_routines 2767:i,il,lwork(il),inb(il)=',
+        if (iso_eau.gt.0) THEN
+!            WRITE(*,*) 'cv30_routines 2767:i,il,lwork(il),inb(il)=',
 !     :           i,il,lwork(il),inb(il)
-!            write(*,*) 'rp(il,i),xtp(iso_eau,il,i)=',
+!            WRITE(*,*) 'rp(il,i),xtp(iso_eau,il,i)=',
 !     :           rp(il,i),xtp(iso_eau,il,i)  
             CALL iso_verif_egalite_choix(xt(iso_eau,il,i), &
@@ -3342,12 +3338,12 @@
            CALL iso_verif_egalite_choix(xtwater(iso_eau,il,i), &
                  water(il,i),'cv30_unsat 2672',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 !#ifdef ISOTRAC
 !        if (iso_verif_traceur_choix_nostop(xtwater(1,il,i),
 !     :       'cv30_routine 2982 unsat',errmax,
-!     :       errmaxrel,ridicule_trac,deltalimtrac).eq.1) then
-!              write(*,*) 'il,i,inb(il),lwork(il)=',
+!     :       errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+!              WRITE(*,*) 'il,i,inb(il),lwork(il)=',
 !     :           il,i,inb(il),lwork(il)
-!              write(*,*) 'xtwater(:,il,i)=',xtwater(:,il,i)
+!              WRITE(*,*) 'xtwater(:,il,i)=',xtwater(:,il,i)
 !              stop
 !        endif
@@ -3357,5 +3353,5 @@
       il=5
       i=39 
-      write(*,*) 'cv30_unsat 2780: il,water(il,i),xtwater(iso_eau,il,i)=' &
+      WRITE(*,*) 'cv30_unsat 2780: il,water(il,i),xtwater(iso_eau,il,i)=' &
                ,il,water(il,i),xtwater(iso_eau,il,i)
 #endif
@@ -3392,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, &
 &       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
@@ -3527,5 +3523,5 @@
 #ifdef ISO
        ! cam debug
-!       write(*,*) 'cv30_routines 3082: entree dans cv3_yield'
+!       WRITE(*,*) 'cv30_routines 3082: entree dans cv3_yield'
        ! en cam debug
        do ixt = 1, ntraciso
@@ -3600,6 +3596,6 @@
          ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) then
-!              write(*,*) 'cv30_yield 2952: '//
+          if (iso_eau.gt.0) THEN
+!              WRITE(*,*) 'cv30_yield 2952: '//
 !     :           'il,water(il,1),xtwater(iso_eau,il,1)='
 !     :           ,il,water(il,1),xtwater(iso_eau,il,1)
@@ -3612,5 +3608,5 @@
                  precip(il),'cv30_routines 3138', &
                  errmax*4e3,errmaxrel)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtwater(1,il,1), &
@@ -3618,9 +3614,9 @@
         if (iso_verif_traceur_choix_nostop(xtprecip(1,il), &
                  'cv30_routine 3147',errmax*1e2, &
-             errmaxrel,ridicule_trac,deltalimtrac).eq.1) then
-          write(*,*) 'il,inb(il)=',il,inb(il)
-          write(*,*) 'xtwater(:,il,1)=',xtwater(:,il,1)
-          write(*,*) 'xtprecip(:,il)=',xtprecip(:,il)
-          write(*,*) 'fac=',wt(il,1)*sigd*86400.*1000./(rowl*grav)
+             errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+          WRITE(*,*) 'il,inb(il)=',il,inb(il)
+          WRITE(*,*) 'xtwater(:,il,1)=',xtwater(:,il,1)
+          WRITE(*,*) 'xtprecip(:,il)=',xtprecip(:,il)
+          WRITE(*,*) 'fac=',wt(il,1)*sigd*86400.*1000./(rowl*grav)
           stop
         endif
@@ -3637,9 +3633,9 @@
          ! 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', &
                  errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtprecip(1,il),'cv30_routine 3166')
@@ -3799,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
@@ -3814,22 +3810,22 @@
                        + dx_tmp/delt
 #ifdef ISOVERIF
-                if (ixt.eq.iso_HDO) then
-                write(*,*) 'cv30_routines 3888: il=',il
-                write(*,*) 'dq_tmp,rr(il,1)=',dq_tmp,rr(il,1)
-                write(*,*) 'R_tmp,dx_tmp,delt=',R_tmp,dx_tmp,delt
-                write(*,*) 'xt(ixt,il,1:2)=',xt(ixt,il,1:2)
-                write(*,*) 'rr(il,1:2)=',rr(il,1:2)
-                write(*,*) 'fxt=',dx_tmp/delt
-                write(*,*) 'rr(il,1)+dq_tmp=',rr(il,1)+dq_tmp
-                write(*,*) 'xt(ixt,il,1)+dx_tmp=',xt(ixt,il,1)+dx_tmp
-                write(*,*) 'xt(ixt,il,1)+fxt(ixt,il,1)*delt=', &
+                if (ixt.eq.iso_HDO) THEN
+                WRITE(*,*) 'cv30_routines 3888: il=',il
+                WRITE(*,*) 'dq_tmp,rr(il,1)=',dq_tmp,rr(il,1)
+                WRITE(*,*) 'R_tmp,dx_tmp,delt=',R_tmp,dx_tmp,delt
+                WRITE(*,*) 'xt(ixt,il,1:2)=',xt(ixt,il,1:2)
+                WRITE(*,*) 'rr(il,1:2)=',rr(il,1:2)
+                WRITE(*,*) 'fxt=',dx_tmp/delt
+                WRITE(*,*) 'rr(il,1)+dq_tmp=',rr(il,1)+dq_tmp
+                WRITE(*,*) 'xt(ixt,il,1)+dx_tmp=',xt(ixt,il,1)+dx_tmp
+                WRITE(*,*) 'xt(ixt,il,1)+fxt(ixt,il,1)*delt=', &
                          xt(ixt,il,1)+fxt(ixt,il,1)*delt
-                write(*,*) 'dqreste_tmp,dxreste_tmp=',dqreste_tmp,dxreste_tmp
-                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
+                WRITE(*,*) 'dqreste_tmp,dxreste_tmp=',dqreste_tmp,dxreste_tmp
+                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
 #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
@@ -3837,5 +3833,5 @@
 #endif
            enddo ! do ixt = 1, ntraciso
-        else !if (dq_tmp/rr(il,1).lt.-0.9) then
+        else !if (dq_tmp/rr(il,1).lt.-0.9) THEN
                 ! formulation habituelle qui avait toujours marche de 2006 a
                 ! decembre 2017.
@@ -3844,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)
@@ -3850,35 +3846,34 @@
 #endif
            enddo !do ixt = 1, ntraciso
-        endif !if (dq_tmp/rr(il,1).lt.-0.9) then
-
+        endif !if (dq_tmp/rr(il,1).lt.-0.9) THEN
        ! 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
-          !write(*,*) 'il,am(il)=',il,am(il)
+          endif !if (iso_eau.gt.0) THEN
+          !WRITE(*,*) 'il,am(il)=',il,am(il)
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
             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
-                write(*,*) 'il,rr(il,1),delt=',il,rr(il,1),delt
-                write(*,*) 'deltaDxt=',deltaD(xt(iso_HDO,il,1)/rr(il,1))
-                write(*,*) 'delt*fr(il,1),fr(il,1)=',delt*fr(il,1),fr(il,1)
-                write(*,*) 'fxt=',fxt(iso_HDO,il,1)
-                write(*,*) 'fq_ddft(il,1)=',0.01*grav*mp(il,2)*(rp(il,2)-rr(il,1))*work(il)
-                write(*,*) 'fq_evapprecip(il,1)=',sigd*0.5*(evap(il,1)+evap(il,2))
-                write(*,*) 'fq_fluxmasse(il,1)=', 0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)
-                write(*,*) 'deltaDfq_ddft=',deltaD((xtp(iso_HDO,il,2)-xt(iso_HDO,il,1))/(rp(il,2)-rr(il,1)))
-                write(*,*) 'deltaDfq_evapprecip=',deltaD((xtevap(iso_HDO,il,1)+xtevap(iso_HDO,il,2))/(evap(il,1)+evap(il,2)))
-                write(*,*) 'deltaDfq_fluxmasse=',deltaD((xt(iso_HDO,il,2)-xt(iso_HDO,il,1))/(rr(il,2)-rr(il,1)))
-                write(*,*) 'rr(il,2),rr(il,1)=',rr(il,2),rr(il,1)
-                write(*,*) 'xt(iso_HDO,il,2),xt(iso_HDO,il,1)',xt(iso_HDO,il,2),xt(iso_HDO,il,1)
-                write(*,*) 'dq_tmp=',dq_tmp
+                 '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))
+                WRITE(*,*) 'delt*fr(il,1),fr(il,1)=',delt*fr(il,1),fr(il,1)
+                WRITE(*,*) 'fxt=',fxt(iso_HDO,il,1)
+                WRITE(*,*) 'fq_ddft(il,1)=',0.01*grav*mp(il,2)*(rp(il,2)-rr(il,1))*work(il)
+                WRITE(*,*) 'fq_evapprecip(il,1)=',sigd*0.5*(evap(il,1)+evap(il,2))
+                WRITE(*,*) 'fq_fluxmasse(il,1)=', 0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)
+                WRITE(*,*) 'deltaDfq_ddft=',deltaD((xtp(iso_HDO,il,2)-xt(iso_HDO,il,1))/(rp(il,2)-rr(il,1)))
+                WRITE(*,*) 'deltaDfq_evapprecip=',deltaD((xtevap(iso_HDO,il,1)+xtevap(iso_HDO,il,2))/(evap(il,1)+evap(il,2)))
+                WRITE(*,*) 'deltaDfq_fluxmasse=',deltaD((xt(iso_HDO,il,2)-xt(iso_HDO,il,1))/(rr(il,2)-rr(il,1)))
+                WRITE(*,*) 'rr(il,2),rr(il,1)=',rr(il,2),rr(il,1)
+                WRITE(*,*) 'xt(iso_HDO,il,2),xt(iso_HDO,il,1)',xt(iso_HDO,il,2),xt(iso_HDO,il,1)
+                WRITE(*,*) 'dq_tmp=',dq_tmp
                 CALL abort_physic('cv30_routines','cv30_yield',1)
             endif ! iso_verif_aberrant_enc_nostop
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3417')
@@ -3887,18 +3882,18 @@
         enddo
         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)
-              write(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
+                 .eq.1) THEN
+              WRITE(*,*) 'il=',il
+              WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
+              WRITE(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
 #ifdef DIAGISO
-              write(*,*) 'fxt_fluxmasse(:,il,1)=',fxt_fluxmasse(:,il,1)
-              write(*,*) 'fxt_ddft(:,il,1)=',fxt_ddft(:,il,1)
-              write(*,*) 'fxt_evapprecip(:,il,1)=', &
+              WRITE(*,*) 'fxt_fluxmasse(:,il,1)=',fxt_fluxmasse(:,il,1)
+              WRITE(*,*) 'fxt_ddft(:,il,1)=',fxt_ddft(:,il,1)
+              WRITE(*,*) 'fxt_evapprecip(:,il,1)=', &
                          fxt_evapprecip(:,il,1)
-              write(*,*) 'xt(:,il,2)=',xt(:,il,2)
-              write(*,*) 'xtp(:,il,2)=',xtp(:,il,2)
-              write(*,*) 'xtevap(:,il,1)=',xtevap(:,il,1)
-              write(*,*) 'xtevap(:,il,2)=',xtevap(:,il,2)
-              write(*,*) 'facam,facmp,facev=',0.01*grav*am(il)*work(il), &
+              WRITE(*,*) 'xt(:,il,2)=',xt(:,il,2)
+              WRITE(*,*) 'xtp(:,il,2)=',xtp(:,il,2)
+              WRITE(*,*) 'xtevap(:,il,1)=',xtevap(:,il,1)
+              WRITE(*,*) 'xtevap(:,il,2)=',xtevap(:,il,2)
+              WRITE(*,*) 'facam,facmp,facev=',0.01*grav*am(il)*work(il), &
                 0.01*grav*mp(il,2)*work(il),sigd*0.5
 #endif                            
@@ -3948,16 +3943,16 @@
        ! 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
+          endif !if (iso_eau.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
                  +delt*fxt(iso_HDO,il,1)) &
                  /(rr(il,1)+delt*fr(il,1)), &
                  'cv30_yield 3125b, ddft en 1')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1), &
@@ -3968,8 +3963,8 @@
         if (iso_verif_tracpos_choix_nostop(xtnew, &
                  'cv30_yield 3449',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il=',il   
-              write(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
-              write(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
+                 .eq.1) THEN
+              WRITE(*,*) 'il=',il
+              WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
+              WRITE(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
 !              stop
         endif
@@ -3988,5 +3983,5 @@
   ! do j=1,ntra
   ! do il=1,ncum
-  ! if (cvflag_grav) then
+  ! if (cvflag_grav) THEN
   ! ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
   ! :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
@@ -4034,14 +4029,14 @@
        ! 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
+          endif !if (iso_eau.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
                +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), &
                'cv30_yield 3127, dtr melanges')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3417')
@@ -4050,10 +4045,10 @@
         enddo
         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)
-              write(*,*) 'fac=', 0.01*grav*work(il)*ment(il,j,1)
-              write(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
-              write(*,*) 'xtent(:,il,j,1)=' ,xtent(:,il,j,1) 
+                 .eq.1) THEN
+              WRITE(*,*) 'il=',il
+              WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
+              WRITE(*,*) 'fac=', 0.01*grav*work(il)*ment(il,j,1)
+              WRITE(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
+              WRITE(*,*) 'xtent(:,il,j,1)=' ,xtent(:,il,j,1)
 !              stop
         endif
@@ -4094,14 +4089,14 @@
        ! 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
+          endif !if (iso_eau.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) &
               +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), &
               'cv30_yield 3127b, dtr melanges')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3462')
@@ -4110,6 +4105,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3753',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il=',il   
+                 .eq.1) THEN
+              WRITE(*,*) 'il=',il
         endif
 #endif            
@@ -4126,7 +4121,6 @@
   ! do j=2,nl
   ! do il=1,ncum
-  ! if (j.le.inb(il)) then
-
-  ! if (cvflag_grav) then
+  ! if (j.le.inb(il)) THEN
+  ! if (cvflag_grav) THEN
   ! ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
   ! :                *(traent(il,j,1,k)-tra(il,1,k))
@@ -4251,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
@@ -4261,18 +4255,18 @@
             fxt(ixt,il,i)= dx_tmp/delt
 #ifdef ISOVERIF
-                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)
-                write(*,*) 'R_tmp,dx_tmp,delt=',R_tmp,dx_tmp,delt
-                write(*,*) 'amp1(il),ad(il)=',amp1(il),ad(il)
-                write(*,*) 'xt(ixt,il,i-1:i+1)=',xt(ixt,il,i-1:i+1)
-                write(*,*) 'rr(il,i-1:i+1)=',rr(il,i-1:i+1)
-                write(*,*) 'fxt=',dx_tmp/delt
-                write(*,*) 'rr(il,i)+dq_tmp=',rr(il,1)+dq_tmp
-                write(*,*) 'xt(ixt,il,i)+dx_tmp=',xt(ixt,il,i)+dx_tmp
-                write(*,*) 'xt(ixt,il,i)+fxt(ixt,il,i)*delt=', &
+                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)
+                WRITE(*,*) 'R_tmp,dx_tmp,delt=',R_tmp,dx_tmp,delt
+                WRITE(*,*) 'amp1(il),ad(il)=',amp1(il),ad(il)
+                WRITE(*,*) 'xt(ixt,il,i-1:i+1)=',xt(ixt,il,i-1:i+1)
+                WRITE(*,*) 'rr(il,i-1:i+1)=',rr(il,i-1:i+1)
+                WRITE(*,*) 'fxt=',dx_tmp/delt
+                WRITE(*,*) 'rr(il,i)+dq_tmp=',rr(il,1)+dq_tmp
+                WRITE(*,*) 'xt(ixt,il,i)+dx_tmp=',xt(ixt,il,i)+dx_tmp
+                WRITE(*,*) 'xt(ixt,il,i)+fxt(ixt,il,i)*delt=', &
                          xt(ixt,il,i)+fxt(ixt,il,i)*delt
-                write(*,*) 'fxt(:,il,i)=',fxt(:,il,i)
-                endif !if (ixt.eq.iso_HDO) then  
+                WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i)
+                endif !if (ixt.eq.iso_HDO) THEN
 #endif 
         enddo ! do ixt = 1, ntraciso  
@@ -4282,5 +4276,5 @@
         enddo
 #endif  
-       else !if (dq_tmp/rr(il,i).lt.-0.9) then
+       else !if (dq_tmp/rr(il,i).lt.-0.9) THEN
         ! ancienne formulation
          do ixt = 1, ntraciso
@@ -4296,30 +4290,28 @@
         enddo
 #endif  
-       endif !if (dq_tmp/rr(il,i).lt.-0.9) then
-          
-       
+       endif !if (dq_tmp/rr(il,i).lt.-0.9) THEN
        ! 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)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
         do ixt=1,niso
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229')
         enddo
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (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 3384, flux masse')
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
         if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
                  (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)), &
                  'cv30_yield 3384,O18, flux masse')
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3626')
@@ -4328,12 +4320,12 @@
         enddo
         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)
-              write(*,*) 'amp1(il),ad(il),fac=',  &
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
+              WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i)
+              WRITE(*,*) 'amp1(il),ad(il),fac=',  &
                     amp1(il),ad(il),0.01*grav*dpinv
-              write(*,*) 'xt(:,il,i+1)=' ,xt(:,il,i+1)
-              write(*,*) 'xt(:,il,i)=' ,xt(:,il,i) 
-              write(*,*) 'xt(:,il,i-1)=' ,xt(:,il,i-1)
+              WRITE(*,*) 'xt(:,il,i+1)=' ,xt(:,il,i+1)
+              WRITE(*,*) 'xt(:,il,i)=' ,xt(:,il,i)
+              WRITE(*,*) 'xt(:,il,i-1)=' ,xt(:,il,i-1)
 !              stop
         endif
@@ -4370,8 +4362,8 @@
        ! 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)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
           do ixt=1,niso
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229')
@@ -4379,9 +4371,9 @@
           ! correction 21 oct 2008
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (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)) &
@@ -4390,6 +4382,6 @@
                  /(rr(il,i)+delt*fr(il,i)), &
                  'cv30_yield 3384bO18 flux masse')
-        endif !if (iso_O18.gt.0) then
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_O18.gt.0) THEN
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv30_routine 3674')
@@ -4398,6 +4390,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3775',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
         endif
 #endif          
@@ -4412,8 +4404,8 @@
     ! do k=1,ntra
     ! do il=1,ncum
-    ! if (i.le.inb(il)) then
+    ! if (i.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
     ! :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
@@ -4447,10 +4439,10 @@
         ! 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))
 !          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
         enddo
-      else !if (elij(il,k,i).gt.0.0) then
+      else !if (elij(il,k,i).gt.0.0) THEN
           ! normalement, si elij(il,k,i)<=0, alors awat=0
           ! on le verifie. Si c'est vrai -> xtawat=0 aussi
@@ -4465,8 +4457,8 @@
       ! 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)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(xtawat(1),'cv30_routine 3729')
@@ -4509,40 +4501,40 @@
       ! 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)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
         do ixt=1,niso
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3328')
         enddo
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
         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
-           write(*,*) 'il,k,i=',il,k,i
-           write(*,*) 'rr,delt,fr=',rr(il,i),delt,fr(il,i)
-           write(*,*) 'frnew=',0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat-rr(il,i))
-           write(*,*) 'frold=',fr(il,i)-0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat-rr(il,i))
-           write(*,*) 'deltaDfrnew=',deltaD((xtent(iso_HDO,il,k,i)-xtawat(iso_HDO)-xt(iso_HDO,il,i)) &
+                 .eq.1) THEN
+           WRITE(*,*) 'il,k,i=',il,k,i
+           WRITE(*,*) 'rr,delt,fr=',rr(il,i),delt,fr(il,i)
+           WRITE(*,*) 'frnew=',0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat-rr(il,i))
+           WRITE(*,*) 'frold=',fr(il,i)-0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat-rr(il,i))
+           WRITE(*,*) 'deltaDfrnew=',deltaD((xtent(iso_HDO,il,k,i)-xtawat(iso_HDO)-xt(iso_HDO,il,i)) &
                 /(qent(il,k,i)-awat-rr(il,i)))
-           write(*,*) 'deltaDfrold=',deltaD((fxt(iso_HDO,il,i) &
+           WRITE(*,*) 'deltaDfrold=',deltaD((fxt(iso_HDO,il,i) &
                 -0.01*grav*dpinv*ment(il, k, i)*(xtent(iso_HDO,il,k,i)-xtawat(iso_HDO)-xt(iso_HDO,il,i))) &
                 /(fr(il,i)-0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat-rr(il,i))))
-           write(*,*) 'q+=',rr(il,i)+delt*fr(il,i)
-           write(*,*) 'qent,awat=',qent(il,k,i),awat
-           write(*,*) 'elij,clw,ep=',elij(il,k,i),clw(il,i),ep(il,i)
-           write(*,*) 'deltaDfr=',deltaD(fxt(iso_hdo,il,i)/fr(il,i))
-           write(*,*) 'deltaDrr=',deltaD(xt(iso_hdo,il,i)/rr(il,i))
-           write(*,*) 'deltaDqent=',deltaD(xtent(iso_hdo,il,k,i) &
+           WRITE(*,*) 'q+=',rr(il,i)+delt*fr(il,i)
+           WRITE(*,*) 'qent,awat=',qent(il,k,i),awat
+           WRITE(*,*) 'elij,clw,ep=',elij(il,k,i),clw(il,i),ep(il,i)
+           WRITE(*,*) 'deltaDfr=',deltaD(fxt(iso_hdo,il,i)/fr(il,i))
+           WRITE(*,*) 'deltaDrr=',deltaD(xt(iso_hdo,il,i)/rr(il,i))
+           WRITE(*,*) 'deltaDqent=',deltaD(xtent(iso_hdo,il,k,i) &
                         /qent(il,k,i))
-           write(*,*) 'deltaDqent-awat=',deltaD((xtent(iso_hdo,il,k,i)-xtawat(iso_HDO)) &
+           WRITE(*,*) 'deltaDqent-awat=',deltaD((xtent(iso_hdo,il,k,i)-xtawat(iso_HDO)) &
                         /(qent(il,k,i)-awat))
-           write(*,*) 'deltaDawat=',deltaD(xtawat(iso_hdo)/awat) 
-           write(*,*) 'deltaDclw=',deltaD(xtclw(iso_hdo,il,i)/clw(il,i))          
+           WRITE(*,*) 'deltaDawat=',deltaD(xtawat(iso_hdo)/awat)
+           WRITE(*,*) 'deltaDclw=',deltaD(xtclw(iso_hdo,il,i)/clw(il,i))
 !           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)) &
@@ -4551,6 +4543,6 @@
                  /(rr(il,i)+delt*fr(il,i)), &
                  'cv30_yield 3396aO18, dtr mels')
-        endif !if (iso_O18.gt.0) then
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_O18.gt.0) THEN
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3784')
@@ -4559,6 +4551,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3905',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv30_yield 3905',1e-5)
@@ -4599,24 +4591,24 @@
       ! 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)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
         do ixt=1,niso
             CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3353')
         enddo
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (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 3396b, dtr mels')
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
         if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
                  (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)), &
                  'cv30_yield 3396b,O18, dtr mels')
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3828')
@@ -4625,6 +4617,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3949',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv30_yield 3949',1e-5)
@@ -4646,8 +4638,8 @@
     ! do k=1,i-1
     ! do il=1,ncum
-    ! if (i.le.inb(il)) then
+    ! if (i.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     ! :        *(traent(il,k,i,j)-tra(il,i,j))
@@ -4697,8 +4689,8 @@
        ! cam verif
 #ifdef ISOVERIF
-        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)
-                write(*,*) 'q,qe=',rr(il,i),qent(il,k,i)
+        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)
+                WRITE(*,*) 'q,qe=',rr(il,i),qent(il,k,i)
                 bx=0.01*grav*dpinv*ment(il,k,i)*(qent(il,k,i)-rr(il,i))
                 do ixt=1,niso
@@ -4711,30 +4703,30 @@
 #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)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
         do ixt=1,niso
             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 (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
-                write(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
-                write(*,*) 'fr(il,i)=',fr(il,i)
-!                if (fr(il,i).gt.ridicule*1e5) 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)
+!                if (fr(il,i).gt.ridicule*1e5) THEN
 !                 stop
 !                endif
                endif
-        endif !if (iso_HDO.gt.0) then
-        endif !if (1.eq.0) then
+        endif !if (iso_HDO.gt.0) THEN
+        endif !if (1.eq.0) THEN
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (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)) &
@@ -4743,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))) &
@@ -4750,7 +4742,7 @@
                  /(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 (iso_O18.gt.0) then
-        endif !if (iso_HDO.gt.0) 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
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3921')
@@ -4759,6 +4751,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4036',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv30_yield 4036',1e-5)
@@ -4798,30 +4790,30 @@
        ! cam verif
 #ifdef ISOVERIF
-          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)
+          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)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
           do ixt=1,niso
             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_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
-                write(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
+                 '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
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (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 3605b, dtr mels')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 3972')
@@ -4830,6 +4822,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4091',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv30_yield 4091',1e-5)
@@ -4846,8 +4838,8 @@
     ! 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)
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     ! :         *(traent(il,k,i,j)-tra(il,i,j))
@@ -4907,56 +4899,56 @@
         enddo
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
         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
-        write(*,*) 'il,i=',il,i
-        if (rr(il,i).ne.0.0) then
-        write(*,*) 'il,i,rr,deltaD=',il,i,rr(il,i),deltaD &
+                 .eq.1) THEN
+        WRITE(*,*) 'il,i=',il,i
+        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
-        write(*,*) 'fr,fxt,deltaD=',fr(il,i),fxt(iso_HDO,il,i), &
+        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
-        write(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
+        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
-        write(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i),deltaD( &
+        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
 #endif        
-        write(*,*) 'sigd,evap(il,i),evap(il,i+1)=', &
+        WRITE(*,*) 'sigd,evap(il,i),evap(il,i+1)=', &
                   sigd,evap(il,i),evap(il,i+1)
-        write(*,*) 'xtevap(iso_HDO,il,i),xtevap(iso_HDO,il,i+1)=', &
+        WRITE(*,*) 'xtevap(iso_HDO,il,i),xtevap(iso_HDO,il,i+1)=', &
                  xtevap(iso_HDO,il,i),xtevap(iso_HDO,il,i+1)
-        write(*,*) 'grav,mp(il,i+1),mp(il,i),dpinv=', &
+        WRITE(*,*) 'grav,mp(il,i+1),mp(il,i),dpinv=', &
                  grav,mp(il,i+1),mp(il,i),dpinv
-        write(*,*) 'rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)=', &
+        WRITE(*,*) 'rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)=', &
                  rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)
-        write(*,*) 'xtp(il,i+1),xt(il,i),xtp(il,i),xt(il,i-1)=', &
+        WRITE(*,*) 'xtp(il,i+1),xt(il,i),xtp(il,i),xt(il,i-1)=', &
                  xtp(iso_HDO,il,i+1),xt(iso_HDO,il,i), &
                  xtp(iso_HDO,il,i),xt(iso_HDO,il,i-1)
         stop
         endif
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
         if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
              (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)), &
              'cv30_yield 5029,O18, evap')
-          if ((il.eq.1636).and.(i.eq.9)) then
-            write(*,*) 'cv30_yield 5057: ici, on verifie deltaD_nobx'
-            write(*,*) 'il,i=',il,i
-            write(*,*) 'fr(il,i),bx,fr(il,i)-bx=',fr(il,i),bx,fr(il,i)-bx
-            write(*,*) 'q,q+=',rr(il,i),rr(il,i)+delt*(fr(il,i)-bx)
-            write(*,*) 'deltaD,deltaD+=',deltaD(xt(iso_HDO,il,inb(il))/rr(il,inb(il))), &
+          if ((il.eq.1636).and.(i.eq.9)) THEN
+            WRITE(*,*) 'cv30_yield 5057: ici, on verifie deltaD_nobx'
+            WRITE(*,*) 'il,i=',il,i
+            WRITE(*,*) 'fr(il,i),bx,fr(il,i)-bx=',fr(il,i),bx,fr(il,i)-bx
+            WRITE(*,*) 'q,q+=',rr(il,i),rr(il,i)+delt*(fr(il,i)-bx)
+            WRITE(*,*) 'deltaD,deltaD+=',deltaD(xt(iso_HDO,il,inb(il))/rr(il,inb(il))), &
                 deltaD( (xt(iso_HDO,il,i)+delt*(fxt(iso_HDO,il,i)-xtbx(iso_HDO)))/(rr(il,i)+delt*(fr(il,i)-bx)))
-            write(*,*) 'deltaO18,deltaO18+=',deltaO(xt(iso_O18,il,inb(il))/rr(il,inb(il))), &
+            WRITE(*,*) 'deltaO18,deltaO18+=',deltaO(xt(iso_O18,il,inb(il))/rr(il,inb(il))), &
                 deltaO( (xt(iso_O18,il,i)+delt*(fxt(iso_O18,il,i)-xtbx(iso_O18)))/(rr(il,i)+delt*(fr(il,i)-bx)))
             CALL iso_verif_O18_aberrant( &
@@ -4966,11 +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 (iso_HDO.gt.0) 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
@@ -5008,18 +4999,18 @@
 
         ! ajout du terme des ddfts sensi stricto
-!        write(*,*) 'tmp cv3_yield 4165: i,il=',i,il
-
-        if (option_traceurs.eq.6) then
+!        WRITE(*,*) 'tmp cv3_yield 4165: i,il=',i,il
+
+        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))
-             else !if (mp(il,i).gt.mp(il,i+1)) then
+             else !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)-mp(il,i+1)*xt(ixt_ddft,il,i) &
                  +(mp(il,i+1)-mp(il,i))*xtp(ixt_ddft,il,i))
-             endif !if (mp(il,i).gt.mp(il,i+1)) then
+             endif !if (mp(il,i).gt.mp(il,i+1)) THEN
              fxtqe(iiso)=0.01*grav*dpinv* &
                     (mp(il,i+1)*(xtp(iiso,il,i+1)-xt(iiso,il,i)) &
@@ -5032,8 +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
                 
@@ -5058,8 +5047,8 @@
                 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
+                         (izone.ne.izone_ddft)) THEN
                     ixt=itZonIso(izone,iiso) 
                     fxt(ixt,il,i)=fxt(ixt,il,i) &
@@ -5068,20 +5057,20 @@
                   enddo !do izone=1,nzone   
 #ifdef ISOVERIF
-!                write(*,*) 'iiso=',iiso
-!                write(*,*) 'fxtqe=',fxtqe(iiso)
-!                write(*,*) 'fxtYe=',fxtYe(iiso)
-!                write(*,*) 'fxt_revap=',fxt_revap(iiso)
-!                write(*,*) 'fxtXe=',fxtXe(iiso)
-!                write(*,*) 'Xe=',Xe(iiso)
-!                write(*,*) 'xt=',xt(:,il,i)
+!                WRITE(*,*) 'iiso=',iiso
+!                WRITE(*,*) 'fxtqe=',fxtqe(iiso)
+!                WRITE(*,*) 'fxtYe=',fxtYe(iiso)
+!                WRITE(*,*) 'fxt_revap=',fxt_revap(iiso)
+!                WRITE(*,*) 'fxtXe=',fxtXe(iiso)
+!                WRITE(*,*) 'Xe=',Xe(iiso)
+!                WRITE(*,*) 'xt=',xt(:,il,i)
                   CALL iso_verif_traceur_justmass(fxt(1,il,i), &
                          'cv30_routine 4646')
 #endif
-                else !if (abs(dXe).gt.ridicule) then
+                else !if (abs(dXe).gt.ridicule) THEN
                     ! dans ce cas, fxtXe doit etre faible
                     
 #ifdef ISOVERIF
-                if (delt*fxtXe(iiso).gt.ridicule) then
-                   write(*,*) 'cv30_routines 6563: delt*fxtXe(iiso)=', &
+                if (delt*fxtXe(iiso).gt.ridicule) THEN
+                   WRITE(*,*) 'cv30_routines 6563: delt*fxtXe(iiso)=', &
                                 delt*fxtXe(iiso)
                    stop
@@ -5090,11 +5079,11 @@
                 do izone=1,nzone
                    if ((izone.ne.izone_revap).and. &
-                         (izone.ne.izone_ddft)) then
+                         (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.eq.izone_poubelle) THEN
                    endif !if ((izone.ne.izone_revap).and.
                 enddo !do izone=1,nzone
@@ -5104,9 +5093,8 @@
 #endif              
                                            
-                endif !if (abs(dXe).gt.ridicule) then
-
+                endif !if (abs(dXe).gt.ridicule) THEN
               enddo !do iiso = 1, niso
                
-            else !if (mp(il,i).gt.mp(il,i+1)) then
+            else !if (mp(il,i).gt.mp(il,i+1)) THEN
                 ! cas detrainant: pas de problemes
                 do ixt=1+niso,ntraciso
@@ -5119,13 +5107,11 @@
                          'cv30_routine 4685')
 #endif                
-            endif !if (mp(il,i).gt.mp(il,i+1)) 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 (mp(il,i).gt.mp(il,i+1)) 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
         
@@ -5137,53 +5123,51 @@
 #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
+          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( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 '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
+                 '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
-                write(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
+                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
-                write(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i), &
+                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
+          endif !if (iso_HDO.gt.0) THEN
+          endif !if (1.eq.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            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
-                write(*,*) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( &
+                 .eq.1) THEN
+                WRITE(*,*) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( &
                    xt(iso_HDO,il,i)/rr(il,i))
-                write(*,*) 'i,il,fr,deltaD=',i,il,fr(il,i),deltaD( &
+                WRITE(*,*) 'i,il,fr,deltaD=',i,il,fr(il,i),deltaD( &
                    fxt(iso_HDO,il,i)/fr(il,i))
                 stop
             endif ! if (iso_verif_aberrant_enc_nostop
-        endif !if (iso_HDO.gt.0) then
-        
+        endif !if (iso_HDO.gt.0) THEN
         if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
              (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)), &
              'cv30_yield 5250,O18, ddfts')
-          endif !if (iso_HDO.gt.0) then
-
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
-!        write(*,*) 'tmp cv3_yield 4224: i,il=',i,il
+!        WRITE(*,*) 'tmp cv3_yield 4224: i,il=',i,il
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 4107')
         do ixt=1,ntraciso
@@ -5191,16 +5175,16 @@
         enddo
         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)
-          write(*,*) 'xt(,il,i)=',xt(:,il,i)
-          write(*,*) 'delt,sigd,grav,dpinv=',delt,sigd,grav,dpinv
-          write(*,*) 'xtevap(,il,i)=',xtevap(:,il,i)
-          write(*,*) 'xtevap(,il,i+1)=',xtevap(:,il,i+1)
-          write(*,*) 'mp(il,i+1),mp(il,i)=',mp(il,i+1),mp(il,i)
-          write(*,*) 'xtp(,il,i)=',xtp(:,il,i)
-          write(*,*) 'xtp(,il,i+1)=',xtp(:,il,i+1)
-          write(*,*) 'xt(,il,i)=',xt(:,il,i)
-          write(*,*) 'xt(,il,i-1)=',xt(:,il,i-1)
+                        '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)
+          WRITE(*,*) 'xt(,il,i)=',xt(:,il,i)
+          WRITE(*,*) 'delt,sigd,grav,dpinv=',delt,sigd,grav,dpinv
+          WRITE(*,*) 'xtevap(,il,i)=',xtevap(:,il,i)
+          WRITE(*,*) 'xtevap(,il,i+1)=',xtevap(:,il,i+1)
+          WRITE(*,*) 'mp(il,i+1),mp(il,i)=',mp(il,i+1),mp(il,i)
+          WRITE(*,*) 'xtp(,il,i)=',xtp(:,il,i)
+          WRITE(*,*) 'xtp(,il,i+1)=',xtp(:,il,i+1)
+          WRITE(*,*) 'xt(,il,i)=',xt(:,il,i)
+          WRITE(*,*) 'xt(,il,i-1)=',xt(:,il,i-1)
 !         rappel: fxt(ixt,il,i)=fxt(ixt,il,i)
 !          0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
@@ -5229,6 +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
@@ -5239,6 +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
@@ -5246,22 +5228,22 @@
                 +0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
         enddo !do ixt = 1+niso,ntraciso
-!        write(*,*) 'tmp cv3_yield 4165: i,il=',i,il
+!        WRITE(*,*) 'tmp cv3_yield 4165: i,il=',i,il
 !        ixt_poubelle=itZonIso(izone_poubelle,iso_eau)
 !        ixt_ddft=itZonIso(izone_ddft,iso_eau)
-!        write(*,*) 'delt*fxt(ixt_poubelle,il,i)=',
+!        WRITE(*,*) 'delt*fxt(ixt_poubelle,il,i)=',
 !     :           delt*fxt(ixt_poubelle,il,i)
-!        write(*,*) 'delt*fxt(ixt_ddft,il,i)=',delt*fxt(ixt_ddft,il,i)
-!        write(*,*) 'xt(iso_eau,il,i)=',xt(iso_eau,il,i)
+!        WRITE(*,*) 'delt*fxt(ixt_ddft,il,i)=',delt*fxt(ixt_ddft,il,i)
+!        WRITE(*,*) 'xt(iso_eau,il,i)=',xt(iso_eau,il,i)
           do iiso = 1, niso
              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))
-             else !if (mp(il,i).gt.mp(il,i+1)) then
+             else !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)-mp(il,i+1)*xt(ixt_ddft,il,i) &
                  +(mp(il,i+1)-mp(il,i))*xtp(ixt_ddft,il,i))
-             endif !if (mp(il,i).gt.mp(il,i+1)) then
+             endif !if (mp(il,i).gt.mp(il,i+1)) THEN
              fxtqe(iiso)=0.01*grav*dpinv* &
                     (mp(il,i+1)*(xtp(iiso,il,i+1)-xt(iiso,il,i)) &
@@ -5271,8 +5253,8 @@
                  +fxtqe(iiso)-fxtYe(iiso)
           enddo !do iiso = 1, niso
-!          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.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.eq.6) THEN
 #endif       
 
@@ -5300,29 +5282,29 @@
 #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
+          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( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 'cv30_yield 3690').eq.1) then
-                write(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
+                 '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
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (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 3757b, ddfts')
-          endif !if (iso_HDO.gt.0) then          
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant( &
                  (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)), &
                  'cv30_yield 3757b,O18, ddfts')
-          endif !if (iso_HDO.gt.0) then      
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv30_routine 4172')
@@ -5331,6 +5313,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4295',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv30_yield 4295',1e-5)
@@ -5373,9 +5355,9 @@
     ! do j=1,ntra
     ! do il=1,ncum
-    ! if (i.le.inb(il)) then
+    ! if (i.le.inb(il)) THEN
     ! dpinv=1.0/(ph(il,i)-ph(il,i+1))
     ! cpinv=1.0/cpn(il,i)
 
-    ! if (cvflag_grav) then
+    ! if (cvflag_grav) THEN
     ! ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
     ! :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
@@ -5400,6 +5382,5 @@
 
 ! attention, on corrige un probleme C Risi
-      IF (cvflag_grav) then
-
+      IF (cvflag_grav) THEN
        ax = 0.01*grav*ment(il, inb(il), inb(il))*(hp(il,inb(il))-h(il,inb(il))+t(il, &
       inb(il))*(cpv-cpd)*(rr(il,inb(il))-qent(il,inb(il), &
@@ -5505,17 +5486,17 @@
         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)
               CALL iso_verif_egalite_choix(fxt(iso_eau,il,inb(il)-1), &
                  fr(il,inb(il)-1),'cv30_routines 3640',errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-             (rr(il,inb(il))+delt*fr(il,inb(il)).gt.ridicule)) then
+             (rr(il,inb(il))+delt*fr(il,inb(il)).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre( &
                  (xt(iso_HDO,il,inb(il))+delt*fxt(iso_HDO,il,inb(il))) &
                /(rr(il,inb(il))+delt*fr(il,inb(il))), &
                  'cv30_yield 3921, en inb')
-              if (iso_O18.gt.0) then                
+              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))) &
@@ -5523,21 +5504,21 @@
                  (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
-                        write(*,*) 'il,inb(il)=',il,inb(il)
+                 '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))
-                        write(*,*) 'fr,frprec=',fr(il,inb(il)),fr(il,inb(il))+bx
-                        write(*,*) 'M,dt,k_tmp*dt=',k_tmp,delt,k_tmp*delt
-                        write(*,*) 'q,qe=',rr(il,inb(il)),qent(il,inb(il),inb(il))
-                        write(*,*) 'r=',k_tmp*delt*qent(il,inb(il),inb(il))/rr(il,inb(il))
-                        write(*,*) 'deltaDR,Re=',deltaD(xt(iso_HDO,il,inb(il))/rr(il,inb(il))), &
+                        WRITE(*,*) 'fr,frprec=',fr(il,inb(il)),fr(il,inb(il))+bx
+                        WRITE(*,*) 'M,dt,k_tmp*dt=',k_tmp,delt,k_tmp*delt
+                        WRITE(*,*) 'q,qe=',rr(il,inb(il)),qent(il,inb(il),inb(il))
+                        WRITE(*,*) 'r=',k_tmp*delt*qent(il,inb(il),inb(il))/rr(il,inb(il))
+                        WRITE(*,*) 'deltaDR,Re=',deltaD(xt(iso_HDO,il,inb(il))/rr(il,inb(il))), &
                                 deltaD(xtent(iso_HDO,il,inb(il),inb(il))/qent(il,inb(il),inb(il)))
-                        write(*,*) 'deltaO18R,Re=',deltaO(xt(iso_O18,il,inb(il))/rr(il,inb(il))), &
+                        WRITE(*,*) 'deltaO18R,Re=',deltaO(xt(iso_O18,il,inb(il))/rr(il,inb(il))), &
                                 deltaO(xtent(iso_O18,il,inb(il),inb(il))/qent(il,inb(il),inb(il)))
                 stop
               endif !if (iso_verif_O18_aberrant_nostop
-            endif !if (iso_O18.gt.0) then
-          endif !if (iso_HDO.gt.0) then
+            endif !if (iso_O18.gt.0) THEN
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-             (rr(il,inb(il)-1)+delt*fr(il,inb(il)-1).gt.ridicule)) then
+             (rr(il,inb(il)-1)+delt*fr(il,inb(il)-1).gt.ridicule)) THEN
            CALL iso_verif_aberrant_encadre( &
                  (xt(iso_HDO,il,inb(il)-1) &
@@ -5545,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)) &
@@ -5553,5 +5534,5 @@
                  'cv30_yield 3921cO18, en inb-1')
               endif
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,inb(il)-1), &
@@ -5563,6 +5544,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4492',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv30_yield 4492',1e-5)
@@ -5634,27 +5615,27 @@
         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
+        else !if (frsum(il).gt.ridicule) 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
-               write(*,*) 'cv30_yield 4048: fr(il,i)=',fr(il,i)
+           else !if (abs(frsum(il)).gt.0.0) THEN
+             if (abs(fr(il,i))*delt.gt.ridicule) THEN
+               WRITE(*,*) 'cv30_yield 4048: fr(il,i)=',fr(il,i)
                stop 
-             else !if (abs(fr(il,i))*delt.gt.ridicule) then
+             else !if (abs(fr(il,i))*delt.gt.ridicule) THEN
                do ixt=1,ntraciso
                  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
-             endif !if (abs(fr(il,i))*delt.gt.ridicule) then
-           endif !if (abs(frsum(il)).gt.0.0) then
-         endif !if (frsum(il).gt.0) then
+             endif !if (abs(fr(il,i))*delt.gt.ridicule) THEN
+           endif !if (abs(frsum(il)).gt.0.0) THEN
+         endif !if (frsum(il).gt.0) THEN
 #endif
       END IF
@@ -5675,62 +5656,61 @@
 #ifdef ISOVERIF
           do i=1,nl
-!             write(*,*) 'cv30_routines temp 3967: i=',i
+!             WRITE(*,*) 'cv30_routines temp 3967: i=',i
              do il=1,ncum
-!                write(*,*) 'cv30_routines 3969: il=',il
-!                write(*,*) 'cv30_routines temp 3967: il,i,inb(il),ncum=',
+!                WRITE(*,*) 'cv30_routines 3969: il=',il
+!                WRITE(*,*) 'cv30_routines temp 3967: il,i,inb(il),ncum=',
 !     :                           il,i,inb(il),ncum
-!                write(*,*) 'cv30_routines 3974'
-                if (iso_eau.gt.0) then
+!                WRITE(*,*) 'cv30_routines 3974'
+                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'
+                endif !if (iso_eau.gt.0) THEN
+!                WRITE(*,*) 'cv30_routines 3979'
                 if ((iso_HDO.gt.0).and. &
-                    (delt*fr(il,i).gt.ridicule)) then
+                    (delt*fr(il,i).gt.ridicule)) THEN
                     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
-                           write(*,*) 'il,i,icb(il)=',il,i,icb(il)
-                           write(*,*) 'frsum(il)=',frsum(il)
-                           write(*,*) 'fr(il,i)=',fr(il,i)  
-                           write(*,*) 'csum(il)=',csum(il)  
-                           write(*,*) &
+                        '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)
+                           WRITE(*,*) 'fr(il,i)=',fr(il,i)
+                           WRITE(*,*) 'csum(il)=',csum(il)
+                           WRITE(*,*) &
                                 'deltaD(bxtsum(iso_HDO,il)/csum(il))=', &
                                deltaD(bxtsum(iso_HDO,il)/csum(il))
 !                           stop
                         endif
-!                        write(*,*) 'cv30_routines 3986: temporaire'
+!                        WRITE(*,*) 'cv30_routines 3986: temporaire'
                     endif   !if (iso_verif_aberrant_enc_nostop   
-                endif !if (iso_HDO.gt.0) then
+                endif !if (iso_HDO.gt.0) THEN
                 if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
                   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
-                     write(*,*) 'il,i,icb(il)=',il,i,icb(il)
-                     write(*,*) 'frsum(il)=',frsum(il)
-                     write(*,*) 'fr(il,i)=',fr(il,i)    
+                 .eq.1) THEN
+                     WRITE(*,*) 'il,i,icb(il)=',il,i,icb(il)
+                     WRITE(*,*) 'frsum(il)=',frsum(il)
+                     WRITE(*,*) 'fr(il,i)=',fr(il,i)
                      stop
                   endif
-               endif !if (iso_HDO.gt.0) then
-               
+               endif !if (iso_HDO.gt.0) THEN
         if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_O18_aberrant( &
                  (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)), &
                  'cv30_yield 3921d, dans la CL')
-        endif !if (iso_HDO.gt.0) then 
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
                 CALL iso_verif_traceur_justmass(fxt(1,il,i), &
                         'cv30_routine 4523')
 #endif                 
-!                write(*,*) 'cv30_routines 3994'
+!                WRITE(*,*) 'cv30_routines 3994'
              enddo !do il=1,ncum
-!             write(*,*) 'cv30_routine 3990: fin des il pour i=',i
+!             WRITE(*,*) 'cv30_routine 3990: fin des il pour i=',i
           enddo !do i=1,nl
-!          write(*,*) 'cv30_routine 3990: fin des verifs sur homogen'
+!          WRITE(*,*) 'cv30_routine 3990: fin des verifs sur homogen'
 #endif
 
@@ -5739,22 +5719,22 @@
           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
+                endif !if (iso_eau.gt.0) THEN
                 if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (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 5710a, final')
-               endif !if (iso_HDO.gt.0) then               
+               endif !if (iso_HDO.gt.0) THEN
                if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
                   CALL iso_verif_O18_aberrant( &
                  (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)), &
                  'cv30_yield 5710b, final')
-               endif !if (iso_HDO.gt.0) then 
+               endif !if (iso_HDO.gt.0) THEN
              enddo !do il=1,ncum
           enddo !do i=1,nl
@@ -5825,5 +5805,5 @@
       DO il = 1, ncum
         ! test         if (i.ge.icb(il).and.i.le.inb(il).and.k.le.inb(il))
-        ! then
+        ! THEN
         IF (i<=inb(il) .AND. k<=inb(il)) THEN
           upwd(il, i) = upwd(il, i) + m(il, k) + up1(il, k, i)
@@ -6236,5 +6216,5 @@
 
 #ifdef ISOVERIF
-        write(*,*) 'cv30_routines 4293: entree dans cv3_uncompress'
+        WRITE(*,*) 'cv30_routines 4293: entree dans cv3_uncompress'
 #endif
   DO i = 1, ncum
@@ -6383,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))
@@ -6406,33 +6386,31 @@
       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
        enddo
       enddo !do k=minorig+1,n
-!     write(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
+!     WRITE(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
       do i=1,ncum  
        do k=1,nl
-        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
-           write(*,*) 'epmax_diag(i)=',epmax_diag(i)
-           write(*,*) 'ep(i,k)=',ep(i,k)
-           write(*,*) 'hp(i,k)=',hp(i,k)
-           write(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
-           write(*,*) 'h(i,k)=',h(i,k)
-           write(*,*) 'nk(i)=',nk(i)
-           write(*,*) 'h(i,nk(i))=',h(i,nk(i))
-           write(*,*) 'lv(i,k)=',lv(i,k)
-           write(*,*) 't(i,k)=',t(i,k)
-           write(*,*) 'clw(i,k)=',clw(i,k)
-           write(*,*) 'cpd,cpv=',cpd,cpv
+        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
+           WRITE(*,*) 'epmax_diag(i)=',epmax_diag(i)
+           WRITE(*,*) 'ep(i,k)=',ep(i,k)
+           WRITE(*,*) 'hp(i,k)=',hp(i,k)
+           WRITE(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
+           WRITE(*,*) 'h(i,k)=',h(i,k)
+           WRITE(*,*) 'nk(i)=',nk(i)
+           WRITE(*,*) 'h(i,nk(i))=',h(i,nk(i))
+           WRITE(*,*) 'lv(i,k)=',lv(i,k)
+           WRITE(*,*) 't(i,k)=',t(i,k)
+           WRITE(*,*) 'clw(i,k)=',clw(i,k)
+           WRITE(*,*) 'cpd,cpv=',cpd,cpv
            CALL abort_physic(modname,abort_message,0)
         endif
        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/phylmdiso/cv3_routines.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90	(revision 5116)
@@ -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), &
@@ -652,5 +652,5 @@
 
 ! PRINT*,'icb dans cv3_feed '
-! write(*,'(64i2)') icb(2:len-1)
+! WRITE(*,'(64i2)') icb(2:len-1)
 ! CALL dump2d(64,43,'plcl dans cv3_feed ',plcl(2:len-1))
 
@@ -839,5 +839,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0) ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -861,5 +861,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0)                               ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -919,20 +919,20 @@
 #endif         
 #ifdef ISOVERIF
-        write(*,*) 'cv3_routine undilute 1 573: avant condiso'
-        if (iso_HDO.gt.0) then            
+        WRITE(*,*) 'cv3_routine undilute 1 573: avant condiso'
+        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')
-           endif  !if (qnk(i).gt.ridicule) then
+           endif  !if (qnk(i).gt.ridicule) THEN
          enddo !do i=1,len       
-        endif !if (iso_HDO.gt.0) then 
-        if (iso_eau.gt.0) then            
+        endif !if (iso_HDO.gt.0) THEN
+        if (iso_eau.gt.0) THEN
          do i=1,len
            CALL iso_verif_egalite(xtnk(iso_eau,i),qnk(i), &
                   'cv3_routines 634')
          enddo !do i=1,len       
-        endif !if (iso_eau.gt.0) then
-        write(*,*) 'cv3_routines 641: CALL condiso_liq_ice_vectall'
+        endif !if (iso_eau.gt.0) THEN
+        WRITE(*,*) 'cv3_routines 641: CALL condiso_liq_ice_vectall'
         do i=1,len
            CALL iso_verif_positif(qnk(i)-clw_k(i), &
@@ -956,12 +956,12 @@
 
 #ifdef ISOVERIF
-            write(*,*) 'cv3_routine undilute 1 598: apres condiso'
+            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)), &
                clw(i,icbs(i)),'cv3_routines 577',errmax,errmaxrel)
             enddo !do i=1,len
-          endif !if (iso_eau.gt.0) then 
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC   
         do i=1,len
@@ -1020,5 +1020,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0)                                   ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -1042,5 +1042,5 @@
     denom = 243.5 + tc
     denom = max(denom, 1.0)                                   ! convect3
-! ori          if(tc.ge.0.0)then
+! ori          IF(tc.ge.0.0)THEN
     es = 6.112*exp(17.67*tc/denom)
 ! ori          else
@@ -1094,11 +1094,11 @@
 #endif        
 #ifdef ISOVERIF 
-        write(*,*) 'cv3_routines 739: avant condiso'
-        if (iso_HDO.gt.0) then            
+        WRITE(*,*) 'cv3_routines 739: avant condiso'
+        if (iso_HDO.gt.0) THEN
          do i=1,len
            CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), &
                   'cv3_routines 725')
          enddo     
-        endif !if (iso_HDO.gt.0) then 
+        endif !if (iso_HDO.gt.0) THEN
         do i=1,len
         CALL iso_verif_positif(qnk(i)-clw_k(i), &
@@ -1127,10 +1127,10 @@
 
 #ifdef ISOVERIF            
-!write(*,*) 'DEBUG ISO B'
+!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)
-            endif ! if (iso_eau.gt.0) then 
+            endif ! if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC   
            CALL iso_verif_traceur(xtclw(1,i,icb(i)+1), &
@@ -1138,5 +1138,5 @@
 #endif            
           enddo !do i=1,len
-            !write(*,*) 'FIN DEBUG ISO B'
+            !WRITE(*,*) 'FIN DEBUG ISO B'
 #endif  
 #endif
@@ -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
@@ -1217,5 +1217,5 @@
 ! oct3         iflag(i)=4 ! pour version vectorisee
 ! oct3c convect3         iflag(i)=0
-! oct3cccc         return
+! oct3cccc         RETURN
 ! oct3       endif
 ! oct3
@@ -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                      
@@ -1410,5 +1410,5 @@
          enddo
         enddo
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
        do k = 1, nd
          do i = 1, nloc
@@ -1499,5 +1499,5 @@
 !   - vertical profile of buoyancy computed here (use of buoybase)
 !   - the determination of inb is different
-!   - no inb1, only inb in output
+!   - no inb1, ONLY inb in output
 ! ---------------------------------------------------------------------
 
@@ -1707,5 +1707,5 @@
       DO j = 1,4
         DO i = 1, ncum
-! ori	    if(k.ge.(icb(i)+1))then
+! ori	    IF(k.ge.(icb(i)+1))THEN
           IF (k>=(icbs(i)+1)) THEN                                ! convect3
             tg = tp(i, k)
@@ -1818,5 +1818,5 @@
       DO j = 1,4
         DO i = 1, ncum
-! ori	    if(k.ge.(icb(i)+1))then
+! ori	    IF(k.ge.(icb(i)+1))THEN
           IF (k>=(icbs(i)+1)) THEN                                ! convect3
             tg = tp(i, k)
@@ -1935,5 +1935,5 @@
   DO k = minorig + 1, nl
     DO i = 1, ncum
-! ori	    if(k.ge.(icb(i)+1))then
+! ori	    IF(k.ge.(icb(i)+1))THEN
       IF (k>=(icbs(i)+1)) THEN                                ! convect3
         tg = t(i, k)
@@ -1956,5 +1956,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0)                               ! convect3
-! ori	       if(tc.ge.0.0)then
+! ori	       IF(tc.ge.0.0)THEN
         es = 6.112*exp(17.67*tc/denom)
 ! ori	       else
@@ -1976,5 +1976,5 @@
         denom = 243.5 + tc
         denom = max(denom, 1.0)                               ! convect3
-! ori	       if(tc.ge.0.0)then
+! ori	       IF(tc.ge.0.0)THEN
         es = 6.112*exp(17.67*tc/denom)
 ! ori	       else
@@ -2108,10 +2108,10 @@
 #endif  
 #ifdef ISOVERIF
-        !write(*,*) 'cv3_routine 1259: avant condiso'
+        !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')
-           endif !if (iso_HDO.gt.0) then 
+           endif !if (iso_HDO.gt.0) THEN
            CALL iso_verif_positif(qnk(i)-clw_k(i), &
                   'cv3_routines 1336')
@@ -2130,5 +2130,5 @@
 #ifdef ISOTRAC
 #ifdef ISOVERIF
-!        write(*,*) 'cv3_routines 1283: condiso pour traceurs'
+!        WRITE(*,*) 'cv3_routines 1283: condiso pour traceurs'
 #endif
         CALL condiso_liq_ice_vectall_trac(xtnk(1,1),qnk(1), &
@@ -2143,10 +2143,10 @@
         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), &
                 clw(i,k),'cv3_routines 1223',errmax,errmaxrel)
           enddo
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC   
         do i=1,ncum
@@ -2229,5 +2229,5 @@
 ! ori      do 340 k=minorig+1,nl
 ! ori        do 330 i=1,ncum
-! ori        if(k.ge.(icb(i)+1))then
+! ori        IF(k.ge.(icb(i)+1))THEN
 ! ori          tvp(i,k)=tvp(i,k)*(1.0-qnk(i)+ep(i,k)*clw(i,k))
 ! oric         PRINT*,'i,k,tvp(i,k),qnk(i),ep(i,k),clw(i,k)'
@@ -2353,10 +2353,10 @@
 !    do 530 k=minorig+1,nl-1
 !     do 520 i=1,ncum
-!      if(k.ge.(icb(i)+1))then
+!      IF(k.ge.(icb(i)+1))THEN
 !       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
 !       byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
 !       cape(i)=cape(i)+by
-!       if(by.ge.0.0)inb1(i)=k+1
-!       if(cape(i).gt.0.0)then
+!       IF(by.ge.0.0)inb1(i)=k+1
+!       IF(cape(i).gt.0.0)THEN
 !        inb(i)=k+1
 !        capem(i)=cape(i)
@@ -2380,9 +2380,9 @@
 !    do 530 k=minorig+1,nl-1
 !     do 520 i=1,ncum
-!      if(k.ge.(icb(i)+1))then
+!      IF(k.ge.(icb(i)+1))THEN
 !       by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
 !       cape(i)=cape(i)+by
-!       if(by.ge.0.0)inb1(i)=k+1
-!       if(cape(i).gt.0.0)then
+!       IF(by.ge.0.0)inb1(i)=k+1
+!       IF(cape(i).gt.0.0)THEN
 !        inb(i)=k+1
 !        capem(i)=cape(i)
@@ -2410,11 +2410,11 @@
 ! ori      do 530 k=minorig+1,nl-1
 ! 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(cape(i).lt.0.0)lcape(i)=.FALSE.
+! 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)
 ! ori            cape(i)=cape(i)+by
-! ori            if(by.ge.0.0)inb1(i)=k+1
-! ori            if(cape(i).gt.0.0)then
+! ori            IF(by.ge.0.0)inb1(i)=k+1
+! ori            IF(cape(i).gt.0.0)THEN
 ! ori              inb(i)=k+1
 ! ori              capem(i)=cape(i)
@@ -2589,5 +2589,5 @@
   END DO
 
-!!      if(inb.lt.(nl-1))then
+!!      IF(inb.lt.(nl-1))THEN
 !!         do 85 i=inb+1,nl-1
 !!            sig(i)=beta*sig(i)+2.*alpha*buoy(inb)*
@@ -2770,8 +2770,8 @@
 #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, &
@@ -2854,5 +2854,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!       write(*,*) 'cv3_routines 1820: entree dans cv3_mixing'
+!       WRITE(*,*) 'cv3_routines 1820: entree dans cv3_mixing'
        do i=minorig+1,nl
         do il=1,ncum
@@ -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 
 
@@ -3010,21 +3010,21 @@
 #ifdef ISOVERIF
         do il=1,ncum
-          write(*,*) 'cv3_routines 2083: CALL condiso_liq_ice_vectall'
+          WRITE(*,*) 'cv3_routines 2083: CALL condiso_liq_ice_vectall'
            CALL iso_verif_positif(qent(il,i,j)-elij(il,i,j), &
                   'cv3_routines 2085')
-          if (iso_eau.gt.0) then
+          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
-                  write(*,*) 'il,i,j=',il,i,j
-                  write(*,*) 'sij(il,i,j)=',sij(il,i,j)
-                  write(*,*) 'xt(:,il,i)=',xt(:,il,i)
-                  write(*,*) 'xtrti(:,il)=',xtrti(:,il)
-                  write(*,*) 'rr(il,i)=',rr(il,i)
-                  write(*,*) 'qnk(il)=',qnk(il)
-                  write(*,*) 'xtnk(:,il)=',xtnk(:,il)
+                    'cv3_routine 2126').eq.1) THEN
+                  WRITE(*,*) 'il,i,j=',il,i,j
+                  WRITE(*,*) 'sij(il,i,j)=',sij(il,i,j)
+                  WRITE(*,*) 'xt(:,il,i)=',xt(:,il,i)
+                  WRITE(*,*) 'xtrti(:,il)=',xtrti(:,il)
+                  WRITE(*,*) 'rr(il,i)=',rr(il,i)
+                  WRITE(*,*) 'qnk(il)=',qnk(il)
+                  WRITE(*,*) 'xtnk(:,il)=',xtnk(:,il)
                   stop
               endif !if (iso_verif_egalite_nostop(qent(il,i,j),
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
         enddo !do il=1,ncum
 #endif
@@ -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')
           
@@ -3056,29 +3056,29 @@
 
 #ifdef ISOTRAC    
-!        write(*,*) 'cv3_routines tmp 1987,option_traceurs=',
+!        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),',
+!        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
 !     :           'tcond(il),rs(il,j)=',
 !     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
         ! 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
-!             write(*,*) 'cv3 2002: il,i,j  =',il,i,j   
+            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)
             enddo     
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
         enddo !do il=1,ncum
 #ifdef ISOVERIF
@@ -3090,15 +3090,15 @@
         enddo !do il=1,ncum 
 #endif        
-        endif !if (option_tmin.ge.1) then       
+        endif !if (option_tmin.ge.1) THEN
 #endif
 
 ! fractionation:
 #ifdef ISOVERIF 
-!        write(*,*) 'cv3_routines 2050: avant condiso'
+!        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
+            (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')
@@ -3115,7 +3115,7 @@
                   xtelij(iso_HDO,il,i,j),elij(il,i,j), &
                   ridicule,deltalim,'cv3_routines 1993')
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC  
-!        write(*,*) 'cv3_routines tmp 2039 il=',il
+!        WRITE(*,*) 'cv3_routines tmp 2039 il=',il
            CALL iso_verif_traceur(xtent(1,il,i,j), &
                          'cv3_routines 2031')
@@ -3124,9 +3124,9 @@
 #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
-!        write(*,*) 'cv3_routine tmp 1984: cond=',elij(il,i,j)                
+!        WRITE(*,*) 'cv3_routine tmp 1984: cond=',elij(il,i,j)
 #endif
     END DO
@@ -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)=',
+!        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)
@@ -3200,6 +3200,5 @@
             enddo
 #endif            
-          endif !if (cond.gt.0.0) then
-          
+          endif !if (cond.gt.0.0) THEN
 #ifdef ISOVERIF          
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,i),&
@@ -3208,5 +3207,5 @@
           CALL iso_verif_traceur(xtelij(1,il,i,i),'cv3_routines 2096')
 #endif        
-        endif !if (option_tmin.ge.1) then    
+        endif !if (option_tmin.ge.1) THEN
 #endif
 
@@ -3219,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
@@ -3406,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)=',
+!        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), &
@@ -3418,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), &
@@ -3424,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)
@@ -3436,5 +3435,5 @@
             enddo
 #endif               
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
 #ifdef ISOVERIF          
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
@@ -3443,5 +3442,5 @@
           CALL iso_verif_traceur(xtelij(1,il,i,i),'cv3_routines 2323')
 #endif        
-        endif !if (option_tmin.ge.1) then
+        endif !if (option_tmin.ge.1) THEN
 #endif
       END IF
@@ -3451,5 +3450,5 @@
 !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!     :     .and. csum(il,i).lt.m(il,i) ) THEN
 !AC!         traent(il,i,i,j)=tra(il,nk(il),j)
 !AC!        endif
@@ -3489,19 +3488,19 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'cv3_routines 2540: verif finale en sortant de cv3_mixing'
+       WRITE(*,*) 'cv3_routines 2540: verif finale en sortant de cv3_mixing'
        do im = 1, nd
        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),  &
                qent(il,im,jm),'cv3_mixing 2112',errmax,errmaxrel) &
-               .eq.1) then
-                write(*,*) 'il,im,jm=',il,im,jm
-                write(*,*) 'xtnk(:,il),qnk(il)=',xtnk(:,il),qnk(il)
+               .eq.1) THEN
+                WRITE(*,*) 'il,im,jm=',il,im,jm
+                WRITE(*,*) 'xtnk(:,il),qnk(il)=',xtnk(:,il),qnk(il)
                 stop
             endif !if (iso_verif_egalite_choix_nostop(xtent(iso_eau,il,im,jm),
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(xtelij(1,il,im,jm), &
@@ -3517,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
@@ -3523,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
@@ -3542,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
@@ -3555,8 +3554,8 @@
         if (iso_verif_positif_nostop(xtclw(itZonIso( &
                  izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-                 ,'cv3_routines 909').eq.1) then
-               write(*,*) 'i,k=',i,k
-               write(*,*) 'xtclw=',xtclw(:,i,k)
-               write(*,*) 'niso,ntraciso,index_zone,izone_cond=', &
+                 ,'cv3_routines 909').eq.1) THEN
+               WRITE(*,*) 'i,k=',i,k
+               WRITE(*,*) 'xtclw=',xtclw(:,i,k)
+               WRITE(*,*) 'niso,ntraciso,index_zone,izone_cond=', &
                    niso,ntraciso,index_zone,izone_cond
                stop
@@ -3565,6 +3564,6 @@
          enddo !do il = 1, ncum   
          enddo !do im = 1, nd
-!         write(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
-        endif !if (option_tmin.eq.1) then
+!         WRITE(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
+        endif !if (option_tmin.eq.1) THEN
 #endif
 #endif
@@ -3598,5 +3597,5 @@
 #endif
 #ifdef ISOTRAC
-    use isotrac_mod, only: option_cond,izone_cond
+    use isotrac_mod, ONLY: option_cond,izone_cond
     use infotrac_phy, ONLY: itZonIso
 #ifdef ISOVERIF
@@ -3776,5 +3775,5 @@
             CALL iso_verif_noNaN(xtwater(ixt,il,i),'cv3_routines 2888')
           enddo
-            if(iso_eau.gt.0) then
+            IF(iso_eau.gt.0) THEN
               CALL iso_verif_egalite_choix(xt(iso_eau,il,i),rr(il,i), &
                         'cv3_unsat 2245 ',errmax,errmaxrel)
@@ -3785,5 +3784,5 @@
                   elij(il,i,j),'cv3_unsat 2267 ',errmax,errmaxrel)
              enddo  !do j=1,nl   
-            endif !if(iso_eau.gt.0) then
+            endif !IF(iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xt(1,il,i),'cv3_routine 2410')
@@ -3813,5 +3812,5 @@
   DO il = 1, ncum
 !!          lwork(il)=.TRUE.
-!!          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
+!!          IF(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
 !jyg<
 !!    lwork(il) = ep(il, inb(il)) >= 0.0001
@@ -3892,8 +3891,8 @@
           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)
-             endif !if (iso_eau.gt.0) then
+             endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtwdtrain(1,il),'cv3_routine 2480')
@@ -3915,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))
@@ -3921,15 +3920,14 @@
              enddo
 !!             xtawat(ixt)=amin1(xtawat(ixt),xtelij(ixt,il,j,i)) !security..
-            else !if (elij(il,j,i).gt.0.0) then
+            else !if (elij(il,j,i).gt.0.0) THEN
              do ixt=1,ntraciso
                xtawat(ixt)=0.0
              enddo !do ixt=1,niso
-            endif  !if (elij(il,j,i).gt.0.0) then                                  
-
+            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)
-              endif !if (iso_eau.gt.0) then
+              endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtawat(1),'cv3_routine 2522')
@@ -3950,22 +3948,22 @@
 #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)
-              endif !if (iso_eau.gt.0) then
+              endif !if (iso_eau.gt.0) THEN
 #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( &
                 xtwdtrain(itZonIso(izone_cond,iso_eau),il) &
                 -xtwdtrain(iso_eau,il), &
-                'cv3_routines 2795').eq.1) then
-          write(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
-          write(*,*) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i)
-          write(*,*) 'xtclw(:,il,i)=',xtclw(:,il,i)
+                'cv3_routines 2795').eq.1) THEN
+          WRITE(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
+          WRITE(*,*) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i)
+          WRITE(*,*) 'xtclw(:,il,i)=',xtclw(:,il,i)
           stop
           endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
-        endif !if (option_cond.ge.1) then
+        endif !if (option_cond.ge.1) THEN
 #endif              
 #endif
@@ -4093,5 +4091,5 @@
 !JYG1
 ! cc        sigt=1.0
-! cc        if(i.ge.icb)sigt=sigp(i)
+! cc        IF(i.ge.icb)sigt=sigp(i)
 ! prise en compte de la variation progressive de sigt dans
 ! les couches icb et icb-1:
@@ -4129,5 +4127,5 @@
 !   c6=prec(il,i+1)+bfac*wdtrain(il) &
 !       -50.*sigd(il)*bfac*(ph(il,i)-ph(il,i+1))*evap(il,i+1)
-!   if(c6.gt.0.0)then
+!   IF(c6.gt.0.0)THEN
 !   revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
 
@@ -4213,5 +4211,5 @@
 !           ice(il,i)=ice(il,i)-fondue(il,i)
             
-!           if((water(il,i)+ice(il,i)).lt.1.e-30)then
+!           if((water(il,i)+ice(il,i)).lt.1.e-30)THEN
 !             faci(il,i)=0.
 !           else
@@ -4380,5 +4378,5 @@
 
 
-! c      if(p(il,i).gt.p(il,icb(il)))then
+! c      IF(p(il,i).gt.p(il,icb(il)))THEN
 ! c       mp(il,i)=mp(il,icb(il))*(p(il,1)-p(il,i))/(p(il,1)-p(il,icb(il)))
 ! c      endif
@@ -4466,12 +4464,12 @@
 !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
+!AC!         IF(mplus(il))THEN
 !AC!          trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
 !AC!     :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
 !AC!          trap(il,i,j)=trap(il,i,j)/mp(il,i)
 !AC!         else ! if (mplus(il))
-!AC!          if(mp(il,i+1).gt.1.0e-16)then
+!AC!          IF(mp(il,i+1).gt.1.0e-16)THEN
 !AC!           trap(il,i,j)=trap(il,i+1,j)
 !AC!          endif
@@ -4486,16 +4484,16 @@
 ! 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)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
 !#ifdef ISOTRAC
-!        if (option_tmin.ge.1) then
+!        if (option_tmin.ge.1) THEN
 !           CALL iso_verif_positif(xtwater(
 !     :           itZonIso(izone_cond,iso_eau),il,i+1)
 !     :           -xtwater(iso_eau,il,i+1),
 !     :          'cv3_routines 3083')
-!        endif !if (option_tmin.ge.1) then
+!        endif !if (option_tmin.ge.1) THEN
 !#endif
         endif
@@ -4514,8 +4512,8 @@
 
 #ifdef ISOVERIF
-!        write(*,*) 'cv3_routines 2864 tmp: sortie de appel_stewart'
+!        WRITE(*,*) 'cv3_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),'cv3_unsat 3382')
@@ -4528,26 +4526,26 @@
 #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)
-!          write(*,*) 'xtp(iso_eau,il,i),rpprec(il,i)=',
+!          WRITE(*,*) 'xtp(iso_eau,il,i),rpprec(il,i)=',
 !     :                   xtp(iso_eau,il,i),rpprec(il,i)
           CALL iso_verif_egalite_choix(xtwater(iso_eau,il,i), &
                  water(il,i),'cv3_unsat 2747',errmax,errmaxrel)
-!         write(*,*) 'xtwater(4,il,i)=',xtwater(4,il,i)
-!         write(*,*) 'water(il,i)=',water(il,i)
+!         WRITE(*,*) 'xtwater(4,il,i)=',xtwater(4,il,i)
+!         WRITE(*,*) 'water(il,i)=',water(il,i)
           CALL iso_verif_egalite_choix(xtevap(iso_eau,il,i), &
                  evap(il,i),'cv3_unsat 2751',errmax,errmaxrel)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
          if ((iso_HDO.gt.0).and. &
-                 (rp(il,i).gt.ridicule)) then
+                 (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.
 #ifdef ISOTRAC
-!        if (il.eq.602) then
-!        write(*,*) 'cv3_routine tmp: il,i=',il,i
-!        write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
+!        if (il.eq.602) THEN
+!        WRITE(*,*) 'cv3_routine tmp: il,i=',il,i
+!        WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
 !     :          xtp(iso_eau:ntraciso:3,il,i)
 !        endif
@@ -4559,12 +4557,12 @@
         CALL iso_verif_traceur_justmass(xtevap(1,il,i), &
                           'cv3_routine 2854')
-!        if (option_tmin.ge.1) then
+!        if (option_tmin.ge.1) THEN
 !         CALL iso_verif_positif(xtwater(
 !     :           itZonIso(izone_cond,iso_eau),il,i)
 !     :           -xtwater(iso_eau,il,i),
 !     :          'cv3_routines 3143')
-!        endif !if (option_tmin.ge.1) then
+!        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
@@ -4572,9 +4570,8 @@
 ! 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
-                write(*,*) 'cv3unsat 2640'
+        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
             endif
@@ -4589,6 +4586,6 @@
 #endif
 #ifdef ISOVERIF
-           if (iso_eau.gt.0) then
-!             write(*,*) 'xtp(iso_eau,il,i)=',xtp(iso_eau,il,i)  
+           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), &
                         'cv3unsat 2653',errmax,errmaxrel)
@@ -4597,8 +4594,8 @@
            endif  
            if ((iso_HDO.gt.0).and. &
-                 (rp(il,i).gt.ridicule)) then
+                 (rp(il,i).gt.ridicule)) 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)=', &
+                        'cv3unsat 2658').eq.1) THEN
+                WRITE(*,*) 'rpprec(il,i),rs(il,i),rp(il,i)=', &
                          rpprec(il,i),rs(il,i),rp(il,i)
                 stop
@@ -4611,9 +4608,9 @@
           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
              enddo
-         endif !if (rp(il,i).gt.rs(il,i)) then           
+         endif !if (rp(il,i).gt.rs(il,i)) THEN
          endif !if (i.lt.INB et lwork)
         enddo ! il=1,ncum
@@ -4621,12 +4618,12 @@
 400 END DO
 #ifdef ISO   
-!      write(*,*) 'nl=',nl,'nd=',nd,'; ncum=',ncum  
+!      WRITE(*,*) 'nl=',nl,'nd=',nd,'; ncum=',ncum
 #ifdef ISOVERIF
       do i=1,nl!nl
         do il=1,ncum
-        if (iso_eau.gt.0) then
-!            write(*,*) 'cv3_routines 2767:i,il,lwork(il),inb(il)=',
+        if (iso_eau.gt.0) THEN
+!            WRITE(*,*) 'cv3_routines 2767:i,il,lwork(il),inb(il)=',
 !     :           i,il,lwork(il),inb(il)
-!            write(*,*) 'rp(il,i),xtp(iso_eau,il,i)=',
+!            WRITE(*,*) 'rp(il,i),xtp(iso_eau,il,i)=',
 !     :           rp(il,i),xtp(iso_eau,il,i)  
             CALL iso_verif_egalite_choix(xt(iso_eau,il,i), &
@@ -4636,12 +4633,12 @@
            CALL iso_verif_egalite_choix(xtwater(iso_eau,il,i), &
                  water(il,i),'cv3_unsat 2672',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 !#ifdef ISOTRAC
 !        if (iso_verif_traceur_choix_nostop(xtwater(1,il,i),
 !     :       'cv3_routine 2982 unsat',errmax,
-!     :       errmaxrel,ridicule_trac,deltalimtrac).eq.1) then
-!              write(*,*) 'il,i,inb(il),lwork(il)=',
+!     :       errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+!              WRITE(*,*) 'il,i,inb(il),lwork(il)=',
 !     :           il,i,inb(il),lwork(il)
-!              write(*,*) 'xtwater(:,il,i)=',xtwater(:,il,i)
+!              WRITE(*,*) 'xtwater(:,il,i)=',xtwater(:,il,i)
 !              stop
 !        endif
@@ -4650,5 +4647,5 @@
       enddo !do i=1,nl!nl
 !      il=130
-!      write(*,*) 'cv3_unsat 2780: '//
+!      WRITE(*,*) 'cv3_unsat 2780: '//
 !     :           'il,water(il,1),xtwater(iso_eau,il,1)='
 !     :          ,il,water(il,1),xtwater(iso_eau,il,1)
@@ -4706,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, &
 &       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
@@ -4871,5 +4868,5 @@
 #ifdef ISO
        ! cam debug
-!       write(*,*) 'cv3_routines 3082: entree dans cv3_yield'
+!       WRITE(*,*) 'cv3_routines 3082: entree dans cv3_yield'
        ! en cam debug
        do ixt = 1, ntraciso
@@ -4971,6 +4968,6 @@
          ! cam verif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) then
-!              write(*,*) 'cv3_yield 2952: '//
+          if (iso_eau.gt.0) THEN
+!              WRITE(*,*) 'cv3_yield 2952: '//
 !     :           'il,water(il,1),xtwater(iso_eau,il,1)='
 !     :           ,il,water(il,1),xtwater(iso_eau,il,1)
@@ -4983,5 +4980,5 @@
                  precip(il),'cv3_routines 3138', &
                  errmax*4e3,errmaxrel)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtwater(1,il,1), &
@@ -4989,9 +4986,9 @@
         if (iso_verif_traceur_choix_nostop(xtprecip(1,il), &
                  'cv3_routine 3147',errmax*1e2, &
-             errmaxrel,ridicule_trac,deltalimtrac).eq.1) then
-          write(*,*) 'il,inb(il)=',il,inb(il)
-          write(*,*) 'xtwater(:,il,1)=',xtwater(:,il,1)
-          write(*,*) 'xtprecip(:,il)=',xtprecip(:,il)
-          write(*,*) 'fac=',wt(il,1)*sigd*86400.*1000./(rowl*grav)
+             errmaxrel,ridicule_trac,deltalimtrac).eq.1) THEN
+          WRITE(*,*) 'il,inb(il)=',il,inb(il)
+          WRITE(*,*) 'xtwater(:,il,1)=',xtwater(:,il,1)
+          WRITE(*,*) 'xtprecip(:,il)=',xtprecip(:,il)
+          WRITE(*,*) 'fac=',wt(il,1)*sigd*86400.*1000./(rowl*grav)
           stop
         endif
@@ -5010,9 +5007,9 @@
          ! 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', &
                  errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(xtprecip(1,il),'cv3_routine 3166')
@@ -5236,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', &
@@ -5243,18 +5240,18 @@
                  fqd(il,1),'cv3_routines 3748', &
                  errmax*0.1,errmaxrel)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,1) &
               +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), &
                  'cv3_yield 3125, ddft en 1')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((xt(iso_HDO,il,1) &
               +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)),(xt(iso_O18,il,1) &
               +delt*fxt(iso_O18,il,1))/(rr(il,1)+delt*fr(il,1)), &
               'cv3_yield 3125b, ddft en 1')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv3_routine 3417')
@@ -5263,18 +5260,18 @@
         enddo
         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)
-              write(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
+                 .eq.1) THEN
+              WRITE(*,*) 'il=',il
+              WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
+              WRITE(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
 #ifdef DIAGISO
-              write(*,*) 'fxt_fluxmasse(:,il,1)=',fxt_fluxmasse(:,il,1)
-              write(*,*) 'fxt_ddft(:,il,1)=',fxt_ddft(:,il,1)
-              write(*,*) 'fxt_evapprecip(:,il,1)=', &
+              WRITE(*,*) 'fxt_fluxmasse(:,il,1)=',fxt_fluxmasse(:,il,1)
+              WRITE(*,*) 'fxt_ddft(:,il,1)=',fxt_ddft(:,il,1)
+              WRITE(*,*) 'fxt_evapprecip(:,il,1)=', &
                          fxt_evapprecip(:,il,1)
-              write(*,*) 'xt(:,il,2)=',xt(:,il,2)
-              write(*,*) 'xtp(:,il,2)=',xtp(:,il,2)
-              write(*,*) 'xtevap(:,il,1)=',xtevap(:,il,1)
-              write(*,*) 'xtevap(:,il,2)=',xtevap(:,il,2)
-              write(*,*) 'facam,facmp,facev=',0.01*grav*am(il)*work(il), &
+              WRITE(*,*) 'xt(:,il,2)=',xt(:,il,2)
+              WRITE(*,*) 'xtp(:,il,2)=',xtp(:,il,2)
+              WRITE(*,*) 'xtevap(:,il,1)=',xtevap(:,il,1)
+              WRITE(*,*) 'xtevap(:,il,2)=',xtevap(:,il,2)
+              WRITE(*,*) 'facam,facmp,facev=',0.01*grav*am(il)*work(il), &
                 0.01*grav*mp(il,2)*work(il),sigd(il)*0.5
 #endif                            
@@ -5296,6 +5293,6 @@
 !AC!     do j=1,ntra
 !AC!      do il=1,ncum
-!AC!       if (iflag(il) .le. 1) then
-!AC!       if (cvflag_grav) then
+!AC!       if (iflag(il) .le. 1) THEN
+!AC!       if (cvflag_grav) THEN
 !AC!        ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
 !AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
@@ -5339,21 +5336,21 @@
        ! 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
+          endif !if (iso_eau.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,1) &
                +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), &
                'cv3_yield 3127, dtr melanges')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) then
+                 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((xt(iso_HDO,il,1) &
               +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)),(xt(iso_O18,il,1) &
               +delt*fxt(iso_O18,il,1))/(rr(il,1)+delt*fr(il,1)), &
               'cv3_yield 3127b, dtr melanges')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv3_routine 3417')
@@ -5362,10 +5359,10 @@
         enddo
         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)
-              write(*,*) 'fac=', 0.01*grav*work(il)*ment(il,j,1)
-              write(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
-              write(*,*) 'xtent(:,il,j,1)=' ,xtent(:,il,j,1) 
+                 .eq.1) THEN
+              WRITE(*,*) 'il=',il
+              WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1)
+              WRITE(*,*) 'fac=', 0.01*grav*work(il)*ment(il,j,1)
+              WRITE(*,*) 'xt(:,il,1)=' ,xt(:,il,1)
+              WRITE(*,*) 'xtent(:,il,j,1)=' ,xtent(:,il,j,1)
 !              stop
         endif
@@ -5383,7 +5380,7 @@
 !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
+!AC!          if (cvflag_grav) THEN
 !AC!           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
 !AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
@@ -5737,13 +5734,13 @@
         do ixt=1,ntraciso
           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)
-            write(*,*) 'xt_wake(ixt,il,i)=',xt_wake(ixt,il,i)
-            write(*,*) 'xtp(ixt,il,i)=',xtp(ixt,il,i)
-            write(*,*) 'xt_wake(ixt,il,i-1)=',xt_wake(ixt,il,i-1)
-            write(*,*) 'mp(il,i:i+1)=',mp(il,i:i+1)
-            write(*,*) 'fxtd(ixt,il,i)=',fxtd(ixt,il,i)
-            write(*,*) 'fxt(ixt,il,i)=',fxt(ixt,il,i)
+                 .eq.1) THEN
+            WRITE(*,*) 'xtevap(ixt,il,i)=',xtevap(ixt,il,i)
+            WRITE(*,*) 'xtp(ixt,il,i+1)=',xtp(ixt,il,i+1)
+            WRITE(*,*) 'xt_wake(ixt,il,i)=',xt_wake(ixt,il,i)
+            WRITE(*,*) 'xtp(ixt,il,i)=',xtp(ixt,il,i)
+            WRITE(*,*) 'xt_wake(ixt,il,i-1)=',xt_wake(ixt,il,i-1)
+            WRITE(*,*) 'mp(il,i:i+1)=',mp(il,i:i+1)
+            WRITE(*,*) 'fxtd(ixt,il,i)=',fxtd(ixt,il,i)
+            WRITE(*,*) 'fxt(ixt,il,i)=',fxt(ixt,il,i)
             stop
           endif
@@ -5751,57 +5748,56 @@
 #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), &
                  fqd(il,i),'cv3_routines 4164', &
-                 errmax*0.1,errmaxrel).eq.1) then
-                write(*,*) 'i,il=',i,il
+                 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. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
         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
-        write(*,*) 'il,i,rr,deltaD=',il,i,rr(il,i),deltaD &
+                 .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
-        write(*,*) 'fr,fxt,deltaD=',fr(il,i),fxt(iso_HDO,il,i), &
+        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
-        write(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
+        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
-        write(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i),deltaD( &
+        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
 #endif        
-        write(*,*) 'sigd,evap(il,i),evap(il,i+1)=', &
+        WRITE(*,*) 'sigd,evap(il,i),evap(il,i+1)=', &
                   sigd(il),evap(il,i),evap(il,i+1)
-        write(*,*) 'xtevap(ixt,il,i),xtevap(ixt,il,i+1)=', &
+        WRITE(*,*) 'xtevap(ixt,il,i),xtevap(ixt,il,i+1)=', &
                  xtevap(ixt,il,i),xtevap(ixt,il,i+1)
-        write(*,*) 'grav,mp(il,i+1),mp(il,i),dpinv=', &
+        WRITE(*,*) 'grav,mp(il,i+1),mp(il,i),dpinv=', &
                  grav,mp(il,i+1),mp(il,i),dpinv
-        write(*,*) 'rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)=', &
+        WRITE(*,*) 'rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)=', &
                  rp(il,i+1),rr(il,i),rp(il,i),rr(il,i-1)
-        write(*,*) 'xtp(il,i+1),xt(il,i),xtp(il,i),xt(il,i-1)=', &
+        WRITE(*,*) 'xtp(il,i+1),xt(il,i),xtp(il,i),xt(il,i-1)=', &
                  xtp(iso_HDO,il,i+1),xt(iso_HDO,il,i), &
                  xtp(iso_HDO,il,i),xt(iso_HDO,il,i-1)
         stop
         endif
-        endif !if (iso_HDO.gt.0) 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
@@ -5839,18 +5835,18 @@
 
         ! ajout du terme des ddfts sensi stricto
-!        write(*,*) 'tmp cv3_yield 4165: i,il=',i,il
-
-        if (option_traceurs.eq.6) then
+!        WRITE(*,*) 'tmp cv3_yield 4165: i,il=',i,il
+
+        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))
-             else !if (mp(il,i).gt.mp(il,i+1)) then
+             else !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)-mp(il,i+1)*xt(ixt_ddft,il,i) &
                  +(mp(il,i+1)-mp(il,i))*xtp(ixt_ddft,il,i))
-             endif !if (mp(il,i).gt.mp(il,i+1)) then
+             endif !if (mp(il,i).gt.mp(il,i+1)) THEN
              fxtqe(iiso)=0.01*grav*dpinv* &
                     (mp(il,i+1)*(xtp(iiso,il,i+1)-xt(iiso,il,i)) &
@@ -5863,8 +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
                 
@@ -5889,8 +5883,8 @@
                 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
+                         (izone.ne.izone_ddft)) THEN
                     ixt=itZonIso(izone,iiso) 
                     fxt(ixt,il,i)=fxt(ixt,il,i) &
@@ -5899,20 +5893,20 @@
                   enddo !do izone=1,nzone   
 #ifdef ISOVERIF
-!                write(*,*) 'iiso=',iiso
-!                write(*,*) 'fxtqe=',fxtqe(iiso)
-!                write(*,*) 'fxtYe=',fxtYe(iiso)
-!                write(*,*) 'fxt_revap=',fxt_revap(iiso)
-!                write(*,*) 'fxtXe=',fxtXe(iiso)
-!                write(*,*) 'Xe=',Xe(iiso)
-!                write(*,*) 'xt=',xt(:,il,i)
+!                WRITE(*,*) 'iiso=',iiso
+!                WRITE(*,*) 'fxtqe=',fxtqe(iiso)
+!                WRITE(*,*) 'fxtYe=',fxtYe(iiso)
+!                WRITE(*,*) 'fxt_revap=',fxt_revap(iiso)
+!                WRITE(*,*) 'fxtXe=',fxtXe(iiso)
+!                WRITE(*,*) 'Xe=',Xe(iiso)
+!                WRITE(*,*) 'xt=',xt(:,il,i)
                   CALL iso_verif_traceur_justmass(fxt(1,il,i), &
                          'cv3_routine 4646')
 #endif
-                else !if (abs(dXe).gt.ridicule) then
+                else !if (abs(dXe).gt.ridicule) THEN
                     ! dans ce cas, fxtXe doit etre faible
                     
 #ifdef ISOVERIF
-                if (delt*fxtXe(iiso).gt.ridicule) then
-                   write(*,*) 'cv3_routines 6563: delt*fxtXe(iiso)=', &
+                if (delt*fxtXe(iiso).gt.ridicule) THEN
+                   WRITE(*,*) 'cv3_routines 6563: delt*fxtXe(iiso)=', &
                                 delt*fxtXe(iiso)
                    stop
@@ -5921,11 +5915,11 @@
                 do izone=1,nzone
                    if ((izone.ne.izone_revap).and. &
-                         (izone.ne.izone_ddft)) then
+                         (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.eq.izone_poubelle) THEN
                    endif !if ((izone.ne.izone_revap).and.
                 enddo !do izone=1,nzone
@@ -5935,9 +5929,8 @@
 #endif              
                                            
-                endif !if (abs(dXe).gt.ridicule) then
-
+                endif !if (abs(dXe).gt.ridicule) THEN
               enddo !do iiso = 1, niso
                
-            else !if (mp(il,i).gt.mp(il,i+1)) then
+            else !if (mp(il,i).gt.mp(il,i+1)) THEN
                 ! cas detrainant: pas de problemes
                 do ixt=1+niso,ntraciso
@@ -5950,13 +5943,11 @@
                          'cv3_routine 4685')
 #endif                
-            endif !if (mp(il,i).gt.mp(il,i+1)) 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 (mp(il,i).gt.mp(il,i+1)) 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
         
@@ -5968,42 +5959,42 @@
 #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
+          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( &
                  fxt(iso_HDO,il,i)/fr(il,i), &
-                 '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
+                 '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
-                write(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( &
+                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
-                write(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i), &
+                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
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.& 
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            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
-                write(*,*) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( &
+                 .eq.1) THEN
+                WRITE(*,*) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( &
                    xt(iso_HDO,il,i)/rr(il,i))
-                write(*,*) 'i,il,fr,deltaD=',i,il,fr(il,i),deltaD( &
+                WRITE(*,*) 'i,il,fr,deltaD=',i,il,fr(il,i),deltaD( &
                    fxt(iso_HDO,il,i)/fr(il,i))
                 stop
             endif ! if (iso_verif_aberrant_nostop
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
-!        write(*,*) 'tmp cv3_yield 4224: i,il=',i,il
+!        WRITE(*,*) 'tmp cv3_yield 4224: i,il=',i,il
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv3_routine 4107')
         do ixt=1,ntraciso
@@ -6011,16 +6002,16 @@
         enddo
         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)
-          write(*,*) 'xt(,il,i)=',xt(:,il,i)
-          write(*,*) 'delt,sigd,grav,dpinv=',delt,sigd(il),grav,dpinv
-          write(*,*) 'xtevap(,il,i)=',xtevap(:,il,i)
-          write(*,*) 'xtevap(,il,i+1)=',xtevap(:,il,i+1)
-          write(*,*) 'mp(il,i+1),mp(il,i)=',mp(il,i+1),mp(il,i)
-          write(*,*) 'xtp(,il,i)=',xtp(:,il,i)
-          write(*,*) 'xtp(,il,i+1)=',xtp(:,il,i+1)
-          write(*,*) 'xt(,il,i)=',xt(:,il,i)
-          write(*,*) 'xt(,il,i-1)=',xt(:,il,i-1)
+                        '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)
+          WRITE(*,*) 'xt(,il,i)=',xt(:,il,i)
+          WRITE(*,*) 'delt,sigd,grav,dpinv=',delt,sigd(il),grav,dpinv
+          WRITE(*,*) 'xtevap(,il,i)=',xtevap(:,il,i)
+          WRITE(*,*) 'xtevap(,il,i+1)=',xtevap(:,il,i+1)
+          WRITE(*,*) 'mp(il,i+1),mp(il,i)=',mp(il,i+1),mp(il,i)
+          WRITE(*,*) 'xtp(,il,i)=',xtp(:,il,i)
+          WRITE(*,*) 'xtp(,il,i+1)=',xtp(:,il,i+1)
+          WRITE(*,*) 'xt(,il,i)=',xt(:,il,i)
+          WRITE(*,*) 'xt(,il,i-1)=',xt(:,il,i-1)
 !         rappel: fxt(ixt,il,i)=fxt(ixt,il,i)
 !          0.5*sigd*(xtevap(ixt,il,i)+xtevap(ixt,il,i+1))
@@ -6068,21 +6059,21 @@
 #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
+        endif !if (iso_eau.gt.0) THEN
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
          CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
                          +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3384, flux masse')
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
         if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((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 3384b, flux masse')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,1),'cv3_routine 3626')
@@ -6091,12 +6082,12 @@
         enddo
         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)
-              write(*,*) 'amp1(il),ad(il),fac=', &
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
+              WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i)
+              WRITE(*,*) 'amp1(il),ad(il),fac=', &
                     amp1(il),ad(il),0.01*grav*dpinv
-              write(*,*) 'xt(:,il,i+1)=' ,xt(:,il,i+1)
-              write(*,*) 'xt(:,il,i)=' ,xt(:,il,i) 
-              write(*,*) 'xt(:,il,i-1)=' ,xt(:,il,i-1)
+              WRITE(*,*) 'xt(:,il,i+1)=' ,xt(:,il,i+1)
+              WRITE(*,*) 'xt(:,il,i)=' ,xt(:,il,i)
+              WRITE(*,*) 'xt(:,il,i-1)=' ,xt(:,il,i-1)
 !              stop
         endif
@@ -6115,8 +6106,8 @@
 !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)
-!AC!         if (cvflag_grav) then
+!AC!         if (cvflag_grav) THEN
 !AC!           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
 !AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
@@ -6156,10 +6147,10 @@
         ! 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))
 !          xtawat(ixt)=amax1(xtawat(ixt),0.0) ! pas necessaire
         enddo !do ixt = 1, ntraciso
-      else !if (elij(il,k,i).gt.0.0) then
+      else !if (elij(il,k,i).gt.0.0) THEN
           ! normalement, si elij(il,k,i)<=0, alors awat=0
           ! on le verifie. Si c'est vrai -> xtawat=0 aussi
@@ -6170,12 +6161,11 @@
           xtawat(ixt,il)=0.0
         enddo !do ixt = 1, ntraciso        
-      endif !if (elij(il,k,i).gt.0.0) then
-
+      endif !if (elij(il,k,i).gt.0.0) THEN
       ! 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)
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(xtawat(1,il),'cv3_routine 3729')
@@ -6226,24 +6216,24 @@
 #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
+        endif !if (iso_eau.gt.0) THEN
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
         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
-           write(*,*) 'rr,delt,fr=',rr(il,i),delt,fr(il,i)
-           write(*,*) 'qent,awat=',qent(il,k,i),awat(il)
-           write(*,*) 'deltaDfr=',deltaD(fxt(iso_hdo,il,i)/fr(il,i))
-           write(*,*) 'deltaDrr=',deltaD(xt(iso_hdo,il,i)/rr(il,i))
-           write(*,*) 'deltaDqent=',deltaD(xtent(iso_hdo,il,k,i) &
+                 .eq.1) THEN
+           WRITE(*,*) 'rr,delt,fr=',rr(il,i),delt,fr(il,i)
+           WRITE(*,*) 'qent,awat=',qent(il,k,i),awat(il)
+           WRITE(*,*) 'deltaDfr=',deltaD(fxt(iso_hdo,il,i)/fr(il,i))
+           WRITE(*,*) 'deltaDrr=',deltaD(xt(iso_hdo,il,i)/rr(il,i))
+           WRITE(*,*) 'deltaDqent=',deltaD(xtent(iso_hdo,il,k,i) &
                         /qent(il,k,i))
-           write(*,*) 'deltaDawat=',deltaD(xtawat(iso_hdo,il)/awat(il))           
+           WRITE(*,*) 'deltaDawat=',deltaD(xtawat(iso_hdo,il)/awat(il))
 !           stop
         endif
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv3_routine 3784')
@@ -6252,6 +6242,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 3905',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv3_yield 3905',1e-5)
@@ -6274,8 +6264,8 @@
 !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)
-!AC!          if (cvflag_grav) then
+!AC!          if (cvflag_grav) THEN
 !AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
 !AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
@@ -6341,29 +6331,29 @@
 #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
+          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( &
 !     &           fxt(iso_HDO,il,i)/fr(il,i), &
-!     &           'cv3_yield 3597').eq.1) then
-!                write(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il)
+!     &           '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
+!          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 3605b, dtr mels')
-          endif !if (iso_HDO.gt.0) then        
+          endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((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 6415c, dtr mels')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(fxt(1,il,i),'cv3_routine 3972')
@@ -6372,6 +6362,6 @@
         enddo
         if (iso_verif_tracpos_choix_nostop(xtnew,'cv3_yield 4091',1e-5) &
-                 .eq.1) then
-              write(*,*) 'il,i=',il,i  
+                 .eq.1) THEN
+              WRITE(*,*) 'il,i=',il,i
          endif
 !        CALL iso_verif_tracpos_choix(xtnew,'cv3_yield 4091',1e-5)
@@ -6390,8 +6380,8 @@
 !AC!        do il=1,ncum
 !AC!         if (i.le.inb(il) .and. k.le.inb(il)
-!AC!     $                .and. iflag(il) .le. 1) then
+!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)
-!AC!          if (cvflag_grav) then
+!AC!          if (cvflag_grav) THEN
 !AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
 !AC!     :         *(traent(il,k,i,j)-tra(il,i,j))
@@ -6458,9 +6448,9 @@
 !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)
 !AC!
-!AC!         if (cvflag_grav) then
+!AC!         if (cvflag_grav) THEN
 !AC!          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
 !AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
@@ -6534,37 +6524,37 @@
 #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
+        endif !if (iso_eau.gt.0) THEN
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6555')
-        endif !if (iso_HDO.gt.0) then                 
+        endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            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
-                write(*,*) 'il,i=',il,i
-                write(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
-                write(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) &
+              'cv3_yield 6555b').eq.1) THEN
+                WRITE(*,*) 'il,i=',il,i
+                WRITE(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
+                WRITE(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) &
                         +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)))
-                write(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i)
-                write(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i))
-                write(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i)
-                write(*,*) 'qent(il,inb(il),inb(il)),rr(il,inb(il))=', &
+                WRITE(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i)
+                WRITE(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i))
+                WRITE(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i)
+                WRITE(*,*) 'qent(il,inb(il),inb(il)),rr(il,inb(il))=', &
                          qent(il,inb(il),inb(il)),rr(il,inb(il))
-                write(*,*) 'xtent(il,inb(il),inb(il)),xt(il,inb(il))=', &
+                WRITE(*,*) 'xtent(il,inb(il),inb(il)),xt(il,inb(il))=', &
                          xtent(iso_O18,il,inb(il),inb(il)),xt(iso_O18,il,inb(il))
-                write(*,*) 'deltaOent=',deltaO(xtent(iso_O18,il,inb(il),inb(il))/qent(il,inb(il),inb(il)))
-                write(*,*) 'bx,xtbx(iso_O18)=',bx,xtbx(iso_O18)
+                WRITE(*,*) 'deltaOent=',deltaO(xtent(iso_O18,il,inb(il),inb(il))/qent(il,inb(il),inb(il)))
+                WRITE(*,*) 'bx,xtbx(iso_O18)=',bx,xtbx(iso_O18)
                 stop
 
            endif                
-         endif !if (iso_HDO.gt.0) then
+         endif !if (iso_HDO.gt.0) THEN
         enddo
 #endif        
@@ -6596,5 +6586,5 @@
 !AC!       do il=1,ncum
 !AC!        IF (iflag(il) .le. 1) THEN
-!AC!	IF (cvflag_grav) then
+!AC!	IF (cvflag_grav) THEN
 !AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
 !AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
@@ -6706,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')
@@ -6714,11 +6704,11 @@
                  bsum(il),'cv3_routines 5419')
               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,:)
-                write(*,*) 'fqd(il,:)=',fqd(il,:)
+                 fsum(il),'cv3_routines 5421').eq.1) THEN
+                WRITE(*,*) 'i,il=',i,il
+                WRITE(*,*) 'fxtd(iso_eau,il,:)=',fxtd(iso_eau,il,:)
+                WRITE(*,*) 'fqd(il,:)=',fqd(il,:)
                 stop
               endif
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif              
 #endif  
@@ -6745,23 +6735,23 @@
            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')
               CALL iso_verif_egalite_choix(fxtd(iso_eau,il,i), &
                  fqd(il,i),'cv3_routines 5439',errmax*0.1,errmaxrel)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6744')
-        endif !if (iso_HDO.gt.0) then               
+        endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_O18_aberrant((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 6744b')
-          endif !if (iso_HDO.gt.0) then  
+          endif !if (iso_HDO.gt.0) THEN
 #endif         
 #endif
@@ -6843,34 +6833,34 @@
            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
+        endif !if (iso_eau.gt.0) THEN
         if ((iso_HDO.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            CALL iso_verif_aberrant((xt(iso_HDO,il,i) &
                  +delt*fxt(iso_HDO,il,i)) &
                  /(rr(il,i)+delt*fr(il,i)),'cv3_yield 6835a')
-        endif !if (iso_HDO.gt.0) then        
+        endif !if (iso_HDO.gt.0) THEN
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &
-                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) then
+                 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN
            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
-                write(*,*) 'il,i=',il,i
-                write(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
-                write(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) &
+              'cv3_yield 6835b').eq.1) THEN
+                WRITE(*,*) 'il,i=',il,i
+                WRITE(*,*) 'deltaOavant=',deltaO(xt(iso_O18,il,i)/rr(il,i))
+                WRITE(*,*) 'deltaOapres=',deltaO((xt(iso_O18,il,i) &
                         +delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)))
-                write(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i)
-                write(*,*) 'alpha_qpos=',alpha_qpos(il)
-                write(*,*) 'fq*delt avantqpos=',delt*fr(il,i)*alpha_qpos(il)
-                write(*,*) 'deltaO avantqpos=',deltaO((xt(iso_O18,il,i) &
+                WRITE(*,*) 'rr,fq*delt=',rr(il,i),delt*fr(il,i)
+                WRITE(*,*) 'alpha_qpos=',alpha_qpos(il)
+                WRITE(*,*) 'fq*delt avantqpos=',delt*fr(il,i)*alpha_qpos(il)
+                WRITE(*,*) 'deltaO avantqpos=',deltaO((xt(iso_O18,il,i) &
                         +delt*fxt(iso_O18,il,i)*alpha_qpos(il))/(rr(il,i)+delt*fr(il,i)*alpha_qpos(il)))
-                write(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i))
-                write(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i)
+                WRITE(*,*) 'deltaOfq=',deltaO(fxt(iso_O18,il,i)/fr(il,i))
+                WRITE(*,*) 'xt,fxt*delt=',xt(iso_O18,il,i),delt*fxt(iso_O18,il,i)
                 stop
            endif                
-          endif !if (iso_HDO.gt.0) then 
+          endif !if (iso_HDO.gt.0) THEN
 #endif    
 #ifdef DIAGISO
@@ -7040,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)
@@ -7253,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)
@@ -7260,10 +7250,10 @@
                   /f_detrainement(il,i)
               enddo !do ixt=1,niso
-            else !if (f_detrainement(il,1).gt.0.0) then
+            else !if (f_detrainement(il,1).gt.0.0) THEN
               q_detrainement(il,i)=0.0
               do ixt=1,niso
                 xt_detrainement(ixt,il,i)=0.0
               enddo !do ixt=1,niso
-            endif !if (f_detrainement(il,1).gt.0.0) then
+            endif !if (f_detrainement(il,1).gt.0.0) THEN
           enddo !do il=1,ncum
         enddo !do i=1,nl  
@@ -7324,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
@@ -7637,11 +7627,10 @@
       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
         ! necessaires au calcul de la cape dans la nouvelle physique
         
-!        write(*,*) 'cv3_routines check 4303'
+!        WRITE(*,*) 'cv3_routines check 4303'
         do i=1,ncum
         do k=1,nd
@@ -7653,16 +7642,16 @@
         enddo !do i=1,ncum
 
-!        write(*,*) 'cv3_routines check 4311'
-!        write(*,*) 'nl=',nl
+!        WRITE(*,*) 'cv3_routines check 4311'
+!        WRITE(*,*) 'nl=',nl
         CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
           pbase, p, ph, tv, buoy, &
           sig_loc, w0_loc, cape, m_loc,iflag_loc)
 
-!        write(*,*) 'cv3_routines check 4316'
-!        write(*,*) 'ep(1,:)=',ep(1,:)
+!        WRITE(*,*) 'cv3_routines check 4316'
+!        WRITE(*,*) 'ep(1,:)=',ep(1,:)
         do i=1,ncum
            epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
            epmax_diag(i)=amax1(epmax_diag(i),0.0)
-!           write(*,*) 'i,icb,inb,cape,epmax_diag=', &
+!           WRITE(*,*) 'i,icb,inb,cape,epmax_diag=', &
 !                i,icb(i),inb(i),cape(i),epmax_diag(i)
            do k=1,nl
@@ -7672,7 +7661,7 @@
            enddo
         enddo
- !       write(*,*) 'ep(1,:)=',ep(1,:)
-
-      !write(*,*) 'cv3_routines check 4326'
+ !       WRITE(*,*) 'ep(1,:)=',ep(1,:)
+
+      !WRITE(*,*) 'cv3_routines check 4326'
 ! On recalcule hp:
 !      do k=1,nl
@@ -7691,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)
@@ -7708,30 +7697,30 @@
 
   ENDIF !IF (cvflag_ice) THEN     
-      !write(*,*) 'cv3_routines check 4345'
+      !WRITE(*,*) 'cv3_routines check 4345'
 !      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. &
-!            (ep(i,k)-ep_bak(i,k).lt.1e-4))) then
-!           write(*,*) 'i,k=',i,k
-!           write(*,*) 'coef_epmax_cape=',coef_epmax_cape
-!           write(*,*) 'epmax_diag(i)=',epmax_diag(i)
-!           write(*,*) 'ep(i,k)=',ep(i,k)
-!           write(*,*) 'ep_bak(i,k)=',ep_bak(i,k)
-!           write(*,*) 'hp(i,k)=',hp(i,k)
-!           write(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
-!           write(*,*) 'h(i,k)=',h(i,k)
-!           write(*,*) 'nk(i)=',nk(i)
-!           write(*,*) 'h(i,nk(i))=',h(i,nk(i))
-!           write(*,*) 'lv(i,k)=',lv(i,k)
-!           write(*,*) 't(i,k)=',t(i,k)
-!           write(*,*) 'clw(i,k)=',clw(i,k)
-!           write(*,*) 'cpd,cpv=',cpd,cpv
+!            (ep(i,k)-ep_bak(i,k).lt.1e-4))) THEN
+!           WRITE(*,*) 'i,k=',i,k
+!           WRITE(*,*) 'coef_epmax_cape=',coef_epmax_cape
+!           WRITE(*,*) 'epmax_diag(i)=',epmax_diag(i)
+!           WRITE(*,*) 'ep(i,k)=',ep(i,k)
+!           WRITE(*,*) 'ep_bak(i,k)=',ep_bak(i,k)
+!           WRITE(*,*) 'hp(i,k)=',hp(i,k)
+!           WRITE(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
+!           WRITE(*,*) 'h(i,k)=',h(i,k)
+!           WRITE(*,*) 'nk(i)=',nk(i)
+!           WRITE(*,*) 'h(i,nk(i))=',h(i,nk(i))
+!           WRITE(*,*) 'lv(i,k)=',lv(i,k)
+!           WRITE(*,*) 't(i,k)=',t(i,k)
+!           WRITE(*,*) 'clw(i,k)=',clw(i,k)
+!           WRITE(*,*) 'cpd,cpv=',cpd,cpv
 !           stop
 !        endif
 !       enddo !do k=1,nl
 !      enddo !do i=1,ncum  
-      endif !if (coef_epmax_cape.gt.1e-12) then
-      !write(*,*) 'cv3_routines check 4367'
+      endif !if (coef_epmax_cape.gt.1e-12) THEN
+      !WRITE(*,*) 'cv3_routines check 4367'
 
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_compress.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_compress.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_compress.F90	(revision 5116)
@@ -123,6 +123,6 @@
 
 #ifdef ISOVERIF
-        write(*,*) 'compress=',   compress
-        write(*,*) 'nl=',nl
+        WRITE(*,*) 'compress=',   compress
+        WRITE(*,*) 'nl=',nl
 #endif
 !jyg<
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3a_uncompress.F90	(revision 5116)
@@ -209,5 +209,5 @@
 !>jyg
 #ifdef ISOVERIF
-        write(*,*) 'cv3a_uncompress 151: entrée dans cv3a_uncompress'
+        WRITE(*,*) 'cv3a_uncompress 151: entrée dans cv3a_uncompress'
 #endif
     DO i = 1, ncum
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90	(revision 5116)
@@ -282,9 +282,9 @@
           END IF ! new ! IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (j>=(icb(il)-1)) &
 #ifdef ISO
-         if(sij(il,i,j).gt.0.0)then
+         IF(sij(il,i,j).gt.0.0)THEN
                qent_diag(il,i,j)=sij(il,i,j)*rr(il,i) &
                      +(1.-sij(il,i,j))*rti
            ! question: pourquoi qent n'est-il pas recalculé ici?
-         endif !if(sij(il,i,j).gt.0.0)then
+         endif !IF(sij(il,i,j).gt.0.0)THEN
 #endif
         END DO ! il
@@ -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')
@@ -313,10 +313,10 @@
           CALL iso_verif_egalite(xtent_diag(iso_eau,il,i,j), &
                 qent_diag(il,i,j),'cv3p_mixing 256d')    
-          endif ! if (iso_eau.gt.0) then      
+          endif ! if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur(xtrti,'cv3p_mixing 1968')
 #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) &
@@ -324,20 +324,19 @@
              enddo ! do ixt=1,ntraciso
              qent_diag(il,i,j)=elij(il,i,j)
-           endif !if (qent_diag(il,i,j).lt.elij(il,i,j)) then
-
+           endif !if (qent_diag(il,i,j).lt.elij(il,i,j)) THEN
 #ifdef ISOVERIFIDRIS
           CALL iso_verif_noNaN(qent_diag(il,i,j),'cv3p_routines 261')
 #endif
 #ifdef ISOVERIF
-          if (iso_eau.gt.0) 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)=', &
+                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)=', &
                 qent_diag(il,i,j),elij(il,i,j)
-             write(*,*) 'sij(il,i,j)=',sij(il,i,j)
-             write(*,*) 'xt=',xt(iso_eau,il,i),rr(il,i)
-             write(*,*) 'xtclw=',xtclw(iso_eau,il,i),clw(il,i)
-             write(*,*) 'ep(il,i)=',ep(il,i)
+             WRITE(*,*) 'sij(il,i,j)=',sij(il,i,j)
+             WRITE(*,*) 'xt=',xt(iso_eau,il,i),rr(il,i)
+             WRITE(*,*) 'xtclw=',xtclw(iso_eau,il,i),clw(il,i)
+             WRITE(*,*) 'ep(il,i)=',ep(il,i)
              stop
            endif
@@ -346,5 +345,5 @@
                 'cv3p_routines 262')
 #endif
-         else !if (sij(il,i,j).gt.0.0) then 
+         else !if (sij(il,i,j).gt.0.0) THEN
             ! ajout le 4 mai 2012: initialiser au cas où
             elij(il,i,j)=0.0 
@@ -353,6 +352,6 @@
               xtent_diag(ixt,il,i,j)=xt(ixt,il,i)
             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.
+         endif  !IF(sij(il,i,j).gt.0.0)THEN
+        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 
@@ -361,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
@@ -372,5 +371,5 @@
        enddo  !do il=1,ncum 
 
-       !write(*,*) 'cv3p_mixing 265: CALL condiso'
+       !WRITE(*,*) 'cv3p_mixing 265: CALL condiso'
        CALL condiso_liq_ice_vectall(xtent_diag(1,1,i,j), &
                 qent_diag(1,i,j),elij(1,i,j), &
@@ -394,13 +393,13 @@
 
 #ifdef ISOTRAC    
-!        write(*,*) 'cv3p_mixing tmp 1987,option_traceurs=',
+!        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. &
-                (qent_diag(il,i,j).gt.0.0)) then  
-            if (option_traceurs.eq.17) then        
+                (qent_diag(il,i,j).gt.0.0)) THEN
+            if (option_traceurs.eq.17) THEN
              CALL iso_recolorise_condensation(qent_diag(il,i,j), &
                 elij(il,i,j), &
@@ -408,15 +407,15 @@
                 0.0,xtres, &
                 seuil_tag_tmin)
-            else !if (option_traceurs.eq.17) then
-!             write(*,*) 'cv3 2002: il,i,j  =',il,i,j   
+            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), &
                 elij(il,i,j), &
                 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)
             enddo     
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
         enddo !do il=1,ncum
 #ifdef ISOVERIF
@@ -428,5 +427,5 @@
         enddo !do il=1,ncum 
 #endif        
-        endif !if (option_tmin.ge.1) then       
+        endif !if (option_tmin.ge.1) THEN
 #endif
 
@@ -435,7 +434,7 @@
         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
+           (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)   
@@ -443,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')         
@@ -452,7 +451,7 @@
                  xtelij(iso_HDO,il,i,j),elij(il,i,j), &
                  ridicule,deltalim_snow,'cv3p_mixing 1993')
-        endif !if (iso_hdo.gt.0) then
+        endif !if (iso_hdo.gt.0) THEN
 #ifdef ISOTRAC  
-!        write(*,*) 'cv3p_mixing tmp 2039 il=',il
+!        WRITE(*,*) 'cv3p_mixing tmp 2039 il=',il
            CALL iso_verif_traceur(xtent(1,il,i,j), &
                         'cv3p_mixing 2031')
@@ -461,9 +460,9 @@
 #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(sij(il,i,j).gt.0.0)THEN
+        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
         enddo !do il=1,ncum
 #endif
-!        write(*,*) 'cv3p_routine tmp 1984: cond=',elij(il,i,j)                
+!        WRITE(*,*) 'cv3p_routine tmp 1984: cond=',elij(il,i,j)
 #endif
 
@@ -492,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.
@@ -512,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)
@@ -518,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)=',
+!        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), &
@@ -530,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), &
@@ -536,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)
@@ -548,6 +547,5 @@
             enddo
 #endif            
-          endif !if (cond.gt.0.0) then
-          
+          endif !if (cond.gt.0.0) THEN
 #ifdef ISOVERIF          
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
@@ -556,5 +554,5 @@
           CALL iso_verif_traceur(xtelij(1,il,i,i),'cv3p_mixing 2096')
 #endif        
-        endif !if (option_tmin.ge.1) then    
+        endif !if (option_tmin.ge.1) THEN
 #endif
 ! endif ISOTRAC
@@ -886,7 +884,6 @@
        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
-
+           .and. lwork(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)         
@@ -899,11 +896,11 @@
           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')    
           endif
 #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(sij(il,i,j).gt.0.0)THEN
+        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
        enddo  !do il=1,ncum
    
@@ -914,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), &
@@ -924,5 +921,5 @@
                 'cv3p_routines 749')
         enddo !do il=1,ncum   
-        !write(*,*) 'cv3p_mixing 788: CALL condiso_liq_ice_vectall'
+        !WRITE(*,*) 'cv3p_mixing 788: CALL condiso_liq_ice_vectall'
 #endif     
       
@@ -938,15 +935,15 @@
         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
+           .and. lwork(il) ) THEN
+        IF(sij(il,i,j).gt.0.0)THEN
          do ixt = 1, ntraciso
           xtelij(ixt,il,i,j)=zxtice(ixt,il)+zxtliq(ixt,il)
          enddo !do ixt = 1, ntraciso
-        endif !if(sij(il,i,j).gt.0.0)then
+        endif !IF(sij(il,i,j).gt.0.0)THEN
         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), &
@@ -960,29 +957,29 @@
 
 #ifdef ISOTRAC    
-!        write(*,*) 'cv3_routines tmp 1987,option_traceurs=',
+!        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),',
+!        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
 !     :           'tcond(il),rs(il,j)=',
 !     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
         ! 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
-!             write(*,*) 'cv3 2002: il,i,j  =',il,i,j   
+            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)
             enddo     
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
         enddo !do il=1,ncum
 #ifdef ISOVERIF
@@ -994,5 +991,5 @@
         enddo !do il=1,ncum 
 #endif        
-        endif !if (option_tmin.ge.1) then       
+        endif !if (option_tmin.ge.1) THEN
 #endif
 ! endif ISOTRAC
@@ -1045,6 +1042,6 @@
        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
+           .and. lwork(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)         
@@ -1059,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')    
@@ -1066,9 +1063,9 @@
                 'cv3p_routines 887')
 #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(sij(il,i,j).gt.0.0)THEN
+        endif !IF( (i.ge.icb(il)).and.(i.le.inb(il)).and.
        enddo  !do il=1,ncum
       
-       !write(*,*) 'cv3p_mixing 808: CALL condiso'
+       !WRITE(*,*) 'cv3p_mixing 808: CALL condiso'
        CALL condiso_liq_ice_vectall(xtent(1,1,i,j),qent(1,i,j), &
                 elij(1,i,j), &
@@ -1080,8 +1077,8 @@
          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')
-         endif ! if (iso_eau.gt.0) then
+         endif ! if (iso_eau.gt.0) THEN
 #endif
         enddo !do il=1,ncum
@@ -1098,27 +1095,27 @@
 #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),',
+!        WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),',
 !     :           'tcond(il),rs(il,j)=',
 !     :            il,i,j,xtent(:,il,i,j),tcond(il),rs(il,j)
         ! 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
-!             write(*,*) 'cv3 2002: il,i,j  =',il,i,j   
+            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)
             enddo     
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
         enddo !do il=1,ncum
 #ifdef ISOVERIF
@@ -1130,10 +1127,10 @@
         enddo !do il=1,ncum 
 #endif        
-        endif !if (option_tmin.ge.1) then
+        endif !if (option_tmin.ge.1) THEN
 !#ifdef ISOVERIF        
 #endif
 !#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), &
@@ -1142,5 +1139,5 @@
                 elij(il,i,j),'cv3p_routines 885')  
             enddo !do il=1,ncum  
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif  
 !#ifdef ISOVERIF           
@@ -1201,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)
@@ -1217,19 +1214,19 @@
       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')
-      endif ! if (iso_eau.gt.0) then
+      endif ! if (iso_eau.gt.0) THEN
 #endif
 #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 2314 il,i,j,xtent(:,il,i,j)=',
+!        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), &
@@ -1237,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), &
@@ -1243,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)
@@ -1255,5 +1252,5 @@
             enddo
 #endif               
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
 #ifdef ISOVERIF          
           CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,i), &
@@ -1264,5 +1261,5 @@
           CALL iso_verif_traceur(xtelij(1,il,i,i),'cv3p_mixing 2323')
 #endif        
-        endif !if (option_tmin.ge.1) then
+        endif !if (option_tmin.ge.1) THEN
 #endif
         IF (fl_cor_ebil .GE. 2) THEN
@@ -1278,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
@@ -1290,16 +1287,16 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!       write(*,*) 'cv3p_mixing 2540: ', &
+!       WRITE(*,*) 'cv3p_mixing 2540: ', &
 !        'verif finale en sortant de cv3p_mixing'
-!       write(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
+!       WRITE(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
        do im = 1, nd
        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)
             CALL iso_verif_egalite_choix(xtent(iso_eau,il,im,jm), &
               qent(il,im,jm),'cv3p_mixing 2112',errmax,errmaxrel)
-          endif !if (iso_eau>0) then
+          endif !if (iso_eau>0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur_justmass(xtelij(1,il,im,jm), &
@@ -1315,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
@@ -1321,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
@@ -1342,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
@@ -1355,8 +1352,8 @@
 !        if (iso_verif_positif_nostop(xtclw(itZonIso( &
 !                izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
-!                ,'cv3p_mixing 909').eq.1) then
-!               write(*,*) 'i,k=',i,k
-!               write(*,*) 'xtclw=',xtclw(:,i,k)
-!               write(*,*) 'niso,ntraciso,index_zone,izone_cond=', &
+!                ,'cv3p_mixing 909').eq.1) THEN
+!               WRITE(*,*) 'i,k=',i,k
+!               WRITE(*,*) 'xtclw=',xtclw(:,i,k)
+!               WRITE(*,*) 'niso,ntraciso,index_zone,izone_cond=', &
 !                  niso,ntraciso,index_zone,izone_cond      
 !               stop
@@ -1365,6 +1362,6 @@
 !         enddo !do il = 1, ncum   
 !         enddo !do im = 1, nd
-!         write(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
-        endif !if (option_tmin.eq.1) then
+!         WRITE(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2)
+        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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_driver.F90	(revision 5116)
@@ -33,5 +33,5 @@
 #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
@@ -450,7 +450,7 @@
         ! verif     
 #ifdef ISOVERIF
-       write(*,*) 'cv_driver 391: ENTREE dans cv_driver'
-!        write(*,*) 'nloc=',nloc
-       if (iso_eau.gt.0) then
+       WRITE(*,*) 'cv_driver 391: ENTREE dans cv_driver'
+!        WRITE(*,*) 'nloc=',nloc
+       if (iso_eau.gt.0) THEN
         do k = 1, klev
          do i = 1, nloc          
@@ -459,15 +459,15 @@
          enddo
         enddo
-       endif !if (iso_eau.gt.0) then 
-       if (iso_HDO.gt.0) then
+       endif !if (iso_eau.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')
-           endif !if (q1(i,k).gt.ridicule) then        
+           endif !if (q1(i,k).gt.ridicule) THEN
          enddo
         enddo
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         do k = 1, klev
@@ -511,5 +511,5 @@
     CALL cv_param(nd)
 #ifdef ISO
-       write(*,*) 'cv_driver 454: isos pas prevus ici'
+       WRITE(*,*) 'cv_driver 454: isos pas prevus ici'
        stop
 #endif
@@ -659,13 +659,13 @@
 
 #ifdef ISOVERIF
-       write(*,*) 'cv_driver 593: avant cv3_undilute1'
+       WRITE(*,*) 'cv_driver 593: avant cv3_undilute1'
        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')
-            endif ! if (q1(i,k).gt.ridicule) then
-            endif !if (iso_HDO.gt.0) then
+            endif ! if (q1(i,k).gt.ridicule) THEN
+            endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt1(1,i,k),'cv_driver 601')
@@ -687,13 +687,13 @@
 !c--debug
 #ifdef ISOVERIF
-       write(*,*) 'cv_driver 621: apres cv3_undilute1'
+       WRITE(*,*) 'cv_driver 621: apres cv3_undilute1'
        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)
          CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
                  'undil1',errmax,errmaxrel)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt1(1,i,k),'cv_driver 623')
@@ -702,5 +702,5 @@
        enddo
 #endif
-       !write(*,*) 'SORTIE DE CV3_UNDILUTE1'
+       !WRITE(*,*) 'SORTIE DE CV3_UNDILUTE1'
 #endif
 
@@ -750,14 +750,14 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        !write(*,*) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
-        !write(*,*) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1) 
+        !WRITE(*,*) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
+        !WRITE(*,*) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1)
        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)
             CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
                   'cv_driver 541b',errmax,errmaxrel)
-        endif !  if (iso_eau.gt.0) then
+        endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt1(1,i,k),'cv_driver 689')
@@ -782,18 +782,18 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'cv_driver 720: apres cv3_compress'           
+       WRITE(*,*) 'cv_driver 720: apres cv3_compress'
        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)
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cv_driver 600',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
-         if (iso_HDO.gt.0) then    
+         endif !  if (iso_eau.gt.0) THEN
+         if (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
                   ridicule,deltalim,'cv_driver 735, apres compress')
-         endif !if (iso_HDO.gt.0) then 
+         endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cv_driver 726')
@@ -801,10 +801,10 @@
         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), &
                   'cv_driver 834',errmax,errmaxrel)
        enddo
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
 #endif
 #endif
@@ -840,18 +840,18 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        write(*,*) 'cv_driver 863: apres CALL cv30_undilute2'
+        WRITE(*,*) 'cv_driver 863: apres CALL cv30_undilute2'
        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)
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cv_driver 652',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
-         if (iso_HDO.gt.0) then    
+         endif !  if (iso_eau.gt.0) THEN
+         if (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
                   ridicule,deltalim,'cv_driver 794, apres undilute2')
-         endif !if (iso_HDO.gt.0) then  
+         endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cv_driver 780trac')
@@ -861,5 +861,5 @@
        enddo
 #endif
-       !write(*,*) 'SORTIE CV3_UNDILUTE2'
+       !WRITE(*,*) 'SORTIE CV3_UNDILUTE2'
 #endif
     END IF
@@ -909,14 +909,14 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'cv_driver 837: apres cv3_mixing'
+       WRITE(*,*) 'cv_driver 837: apres cv3_mixing'
        do k = 1, klev
        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)
             CALL iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
                   qent(i,j,k),'cv_driver 882',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
+         endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur_justmass(xtent(1,i,j,k), &
@@ -932,16 +932,16 @@
        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)
-         endif !  if (iso_eau.gt.0) then
+         endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cv_driver 856')
-           if (option_tmin.eq.1) then
+           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
-               write(*,*) 'i,k=',i,k
-               write(*,*) 'xtclw=',xtclw(:,i,k)
+                 ,'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(
@@ -972,8 +972,8 @@
        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)
-         endif !  if (iso_eau.gt.0) then
+         endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cv_driver 885')
@@ -997,11 +997,11 @@
 
 #ifdef ISO
-!       write(*,*) 'klev=',klev
-#ifdef ISOVERIF
-       write(*,*) 'cv_driver 930: apres cv3_unsat'
+!       WRITE(*,*) 'klev=',klev
+#ifdef ISOVERIF
+       WRITE(*,*) 'cv_driver 930: apres cv3_unsat'
        do k = 1, klev
         do i = 1, ncum
-         if (iso_eau.gt.0) then
-            !    write(*,*) 'i,k=',i,k
+         if (iso_eau.gt.0) THEN
+            !    WRITE(*,*) 'i,k=',i,k
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cv_driver 778',errmax,errmaxrel)
@@ -1013,5 +1013,5 @@
             CALL iso_verif_egalite_choix(xtevap(iso_eau,i,k), &
                   evap(i,k),'cv_driver 784',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
+         endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cv_driver 939')
@@ -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
+        endif !if (iso_HDO.gt.0) 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
+        endif !if (iso_HDO.gt.0) 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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv_routines.F90	(revision 5116)
@@ -591,5 +591,5 @@
         ! 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
@@ -662,10 +662,10 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! byp=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
@@ -689,9 +689,9 @@
   ! do 530 k=minorig+1,nl-1
   ! do 520 i=1,ncum
-  ! if(k.ge.(icb(i)+1))then
+  ! IF(k.ge.(icb(i)+1))THEN
   ! by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k)
   ! cape(i)=cape(i)+by
-  ! if(by.ge.0.0)inb1(i)=k+1
-  ! if(cape(i).gt.0.0)then
+  ! IF(by.ge.0.0)inb1(i)=k+1
+  ! IF(cape(i).gt.0.0)THEN
   ! inb(i)=k+1
   ! capem(i)=cape(i)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cva_driver.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cva_driver.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/cva_driver.F90	(revision 5116)
@@ -63,5 +63,5 @@
 #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
@@ -882,5 +882,5 @@
 ! PRINT*, 'IFLAG1 avant cv3_feed'
 ! PRINT*,'len,nd',len,nd
-! write(*,'(64i1)') iflag1(2:len-1)
+! WRITE(*,'(64i1)') iflag1(2:len-1)
 
         if (prt_level >= 9) &
@@ -899,5 +899,5 @@
 ! PRINT*, 'IFLAG1 apres cv3_feed'
 ! PRINT*,'len,nd',len,nd
-! write(*,'(64i1)') iflag1(2:len-1)
+! WRITE(*,'(64i1)') iflag1(2:len-1)
 
   IF (iflag_con==4) THEN
@@ -924,16 +924,16 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'cva_driver 593: avant cv3_undilute1' 
-       if (iso_HDO.gt.0) then   
+       WRITE(*,*) 'cva_driver 593: avant cv3_undilute1'
+       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')
-           endif ! if (q1(i,k).gt.ridicule) then
+           endif ! if (q1(i,k).gt.ridicule) THEN
           enddo !do i=1,len 
         enddo !do k=1,nd   
-        endif !if (iso_HDO.gt.0) then 
-        if (iso_eau.gt.0) then                     
+        endif !if (iso_HDO.gt.0) THEN
+        if (iso_eau.gt.0) THEN
           do i=1,len
             do k=1,nd
@@ -949,5 +949,5 @@
             enddo ! do ixt=1,ntraciso
            enddo !do i=1,len
-         endif !if (iso_eau.gt.0) then 
+         endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
          do k=1,nd       
@@ -969,13 +969,13 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'cva_driver 621: apres cv3_undilute1'
+       WRITE(*,*) 'cva_driver 621: apres cv3_undilute1'
        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)
          CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
                  'cva_driver 800',errmax,errmaxrel)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
          do ixt=1,ntraciso
            CALL iso_verif_noNaN(xt1(ixt,i,k),'cva_driver 815')
@@ -992,5 +992,5 @@
        enddo !do i = 1, len
 #endif
-       !write(*,*) 'SORTIE DE CV3_UNDILUTE1'
+       !WRITE(*,*) 'SORTIE DE CV3_UNDILUTE1'
 #endif
 
@@ -1021,5 +1021,5 @@
 ! PRINT*, 'IFLAG1 apres cv3_triger'
 ! PRINT*,'len,nd',len,nd
-! write(*,'(64i1)') iflag1(2:len-1)
+! WRITE(*,'(64i1)') iflag1(2:len-1)
 
 ! CALL dump2d(iim,jjm-1,sig1(2)
@@ -1078,10 +1078,10 @@
        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)
             CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
                   'cva_driver 541b',errmax,errmaxrel)
-        endif !  if (iso_eau.gt.0) then
+        endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt1(1,i,k),'cva_driver 689')
@@ -1127,9 +1127,9 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'cva_driver 720: apres cv3_compress'
-!       write(*,*) 'len, nloc, ncum,nd=',len, nloc, ncum,nd
+       WRITE(*,*) 'cva_driver 720: apres cv3_compress'
+!       WRITE(*,*) 'len, nloc, ncum,nd=',len, nloc, ncum,nd
        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)
@@ -1138,10 +1138,10 @@
             CALL iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
                   'cva_driver 602',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
-         if (iso_HDO.gt.0) then    
+         endif !  if (iso_eau.gt.0) THEN
+         if (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
                   ridicule,deltalim,'cva_driver 735, apres compress')
-         endif !if (iso_HDO.gt.0) then 
+         endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cva_driver 726')
@@ -1155,5 +1155,5 @@
          CALL iso_verif_positif(qnk(i),'cva_driver 966b')
        enddo !do i = 1, ncum
-!       write(*,*) 'cva_driver 1142: apres cv3_compress OK'
+!       WRITE(*,*) 'cva_driver 1142: apres cv3_compress OK'
 #endif
 #endif
@@ -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)
@@ -1208,10 +1208,10 @@
             CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
                   'cva_driver 652',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
-         if (iso_HDO.gt.0) then    
+         endif !  if (iso_eau.gt.0) THEN
+         if (iso_HDO.gt.0) THEN
               CALL iso_verif_aberrant_choix( &
                   xt(iso_HDO,i,k),q(i,k), &
                   ridicule,deltalim,'cva_driver 794, apres undilute2')
-         endif !if (iso_HDO.gt.0) then  
+         endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cva_driver 780')
@@ -1229,5 +1229,5 @@
 #endif      
 #endif
-       !write(*,*) 'SORTIE CV3_UNDILUTE2'
+       !WRITE(*,*) 'SORTIE CV3_UNDILUTE2'
 #endif
 
@@ -1363,15 +1363,15 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'cva_driver 837: apres cv3_mixing'
-!       write(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
+       WRITE(*,*) 'cva_driver 837: apres cv3_mixing'
+!       WRITE(*,*) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
        do k=1,nd
        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)
             CALL iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
                   qent(i,j,k),'cva_driver 882',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
+         endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur_justmass(xtent(1,i,j,k), &
@@ -1387,16 +1387,16 @@
        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)
-         endif !  if (iso_eau.gt.0) then
+         endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cva_driver 856')
-           if (option_tmin.eq.1) then
+           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
-               write(*,*) 'i,k=',i,k
-               write(*,*) 'xtclw=',xtclw(:,i,k)
+                 ,'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(
@@ -1449,10 +1449,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(xt(iso_eau,i,k),q(i,k), &
                   'cva_driver 753a',errmax,errmaxrel)
             CALL iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
                   'cva_driver 753b',errmax,errmaxrel)
-         endif !  if (iso_eau.gt.0) then
+         endif !  if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_traceur(xt(1,i,k),'cva_driver 885')
@@ -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   
@@ -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)
@@ -1723,12 +1723,12 @@
       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)) &
                 /(q1(i,k)+delt*fq1(i,k)),'cva_driver 2554')
           endif
-         endif !if (iso_HDO.gt.0) then 
-         if (iso_eau.gt.0) then 
+         endif !if (iso_HDO.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)
@@ -1736,6 +1736,6 @@
          do ixt=1,ntraciso
            if (iso_verif_noNaN_nostop(fxtd1(ixt,i,k), &
-                 'cva_driver 1447').eq.1) then
-              write(*,*) 'i,k=', i,k
+                 'cva_driver 1447').eq.1) THEN
+              WRITE(*,*) 'i,k=', i,k
               stop
            endif !if (iso_verif_noNaN_nostop(fxtd1(ixt,i,k),
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_mod.F90	(revision 5116)
@@ -295,5 +295,5 @@
        tkcin1(ixt) = 0.0005016
        tkcin2(ixt) = 0.0014432
-       if (tnat1) then 
+       if (tnat1) THEN
                tnat(ixt)=1 
        else 
@@ -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 
@@ -338,5 +338,5 @@
        tkcin1(ixt) = tkcin1_O18
        tkcin2(ixt) = tkcin2_O18
-       if (tnat1) then
+       if (tnat1) THEN
                tnat(ixt)=1 
        else 
@@ -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
@@ -400,10 +400,10 @@
    enddo ! ixt=1,niso
 
-   IF(.NOT.Rdefault_smow) then
+   IF(.NOT.Rdefault_smow) THEN
         Rdefault(:) = 0.0
         if (iso_eau.gt.0) Rdefault(iso_eau) = 1.0 ! correction Camille 30 mars 2023
    ENDIF
-   write(*,*) 'Rdefault=',Rdefault
-   write(*,*) 'toce=',toce
+   WRITE(*,*) 'Rdefault=',Rdefault
+   WRITE(*,*) 'toce=',toce
 
    !--- Sensitivity test: no kinetic effect in sfc evaporation
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_routines_mod.F90	(revision 5116)
@@ -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
@@ -101,9 +101,9 @@
 icas_evap_glace=0
 #ifdef ISOVERIF
-!     write(*,*) 'iso_routines tmp 96: entree'
+!     WRITE(*,*) 'iso_routines tmp 96: entree'
 ! initialisation de l'outil de tracage de cas:
 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', &
@@ -118,6 +118,6 @@
 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
@@ -125,5 +125,5 @@
        trace_cas(i)=2               
 #endif  
-     else !if (zt(i).ge.ztglace_kelvin) then
+     else !if (zt(i).ge.ztglace_kelvin) THEN
        icas_evap_glace=icas_evap_glace+1    
        cas_evap_glace(icas_evap_glace)=i
@@ -131,6 +131,6 @@
        trace_cas(i)=3
 #endif       
-     endif !if (zt(i).ge.ztglace_kelvin) then
-    else !if (zrfln(i).gt.ridicule*1e-2) then  
+     endif !if (zt(i).ge.ztglace_kelvin) THEN
+    else !if (zrfln(i).gt.ridicule*1e-2) THEN
        icas_evap_tot=icas_evap_tot+1    
 !               cas_evap_tot(icas_evap_tot)=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)
@@ -159,5 +159,5 @@
 #endif
 #endif
-    endif !if (zrfln(i).gt.ridicule*1e-2) then  
+    endif !if (zrfln(i).gt.ridicule*1e-2) THEN
 else !IF (zrfl_ancien(i) .GT.0.) THEN
     ! pas de precip, rien à signaler
@@ -170,9 +170,9 @@
 #ifdef ISOVERIF
      trace_cas(i)=4
-!     write(*,*) 'iso_routines tmp 160: i=',i
-!        write(*,*) 'zrfl(i)=',zrfl(i)
-!        write(*,*) 'zrfln(i)=',zrfln(i)
-!        write(*,*) 'zrfl_ancien(i)=',zrfl_ancien(i)
-!        write(*,*) 'zqev_diag(i)=',zqev_diag(i)
+!     WRITE(*,*) 'iso_routines tmp 160: i=',i
+!        WRITE(*,*) 'zrfl(i)=',zrfl(i)
+!        WRITE(*,*) 'zrfln(i)=',zrfln(i)
+!        WRITE(*,*) 'zrfl_ancien(i)=',zrfl_ancien(i)
+!        WRITE(*,*) 'zqev_diag(i)=',zqev_diag(i)
      CALL iso_verif_egalite_choix(zqev_diag(i), &
 &                  0.0,'iso_revap_ilp 148a',ridicule,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,17 +189,17 @@
 &                  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')
            CALL iso_verif_O18_aberrant(zxt(iso_HDO,i)/zq(i), &
                      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 (zq(i).gt.ridicule) THEN
+     endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) THEN
 #ifdef ISOTRAC
      CALL iso_verif_traceur(zxtrfl_ancien(1,i), &
 &           'iso_revap_fisrtilp 201: debut quand pas de precip')
 #endif
-!     write(*,*) 'iso_routines tmp 184'
+!     WRITE(*,*) 'iso_routines tmp 184'
 #endif               
 END IF !IF (zrfl_ancien(i) .GT.0.) THEN
@@ -209,13 +209,12 @@
 ncas_evap_tot=icas_evap_tot
 
-!      write(*,*) 'zrfln 773,k,klev,klon=',k,klev,klon
-!      write(*,*) 'ncas_evap_liq=',ncas_evap_liq
-!      write(*,*) 'ncas_evap_glace=',ncas_evap_glace
-!      write(*,*) 'ncas_evap_tot=',ncas_evap_tot
+!      WRITE(*,*) 'zrfln 773,k,klev,klon=',k,klev,klon
+!      WRITE(*,*) 'ncas_evap_liq=',ncas_evap_liq
+!      WRITE(*,*) 'ncas_evap_glace=',ncas_evap_glace
+!      WRITE(*,*) 'ncas_evap_tot=',ncas_evap_tot
 
 
 ! ** cas evap_liq=2
-IF (ncas_evap_liq.gt.0) then
-
+IF (ncas_evap_liq.gt.0) THEN
   CALL compress_ilp_evap_liq( &
 &       ncas_evap_liq,cas_evap_liq(1), &
@@ -248,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)), &
@@ -268,8 +267,8 @@
 &          'iso_revap_fisrtilp 691, après compress_evap_liq')
  enddo !do i=1,ncas_evap_liq
-!         write(*,*) 'iso_revap_fisrtilp temp 715: qeff(1),zqs_cas(1)=',
+!         WRITE(*,*) 'iso_revap_fisrtilp temp 715: qeff(1),zqs_cas(1)=',
 !     :           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), &
@@ -278,6 +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), &
@@ -293,6 +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
@@ -306,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( &
@@ -317,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) &
@@ -326,20 +323,20 @@
          endif
        enddo !do i=1,ncas_evap_liq
-   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
+   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
         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')
            CALL iso_verif_O18_aberrant((zxtnew_cas(iso_HDO,i))/zq(cas_evap_liq(i)), &
                      (zxtnew_cas(iso_O18,i))/zq(cas_evap_liq(i)),'iso_revap_ilp 312')
-        endif !if (zq(i).gt.ridicule) then
+        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     
-    ! write(*,*) 'iso_routines tmp 319'
+    endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) THEN
+    ! WRITE(*,*) 'iso_routines tmp 319'
 #endif
   if ((bidouille_anti_divergence).and. &
-&           (iso_eau.gt.0)) then
+&           (iso_eau.gt.0)) THEN
     do i=1,ncas_evap_liq
       zxtrfln_cas(iso_eau,i)=zrfln_cas(i)
@@ -361,15 +358,15 @@
   
 #ifdef ISOVERIF          
-  write(*,*) 'iso_revap_ilp 245 tmp: izone=',izone
-  write(*,*) 'avant CALL compress_ilp_evap_liq_zone'
-!          if (ncas_evap_liq.ge.9) then
+  WRITE(*,*) 'iso_revap_ilp 245 tmp: izone=',izone
+  WRITE(*,*) 'avant CALL compress_ilp_evap_liq_zone'
+!          if (ncas_evap_liq.ge.9) THEN
 !          i=9
-!          write(*,*) 'i,cas_evap_liq(i),zrfln,zrfl_ancien,zqev_diag=',
+!          WRITE(*,*) 'i,cas_evap_liq(i),zrfln,zrfl_ancien,zqev_diag=',
 !     :              i,cas_evap_liq(i),zrfln(cas_evap_liq(i)),
 !     :              zrfl_ancien(cas_evap_liq(i)),
 !     :              zqev_diag(cas_evap_liq(i))
-!          write(*,*) 'zxtrfl_ancien(1:ntraciso:2,i)=',
+!          WRITE(*,*) 'zxtrfl_ancien(1:ntraciso:2,i)=',
 !     :           zxtrfl_ancien(1:ntraciso:2,cas_evap_liq(i))
-!          write(*,*) 'ieau,zxtrfl_ancien(ieau,cas_evap_liq(i)=',
+!          WRITE(*,*) 'ieau,zxtrfl_ancien(ieau,cas_evap_liq(i)=',
 !     :           index_trac(izone,iso_eau),zxtrfl_ancien        
 !     :           (index_trac(izone,iso_eau),cas_evap_liq(i))
@@ -402,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)
@@ -409,5 +406,5 @@
        zxtrfl_cas(ixt,i)=zxtrfl_cas(ixt,i)/ptrac(i)
       enddo               
-    else !if (ptrac(i).gt.ridicule*1e3) then
+    else !if (ptrac(i).gt.ridicule*1e3) THEN
 #ifdef ISOVERIF                
      CALL iso_verif_egalite((zrfl_cas(i)), &
@@ -424,5 +421,5 @@
        zxtrfl_cas(ixt,i)=0.0
      enddo
-    endif !if (ptrac(i).gt.ridicule*1e3) then
+    endif !if (ptrac(i).gt.ridicule*1e3) THEN
   enddo !do i=1,ncas_evap_liq
 
@@ -431,8 +428,8 @@
     if (iso_verif_egalite_nostop(( &
 &           zrfl_cas(i)-zqevfl(i)-zrfln_cas(i)),0.0, &
-&          'iso_revap_fisrtilp 314').eq.1) then
-       write(*,*) 'i,zrfl_cas(i),zqevfl(i),zrfln_cas(i)=', &
+&          '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)
-       write(*,*) 'ptrac(i),zrfl_ancien=', &
+       WRITE(*,*) 'ptrac(i),zrfl_ancien=', &
 &           ptrac(i),zrfl_ancien(cas_evap_liq(i))
        stop
@@ -442,6 +439,6 @@
 &         (zrfl_cas(i)), &
 &         ridicule_rain,deltalimtrac, &
-&         'iso_revap_ilp 342').eq.1) then
-       write(*,*) 'i,ptrac(i),zrfl_cas(i)=', &
+&         'iso_revap_ilp 342').eq.1) THEN
+       WRITE(*,*) 'i,ptrac(i),zrfl_cas(i)=', &
 &           i,ptrac(i),zrfl_cas(i)
        stop
@@ -450,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), & 
@@ -457,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), &
@@ -501,13 +498,13 @@
 &           zxt(ixt,cas_evap_liq(i))+( &
 &           fac_fluxtomixratio(i)*Exi(iiso,i)), &
-&           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))
-     write(*,*) 'Exi=',Exi(iiso,i)
-     write(*,*) 'zxt_eau=',zxt( &
+&           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))
+     WRITE(*,*) 'Exi=',Exi(iiso,i)
+     WRITE(*,*) 'zxt_eau=',zxt( &
 &           index_trac(izone,iso_eau),cas_evap_liq(i))
-     write(*,*) 'Exi_eau=',Exi(iso_eau,i)
-     write(*,*) 'fac_ftmr=',fac_fluxtomixratio(i)
-     write(*,*) 'ptrac=',ptrac(i)
+     WRITE(*,*) 'Exi_eau=',Exi(iso_eau,i)
+     WRITE(*,*) 'fac_ftmr=',fac_fluxtomixratio(i)
+     WRITE(*,*) 'ptrac=',ptrac(i)
 !             stop
   endif
@@ -540,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
@@ -561,16 +558,14 @@
 ! #endif ISOTRAC
 
-END IF !if (ncas_evap_liq.gt.0) then
-
+END IF !if (ncas_evap_liq.gt.0) THEN
 ! ** cas evap_glace=3
-IF (ncas_evap_glace.gt.0) then
-
-#ifdef ISOVERIF
-!      write(*,*) ''
-!      write(*,*) 'iso_revap tmp 469: traitement cas evap glace'
-!      write(*,*) 'cas_evap_glace(1),zqev_diag=',
+IF (ncas_evap_glace.gt.0) THEN
+#ifdef ISOVERIF
+!      WRITE(*,*) ''
+!      WRITE(*,*) 'iso_revap tmp 469: traitement cas evap glace'
+!      WRITE(*,*) 'cas_evap_glace(1),zqev_diag=',
 !     :           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( &
@@ -580,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( &
@@ -593,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
       
@@ -613,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
@@ -619,5 +614,5 @@
      zqevfl(i)=zqev_diag_cas(i)/fac_fluxtomixratio(i)
   enddo !do i=1,ncas_evap_glace
-!          write(*,*) 'zqev_diag,fac_fluxtomixratio=',
+!          WRITE(*,*) 'zqev_diag,fac_fluxtomixratio=',
 !     :           zqev_diag(cas_evap_glace(1)),
 !     :           fac_fluxtomixratio(1)
@@ -626,13 +621,13 @@
     CALL iso_verif_noNaN((fac_fluxtomixratio(i)), &
 &            'iso_revap_fisrtilp 763')
-!            write(*,*) 'i,cas_evap_glace(i)=',i,cas_evap_glace(i)
-!            write(*,*) 'zqevfl(i),zrfl_cas(i),zrfln_cas(i)=',
+!            WRITE(*,*) 'i,cas_evap_glace(i)=',i,cas_evap_glace(i)
+!            WRITE(*,*) 'zqevfl(i),zrfl_cas(i),zrfln_cas(i)=',
 !     :           zqevfl(i),zrfl_cas(i),zrfln_cas(i)
-!            write(*,*) 'zqev_diag_cas(i),fac_fluxtomixratio(i)=',
+!            WRITE(*,*) 'zqev_diag_cas(i),fac_fluxtomixratio(i)=',
 !     :         zqev_diag_cas(i),fac_fluxtomixratio(i)  
     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
@@ -640,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) &
@@ -647,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) &
@@ -653,9 +648,8 @@
 &              ,zxtrfln_cas(1,1),zxtnew_cas(1,1),Exi(1,1) &
 &              ,fac_fluxtomixratio(1))
-  endif  !if (frac_sublim.eq.1) then 
-
-#ifdef ISOVERIF
-        !write(*,*) 'ncas_evap_glace=',ncas_evap_glace
-        !write(*,*) 'cas_evap_glace(6)=',cas_evap_glace(6)
+  endif  !if (frac_sublim.eq.1) THEN
+#ifdef ISOVERIF
+        !WRITE(*,*) 'ncas_evap_glace=',ncas_evap_glace
+        !WRITE(*,*) 'cas_evap_glace(6)=',cas_evap_glace(6)
   do i=1,ncas_evap_glace
    do ixt=1,niso
@@ -668,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( &
@@ -679,39 +673,39 @@
 &              zq(cas_evap_glace(i)), &
 &              'iso_revap_fisrtilp 4103',errmax,errmaxrel) &
-&              .eq.1) then
-          write(*,*) 'i,cas_evap_glace(i)=',i,cas_evap_glace(i)
-          write(*,*) 'zq(cas_evap_glace(i))=', &
+&              .eq.1) THEN
+          WRITE(*,*) 'i,cas_evap_glace(i)=',i,cas_evap_glace(i)
+          WRITE(*,*) 'zq(cas_evap_glace(i))=', &
 &                   zq(cas_evap_glace(i))
-          write(*,*) 'zq_cas(i)=',zq_cas(i)
+          WRITE(*,*) 'zq_cas(i)=',zq_cas(i)
           stop
        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
-   !  write(*,*) 'iso_routines tmp 667: i=',i
-   if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) 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
       do i=1,ncas_evap_glace
-        if (zq(i).gt.ridicule) then
-!     write(*,*) 'iso_routines tmp 679a'
-!        write(*,*) 'cas_evap_glace(i)=',cas_evap_glace(i)
+        if (zq(i).gt.ridicule) THEN
+!     WRITE(*,*) 'iso_routines tmp 679a'
+!        WRITE(*,*) 'cas_evap_glace(i)=',cas_evap_glace(i)
            CALL iso_verif_aberrant_encadre((zxtnew_cas(iso_HDO,i))/zq(cas_evap_glace(i)), &
                          'iso_revap_ilp 669')
-!     write(*,*) 'iso_routines tmp 679b'
+!     WRITE(*,*) 'iso_routines tmp 679b'
            CALL iso_verif_O18_aberrant((zxtnew_cas(iso_HDO,i))/zq(cas_evap_glace(i)), &
                      (zxtnew_cas(iso_O18,i))/zq(cas_evap_glace(i)),'iso_revap_ilp 671')
-!     write(*,*) 'iso_routines tmp 679c'
-        endif !if (zq(i).gt.ridicule) then
+!     WRITE(*,*) 'iso_routines tmp 679c'
+        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
-!     write(*,*) 'iso_routines tmp 679d'
+    endif !if ((iso_HDO.gt.0.and.(iso_O18.gt.0) THEN
+!     WRITE(*,*) 'iso_routines tmp 679d'
 #endif
 
   if ((bidouille_anti_divergence).and. &
-&           (iso_eau.gt.0)) then
+&           (iso_eau.gt.0)) THEN
     do i=1,ncas_evap_glace
       zxtrfln_cas(iso_eau,i)=zrfln_cas(i)
@@ -721,5 +715,5 @@
 
 #ifdef ISOVERIF
-  if (iso_eau.gt.0) then
+  if (iso_eau.gt.0) THEN
     do i=1,ncas_evap_glace
     CALL iso_verif_egalite_choix( &
@@ -728,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          
   
@@ -736,6 +730,6 @@
 &       zxtrfl(1,1),zxtrfln(1,1),zxt(1,1),klon)      
 
-!      write(*,*) 'iso_revap tmp 448: traitement cas evap glace traceurs'
-!      write(*,*) 'zqev_diag,fac_fluxtomixratio=',
+!      WRITE(*,*) 'iso_revap tmp 448: traitement cas evap glace traceurs'
+!      WRITE(*,*) 'zqev_diag,fac_fluxtomixratio=',
 !     :           zqev_diag(cas_evap_glace(1)),
 !     :           fac_fluxtomixratio(1)
@@ -743,5 +737,5 @@
 #ifdef ISOTRAC
   do izone=1,ntraceurs_zone
-!          write(*,*) 'iso_revap_ilp 509 tmp: izone=',izone     
+!          WRITE(*,*) 'iso_revap_ilp 509 tmp: izone=',izone
   ! on compresse, mais en plus on séléctionne que la preciip
   ! correspondant à la zone izone. Par contre, la vapeur reste
@@ -759,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) &
@@ -774,5 +768,5 @@
   endif  
   
-!          write(*,*) 'iso_revap_ilp 509 tmp: Exi,zqev_diag_cas=',
+!          WRITE(*,*) 'iso_revap_ilp 509 tmp: Exi,zqev_diag_cas=',
 !     :           Exi(iso_eau,1),zqev_diag_cas(1)
   CALL uncompress_ilp_zone( &
@@ -788,13 +782,13 @@
   ! 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
-!             write(*,*) 'iso_revap_ilp 520 tmp: i=',i
-!             write(*,*) 'zxt=',zxt(iso_eau:ntraciso:3,cas_evap_glace(i))
-!             write(*,*) 'zxt_ancien=',zxt_ancien
+!             WRITE(*,*) 'iso_revap_ilp 520 tmp: i=',i
+!             WRITE(*,*) 'zxt=',zxt(iso_eau:ntraciso:3,cas_evap_glace(i))
+!             WRITE(*,*) 'zxt_ancien=',zxt_ancien
 !     :           (iso_eau:ntraciso:3,cas_evap_glace(i))
      CALL iso_verif_traceur(zxt(1,cas_evap_glace(i)), &
@@ -809,11 +803,10 @@
 !#ifdef ISOTRAC
 
-END IF !if (ncas_evap_glace.gt.0) then
-
+END IF !if (ncas_evap_glace.gt.0) THEN
 #ifdef ISOVERIF          
   ! dernières vérifs pour l'évap
-IF (iso_eau.gt.0) then
+IF (iso_eau.gt.0) THEN
 DO i=1,klon
-IF (zrfl_ancien(i).gt.0.0) then
+IF (zrfl_ancien(i).gt.0.0) THEN
 CALL iso_verif_egalite_choix( &
 &           zxtrfln(iso_eau,i), &
@@ -823,7 +816,7 @@
 &         zxtrfl(iso_eau,i), &
 &         zrfl(i),'iso_revap_fisrtilp 802', &
-&         errmax,errmaxrel).eq.1) then
-      write(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
-      write(*,*) 'zxtrfln(iso_eau,i),zrfln(i)=', &
+&         errmax,errmaxrel).eq.1) THEN
+      WRITE(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
+      WRITE(*,*) 'zxtrfln(iso_eau,i),zrfln(i)=', &
 &           zxtrfln(iso_eau,i),zrfln(i)
       stop  
@@ -831,11 +824,11 @@
 IF (iso_verif_egalite_choix_nostop( &
 &         zxt(iso_eau,i),zq(i), &
-&         'iso_revap_fisrtilp 807',errmax,errmaxrel).eq.1) then
-  write(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
+&         'iso_revap_fisrtilp 807',errmax,errmaxrel).eq.1) THEN
+  WRITE(*,*) 'i,k,trace_cas(i)=',i,k,trace_cas(i)
   stop
 END IF !if (iso_verif_egalite_choix_nostop(
-END IF !if (zrfl_ancien(i).gt.0.0) then
+END IF !if (zrfl_ancien(i).gt.0.0) THEN
 END DO !do i=1,klon
-END IF !if (iso_eau.gt.0) then
+END IF !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC      
 ! grande vérif finale
@@ -851,5 +844,5 @@
     enddo
 END DO !do i=1,klon
-        !write(*,*) 'revap_ilp 814: sortie'
+        !WRITE(*,*) 'revap_ilp 814: sortie'
 #endif       
 #endif          
@@ -909,43 +902,42 @@
 
 ! ca ne marche que si déjà de l'eau dans le sol au départ
-IF (qsol0.lt.ridicule_qsol) then
+IF (qsol0.lt.ridicule_qsol) THEN
   do ixt=1,niso
      xtnu(ixt)=Rsol0(ixt)*qevap
   enddo
 #ifdef ISOVERIF
-    if (iso_HDO.gt.0) then
-!                write(*,*) 'sol_nu 66: deltaDsol(iso_HDO)=',         
+    if (iso_HDO.gt.0) THEN
+!                WRITE(*,*) 'sol_nu 66: deltaDsol(iso_HDO)=',
 !     :           (Rsol(iso_HDO)/tnat(iso_HDO)-1)*1000
-!                write(*,*) 'deltaDevap(iso_HDO)=',(Revap(iso_HDO)/
+!                WRITE(*,*) 'deltaDevap(iso_HDO)=',(Revap(iso_HDO)/
 !     :           tnat(iso_HDO)-1)*1000
-    endif !if (iso_HDO.gt.0) then
-#endif
-  return
-END IF !if (qsol0.lt.ridicule_qsol) then
-
+    endif !if (iso_HDO.gt.0) THEN
+#endif
+  RETURN
+END IF !if (qsol0.lt.ridicule_qsol) THEN
 ! vérif des rapports isotopiques en entrée
 #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
-IF (iso_eau.gt.0) then
+IF (iso_eau.gt.0) THEN
   CALL iso_verif_egalite_choix(Rsol0(iso_eau),1.0, &
 &           'sol_nu 83',errmax,errmaxrel)
   CALL iso_verif_egalite_choix(R1(iso_eau),1.0, &
 &           'sol_nu 56',errmax,errmaxrel)
-END IF !if (iso_eau.gt.0) then
-IF (iso_HDO.gt.0) then
-  if (qsol0.gt.ridicule_qsol*1e2) then   
+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
-       write(*,*) 'qsol0=',qsol0
+&           '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
-END IF  !if (iso_HDO.gt.0) then
+  endif !if (h.gt.0.01) THEN
+END IF  !if (iso_HDO.gt.0) THEN
 #endif
 
@@ -960,5 +952,5 @@
 
 
-IF (f.lt.ridicule) then
+IF (f.lt.ridicule) THEN
   ! il ne reste plus rien après l'évap
   ! -> evap sans frac  
@@ -967,29 +959,28 @@
   enddo
 
-else !if (f.lt.ridicule) then
-
+else !if (f.lt.ridicule) THEN
 ! 2 e cas simple: h=1
-IF (h.gt.0.99) then
-#ifdef ISOVERIF
-  write(*,*) 'sol_nu 102: h=',h
+IF (h.gt.0.99) THEN
+#ifdef ISOVERIF
+  WRITE(*,*) 'sol_nu 102: h=',h
 #endif                    
   do ixt=1,niso
     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
@@ -998,16 +989,15 @@
 &           /(q10+qevap+(qsol0-qevap)*zxtalphal(ixt))
        enddo ! do ixt=1,niso
-     endif !if (ordre1.eq.1) then
-     
-  else !if (qevap.gt.min(L,qsol0)) 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
@@ -1016,8 +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
@@ -1025,33 +1013,33 @@
 &               'iso_evap_sol_nu 121')
   enddo
-        if (iso_eau.gt.0) 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
-           write(*,*) 'L=',L
-           write(*,*) 'Rsol0(iso_eau)=',Rsol0(iso_eau)
-           write(*,*) 'R1(iso_eau)=',R1(iso_eau)
-           write(*,*) 'q10=',q10
-           write(*,*) 'zxtalphal(iso_eau)=',zxtalphal(iso_eau)
+&                  'sol_nu 110',errmax,errmaxrel).eq.1) THEN
+           WRITE(*,*) 'qevap=',qevap
+           WRITE(*,*) 'qsol0=',qsol0
+           WRITE(*,*) 'L=',L
+           WRITE(*,*) 'Rsol0(iso_eau)=',Rsol0(iso_eau)
+           WRITE(*,*) 'R1(iso_eau)=',R1(iso_eau)
+           WRITE(*,*) 'q10=',q10
+           WRITE(*,*) 'zxtalphal(iso_eau)=',zxtalphal(iso_eau)
            stop
          endif
-        endif !if (iso_eau.gt.0) then
-        if (iso_HDO.gt.0) then 
-          if (qevap.gt.ridicule_evap*1800) then
+        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
-              write(*,*) 'qevap=',qevap 
-              write(*,*) 'qsol0=',qsol0
-              write(*,*) 'deltaD(R1)=',deltaD(R1((iso_HDO)))
-              write(*,*) 'deltaD(alpha*R1)=',deltaD &
+&                   'sol_nu 113').eq.1) THEN
+              WRITE(*,*) 'qevap=',qevap
+              WRITE(*,*) 'qsol0=',qsol0
+              WRITE(*,*) 'deltaD(R1)=',deltaD(R1((iso_HDO)))
+              WRITE(*,*) 'deltaD(alpha*R1)=',deltaD &
 &                   (zxtalphal(iso_HDO)*R1((iso_HDO)))
-              write(*,*) 'deltaD(Rsol0)=', &
+              WRITE(*,*) 'deltaD(Rsol0)=', &
 &                   deltaD(Rsol0((iso_HDO)))
-              write(*,*) 'L=',L
-              write(*,*) 'Pveg=',Pveg
+              WRITE(*,*) 'L=',L
+              WRITE(*,*) 'Pveg=',Pveg
               ! on ne plante que si ca donne lieu à des valeurs
               ! aberrante de deltaD1
-              write(*,*) 'deltaD1new=',deltaD((  &
+              WRITE(*,*) 'deltaD1new=',deltaD((  &
 &                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
 &                  /(q10+qevap))
@@ -1061,19 +1049,19 @@
 &                  'sol_nu 1390')
             endif !if (iso_verif_aberrant_nosto
-          endif !if (qevap.gt.ridicule_evap*1800) then
+          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
-             write(*,*) 'h=',h
-             write(*,*) 'qsol0=',qsol0
-             write(*,*) 'deltaD(R1)=',deltaD(R1((iso_HDO)))
-             write(*,*) 'deltaD(alpha*R1)=',deltaD &
+&             qevap,ridicule,1e5,'sol_nu 195').eq.1) THEN
+             WRITE(*,*) 'h=',h
+             WRITE(*,*) 'qsol0=',qsol0
+             WRITE(*,*) 'deltaD(R1)=',deltaD(R1((iso_HDO)))
+             WRITE(*,*) 'deltaD(alpha*R1)=',deltaD &
 &                   (zxtalphal(iso_HDO)*R1((iso_HDO)))
-             write(*,*) 'deltaD(Rsol0)=', &
+             WRITE(*,*) 'deltaD(Rsol0)=', &
 &                   deltaD(Rsol0((iso_HDO)))
-             write(*,*) 'deltaD1new=',deltaD((  &
+             WRITE(*,*) 'deltaD1new=',deltaD((  &
 &                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
 &                  /(q10+qevap))
              
-             if (ordre1.eq.1) then
+             if (ordre1.eq.1) THEN
                  ! l'ordre 2 aurait-il amélioré?
                do ixt=1,niso
@@ -1083,7 +1071,7 @@
 &                    /(q10+qevap+(L-qevap)*zxtalphal(ixt))
                enddo  
-               write(*,*) 'si 2e ordre:deltaDevap=', &
+               WRITE(*,*) 'si 2e ordre:deltaDevap=', &
 &                   deltaD(xtnu2(iso_hdo)/qevap)
-               write(*,*) 'si 2e ordre, deltaD1new=',  &
+               WRITE(*,*) 'si 2e ordre, deltaD1new=',  &
 &                   deltaD((  &
 &                   xtnu2(iso_HDO)+q10*R1(iso_HDO))  &
@@ -1094,21 +1082,20 @@
 &                  /(q10+qevap),'sol_nu 224')
           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
+        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 238')
-          endif !if (qevap(i).gt.ridicule_evap) then
-        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
+          endif !if (qevap(i).gt.ridicule_evap) THEN
+        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
 
 
 ! 3 e cas limite : f=1
-else !if (h.gt.0.99) then
-
-IF (f.gt.0.95) then
+else !if (h.gt.0.99) THEN
+IF (f.gt.0.95) THEN
 #ifdef ISOVERIF          
-!          write(*,*) 'sol_nu 139: f=',f
+!          WRITE(*,*) 'sol_nu 139: f=',f
 #endif          
   do ixt=1,niso
@@ -1133,24 +1120,24 @@
 &               '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  
+    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
-                write(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
-                write(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
-                write(*,*) 'deltaD gama*R1=', &
+&           'sol_nu 154').eq.1) THEN
+                WRITE(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
+                WRITE(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
+                WRITE(*,*) 'deltaD gama*R1=', &
 &                   deltaD(gama(iso_HDO)*R1(iso_HDO))
-                write(*,*) 'f=',f                        
-                write(*,*) 'qevap,L=',qevap,L
-                write(*,*) 'betaprime,h=',betaprime(iso_HDO),h
-                write(*,*) 'alphak,zxtalphal=', &
+                WRITE(*,*) 'f=',f
+                WRITE(*,*) 'qevap,L=',qevap,L
+                WRITE(*,*) 'betaprime,h=',betaprime(iso_HDO),h
+                WRITE(*,*) 'alphak,zxtalphal=', &
 &                           alphak(iso_HDO),zxtalphal(iso_HDO)
                 ! on ne stppe que si deltaD1new devient
                 ! aberrant.
-                write(*,*) 'deltaD1new=',deltaD((  &
+                WRITE(*,*) 'deltaD1new=',deltaD((  &
 &                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
 &                  /(q10+qevap))
@@ -1160,22 +1147,21 @@
 &                  'sol_nu 282')
            endif !if (iso_verif_aberrant_nostop
-        endif !if (qevap.gt.ridicule_evap*1800) then
+        endif !if (qevap.gt.ridicule_evap*1800) THEN
         CALL iso_verif_aberrant_choix(xtnu(iso_HDO), &
 &             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
+    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 307')
-          endif !if (qevap(i).gt.ridicule_evap) then
-        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then 
-#endif
-else !if (f.gt.0.90) then
-
+          endif !if (qevap(i).gt.ridicule_evap) THEN
+        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+#endif
+else !if (f.gt.0.90) THEN
 ! 4e cas simple: si h=0
-IF (h.lt.0.01) then
+IF (h.lt.0.01) THEN
 #ifdef ISOVERIF          
-write(*,*) 'sol_nu 165: h=',h
+WRITE(*,*) 'sol_nu 165: h=',h
 #endif        
 DO ixt=1,niso
@@ -1192,30 +1178,29 @@
 &               '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')
-    endif !if (qevap.gt.ridicule_qsol) then
+    endif !if (qevap.gt.ridicule_qsol) THEN
     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
-
-else !if (h.lt.0.01) then     
-
+       endif !if (qevap(i).gt.ridicule_evap) THEN
+   endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+#endif
+
+else !if (h.lt.0.01) THEN
 ! cas général
 #ifdef ISOVERIF      
-!      write(*,*) 'sol_nu 182: cas général'
+!      WRITE(*,*) 'sol_nu 182: cas général'
 #endif      
 DO ixt=1,niso
@@ -1230,26 +1215,26 @@
 #ifdef ISOVERIF
 DO ixt=1,niso
-!         write(*,*) 'qevap,Rsol0(ixt),f,betaprime(ixt)=',
+!         WRITE(*,*) 'qevap,Rsol0(ixt),f,betaprime(ixt)=',
 !     :         qevap,Rsol0(ixt),f,betaprime(ixt)  
  CALL iso_verif_noNAN(xtnu(ixt), &
 &               'iso_evap_sol_nu 234')
 END DO
-IF (iso_eau.gt.0) then
+IF (iso_eau.gt.0) THEN
   CALL iso_verif_egalite_choix(xtnu(iso_eau),qevap,   &
 &           'sol_nu 185',errmax,errmaxrel)
-END IF !if (iso_eau.gt.0) then
-IF (iso_HDO.gt.0) then
-   if (qevap.gt.ridicule_evap*1800) then
+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
-       write(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
-       write(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
-       write(*,*) 'deltaD gama*R1=', &
+&           'sol_nu 189').eq.1) THEN
+       WRITE(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
+       WRITE(*,*) 'deltaDR1=',deltaD(R1(iso_HDO))
+       WRITE(*,*) 'deltaD gama*R1=', &
 &                   deltaD(gama(iso_HDO)*R1(iso_HDO))
-       write(*,*) 'f=',f
-       write(*,*) 'betaprime=',betaprime(iso_HDO)
+       WRITE(*,*) 'f=',f
+       WRITE(*,*) 'betaprime=',betaprime(iso_HDO)
        ! on ne stppe que si deltaD1new devient
        ! aberrant.
-       write(*,*) 'deltaD1new=',deltaD((  &
+       WRITE(*,*) 'deltaD1new=',deltaD((  &
 &                   xtnu(iso_HDO)+q10*R1(iso_HDO))  &
 &                  /(q10+qevap))
@@ -1259,34 +1244,33 @@
 &                  'sol_nu 321')
      endif !if (iso_verif_aberrant_nostop
-   endif !if (qevap.gt.ridicule_evap*1800) then
+   endif !if (qevap.gt.ridicule_evap*1800) THEN
    CALL iso_verif_aberrant_choix(xtnu(iso_HDO), &
 &             qevap,ridicule,1e5,'sol_nu 354')
-   if (qsol0-qevap.gt.ridicule_qsol*1e2) then
+   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
-       write(*,*) 'qsol0=',qsol0
-       write(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
-       write(*,*) 'deltaD gama*R1=', &
+&         'evap_sol_nu, reste sol aberrant 375').eq.1) THEN
+       WRITE(*,*) 'qsol0=',qsol0
+       WRITE(*,*) 'deltaDRsol0=',deltaD(Rsol0(iso_HDO))
+       WRITE(*,*) 'deltaD gama*R1=', &
 &                   deltaD(gama(iso_HDO)*R1(iso_HDO))
-       write(*,*) 'deltaDevap=',deltaD(xtnu(iso_HDO)/qevap)
-       write(*,*) 'f,h=',f,h
+       WRITE(*,*) 'deltaDevap=',deltaD(xtnu(iso_HDO)/qevap)
+       WRITE(*,*) 'f,h=',f,h
        stop
      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
+ 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 419')
-     endif !if (qevap(i).gt.ridicule_evap) then
-  endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
-#endif
-END IF !if (h.lt.0.01) then
+     endif !if (qevap(i).gt.ridicule_evap) THEN
+  endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+#endif
+END IF !if (h.lt.0.01) THEN
 END IF ! if f>0.9
 END IF ! if h>0.99
-END IF !if (f.lt.ridicule) then
-
+END IF !if (f.lt.ridicule) THEN
 #ifdef ISOVERIF
 DO ixt=1,niso
@@ -1294,17 +1278,17 @@
 &               'iso_evap_sol_nu 194')
 END DO
-!       write(*,*) 'sol_nu tmp 252: xtnu(iso_eau),qevap=',
+!       WRITE(*,*) 'sol_nu tmp 252: xtnu(iso_eau),qevap=',
 !     :           xtnu(iso_eau),qevap
-IF (iso_eau.gt.0) then
+IF (iso_eau.gt.0) THEN
   CALL iso_verif_egalite_choix(xtnu(iso_eau),qevap,   &
 &           '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
+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
      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       
 
@@ -1379,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
@@ -1387,12 +1371,12 @@
 
 #ifdef ISOVERIF
-       if (pt.gt.pxtice) 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)=',
+                  .eq.1) THEN
+!             WRITE(*,*) 'kt,pt=',kt,pt
+!             WRITE(*,*) 'talph1(kt),talph2(kt),talph3(kt)=',
 !     :           talph1(kt),talph2(kt),talph3(kt)
            endif
-       endif !if (pt.gt.pxtice) then
+       endif !if (pt.gt.pxtice) THEN
 #endif       
        pxtfra=max(min(pxtfra,100.0),0.0)
@@ -1402,21 +1386,21 @@
 !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
-           write(*,*) 'iso_fractcal 1404: non prévu: kt=',kt
+           WRITE(*,*) 'iso_fractcal 1404: non prévu: kt=',kt
 #ifdef ISOVERIF
            stop
@@ -1425,12 +1409,12 @@
 
 #ifdef ISOVERIF       
-       if (pt.lt.pxtmelt) 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)=',
+                 .eq.1) THEN
+!              WRITE(*,*) 'kt,pt=',kt,pt
+!              WRITE(*,*) 'talps1(kt),talps2(kt)=',
 !     &                   talps1(kt),talps2(kt)
            endif
-       endif !if (pt.lt.pxtmelt) then
+       endif !if (pt.lt.pxtmelt) THEN
 #endif       
        pfraice=max(min(pfraice,100.0),0.0)
@@ -1440,24 +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
-
+         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
-!            write(*,*) 'kt,pt=',kt,pt
-!            write(*,*) 'ZSATVAL,tdifrel(kt)=',ZSATVAL,tdifrel(kt)
+                 .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)
@@ -1504,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
@@ -1512,13 +1495,13 @@
 
 #ifdef ISOVERIF
-       if (pt.gt.pxtice) 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)=',
+                  .eq.1) THEN
+!             WRITE(*,*) 'kt,pt=',kt,pt
+!             WRITE(*,*) 'talph1(kt),talph2(kt),talph3(kt)=',
 !     &           talph1(kt),talph2(kt),talph3(kt)
            endif
-       endif !if (pt.gt.pxtice) then
-       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) then
+       endif !if (pt.gt.pxtice) THEN
+       if ((iso_eau.gt.0).and.(kt.eq.iso_eau)) THEN
            CALL iso_verif_egalite(pxtfra,1.0,'iso_fractcal_phase 51')
        endif
@@ -1574,18 +1557,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
-           write(*,*) 'iso_fractcal 1676: non prévu: kt=',kt
+           WRITE(*,*) 'iso_fractcal 1676: non prévu: kt=',kt
 #ifdef ISOVERIF
            stop
@@ -1594,15 +1577,15 @@
 
 #ifdef ISOVERIF       
-       if (pt.lt.pxtmelt) 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)=',
+                 .eq.1) THEN
+!              WRITE(*,*) 'kt,pt=',kt,pt
+!              WRITE(*,*) 'talps1(kt),talps2(kt)=',
 !     :                   talps1(kt),talps2(kt)
            endif
-       endif !if (pt.lt.pxtmelt) then
+       endif !if (pt.lt.pxtmelt) THEN
 #endif       
        pfraice=max(min(pfraice,alpha_max),0.0)
-!       write(*,*) 'fractcalk tmp 130: kt,pfraice,fac_coeff_eq17_ice=',
+!       WRITE(*,*) 'fractcalk tmp 130: kt,pfraice,fac_coeff_eq17_ice=',
 !     :            kt,pfraice,fac_coeff_eq17_ice
 
@@ -1611,26 +1594,25 @@
 !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
-
+         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
-!            write(*,*) 'kt,pt=',kt,pt
-!            write(*,*) 'ZSATVAL,tdifrel(kt)=',ZSATVAL,tdifrel(kt)
+                 .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)
-!       write(*,*) 'fractcalk tmp 130: kt,pfraice=',kt,pfraice
+!       WRITE(*,*) 'fractcalk tmp 130: kt,pfraice=',kt,pfraice
 
       END SUBROUTINE  fractcalk_glace
@@ -1689,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) &
@@ -1704,9 +1686,9 @@
 #ifdef ISOVERIF
        do i=1,n
-        if (pt(i).gt.pxtice) then
+        if (pt(i).gt.pxtice) THEN
            if (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
-                 'iso_fractcal 33').eq.1) then
+                 'iso_fractcal 33').eq.1) THEN
            endif
-        endif !if (pt(i).gt.pxtice) then
+        endif !if (pt(i).gt.pxtice) THEN
        enddo
 #endif     
@@ -1720,29 +1702,29 @@
 !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.
          enddo !do i=1,n 
        else
-           write(*,*) 'iso_fractcal 1734: non prévu: ixt=',ixt
+           WRITE(*,*) 'iso_fractcal 1734: non prévu: ixt=',ixt
 !#ifdef ISOVERIF
            CALL abort_physic('isotopes_routines_mod', 'iso_fractcal 1734', 1)
@@ -1752,9 +1734,9 @@
 #ifdef ISOVERIF  
        do i=1,n     
-         if (pt(i).lt.pxtmelt) then
+         if (pt(i).lt.pxtmelt) THEN
            if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
-                 'iso_fractcal 55').eq.1) then
+                 'iso_fractcal 55').eq.1) THEN
            endif
-         endif !if (pt(i).lt.pxtmelt) then
+         endif !if (pt(i).lt.pxtmelt) THEN
        enddo !do i=1,n
 #endif   
@@ -1768,25 +1750,24 @@
 !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) &
               *(ZSATVAL(i)/(1.+pfraice(ixt,i)*(ZSATVAL(i)-1.) &
               *tdifrel(ixt)))
-          endif !if (pt(i).lt.pxtmelt) then
+          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
-!            write(*,*) 'ixt,pt(i)=',ixt,pt(i)
-!            write(*,*) 'ZSATVAL,tdifrel(ixt)=',ZSATVAL,tdifrel(ixt)
+                '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, &
@@ -1795,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
@@ -1852,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) &
@@ -1867,9 +1848,9 @@
 #ifdef ISOVERIF
        do i=1,n
-        if (pt(i).gt.pxtice) then
+        if (pt(i).gt.pxtice) THEN
            if (iso_verif_noNAN_nostop(pxtfra(ixt,i), &
-                 'iso_fractcal 33').eq.1) then
+                 'iso_fractcal 33').eq.1) THEN
            endif
-        endif !if (pt(i).gt.pxtice) then
+        endif !if (pt(i).gt.pxtice) THEN
        enddo
 #endif     
@@ -1938,29 +1919,29 @@
 !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.
          enddo !do i=1,n 
        else
-           write(*,*) 'iso_fractcal 1954: non prévu: ixt=',ixt
+           WRITE(*,*) 'iso_fractcal 1954: non prévu: ixt=',ixt
 !#ifdef ISOVERIF
           CALL abort_physic('isotopes_routines_mod', 'iso_fractcal 1954', 1)
@@ -1970,9 +1951,9 @@
 #ifdef ISOVERIF  
        do i=1,n     
-         if (pt(i).lt.pxtmelt) then
+         if (pt(i).lt.pxtmelt) THEN
            if (iso_verif_noNAN_nostop(pfraice(ixt,i), &
-                 'iso_fractcal 55').eq.1) then
+                 'iso_fractcal 55').eq.1) THEN
            endif
-         endif !if (pt(i).lt.pxtmelt) then
+         endif !if (pt(i).lt.pxtmelt) THEN
        enddo !do i=1,n
 #endif   
@@ -1986,30 +1967,29 @@
 !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) &
               *(ZSATVAL(i)/(1.+pfraice(ixt,i)*(ZSATVAL(i)-1.) &
               *tdifrel(ixt)))
-          endif !if (pt(i).lt.pxtmelt) then
+          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
-!            write(*,*) 'ixt,pt(i)=',ixt,pt(i)
-!            write(*,*) 'ZSATVAL,tdifrel(ixt)=',ZSATVAL,tdifrel(ixt)
+                '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
@@ -2060,5 +2040,5 @@
 ! verif
 #ifdef ISOVERIF
-IF (iso_eau.gt.0) then
+IF (iso_eau.gt.0) THEN
   CALL iso_verif_egalite_choix((qsol(i)), &
 &           (xtsol(iso_eau,i)), &
@@ -2066,16 +2046,16 @@
   CALL iso_verif_egalite_choix(q1lay(i),xt1lay(iso_eau,i), &
 &           'iso_surf>calcul_Rsol 387',errmax,errmaxrel)
-!      write(*,*) 'qsol(i)=',qsol(i)
-!      write(*,*) 'xtsol(4,i)=',xtsol(4,i)
-END IF !if (iso_eau.gt.0) then
-IF (iso_HDO.gt.0) then
-  if (qsol(i).gt.ridicule_qsol*1e2) then
+!      WRITE(*,*) 'qsol(i)=',qsol(i)
+!      WRITE(*,*) 'xtsol(4,i)=',xtsol(4,i)
+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(( &
 &           xtsol(iso_HDO,i)/qsol(i))/faccond, &
 &           'iso_surf>calcul_Rsol 301')
- endif ! 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
+ endif ! 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( &
 &           (xtsol(iso_O17,i) &
@@ -2083,9 +2063,9 @@
 &           /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
+END IF !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
 ! end verif 
 
-IF (qsol(i).gt.ridicule_qsol) then
+IF (qsol(i).gt.ridicule_qsol) THEN
 DO ixt=1,niso
     Rsol(ixt)=xtsol(ixt,i)/qsol(i)             
@@ -2097,36 +2077,36 @@
     CALL iso_verif_noNAN(Rsol(ixt),'iso_surf>calcul_Rsol 3191')
   enddo !do ixt=1,niso
-  if (iso_eau.gt.0) then
+  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
-      write(*,*) 'xtsol(ixt,i),qsol(i),ridicule_qsol=', &
+&           .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 (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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
 ! end verif 
 
-else !if (qsol(i).gt.ridicule_rain) then
-#ifdef ISOVERIF
- 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)
+else !if (qsol(i).gt.ridicule_rain) THEN
+#ifdef ISOVERIF
+ 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
 #endif         
- if (q1lay(i).gt.ridicule) then
+ if (q1lay(i).gt.ridicule) THEN
        ! on suppose que
        ! deltaDsol=deltaDprecip~deltaDcond(INB)~deltaDNK
@@ -2134,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) 
@@ -2145,24 +2125,24 @@
 &                   '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
+           endif !if (iso_eau.gt.0) 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
+               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
                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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
           ! end verif
 
-     else !if (t1lay(i).ge.0.0) then   
+     else !if (t1lay(i).ge.0.0) THEN
           do ixt=1,niso
             Rsol(ixt)=zxtalphai(ixt)*xt1lay(ixt,i)/q1lay(i)  
@@ -2175,32 +2155,30 @@
 &                   '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
+            endif !if (iso_eau.gt.0) 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
+              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
                 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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
               ! end verif
-     endif !if (t1lay(i).ge.0.0) then   
-
- else !if (q1lay(i).gt.ridicule) then
-        write(*,*) 'warning: iso_surf>calcul_Rsol 3209'
-        write(*,*) 'qsol(i)=',qsol(i),' mais evap(i)=',evap(i)
-        write(*,*) 'q1lay(i)=',q1lay(i)
+     endif !if (t1lay(i).ge.0.0) THEN
+ else !if (q1lay(i).gt.ridicule) THEN
+        WRITE(*,*) 'warning: iso_surf>calcul_Rsol 3209'
+        WRITE(*,*) 'qsol(i)=',qsol(i),' mais evap(i)=',evap(i)
+        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 (qsol(i).gt.ridicule_rain) then
-
+ endif !if (q1lay(i).gt.ridicule) THEN
+END IF !if (qsol(i).gt.ridicule_rain) THEN
 ! verif
 #ifdef ISOVERIF
@@ -2210,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
+ 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 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
+    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
       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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
           ! end verif
@@ -2273,31 +2251,31 @@
 !#endif
 
-!      write(*,*) 'iso_surf>rosée 527: entrée dans rosée'
-IF (evap(i).eq.0.0) then
+!      WRITE(*,*) 'iso_surf>rosée 527: entrée dans rosée'
+IF (evap(i).eq.0.0) THEN
 #ifdef ISOVERIF          
-write(*,*) 'iso_surf>rosée 528: evap(i)=',evap(i)
+WRITE(*,*) 'iso_surf>rosée 528: evap(i)=',evap(i)
 #endif        
 DO ixt=1,niso
   xtevap(ixt,i)=0.0
 END DO
-return
+RETURN
 END IF
 
-IF (q1lay(i).gt.ridicule) then
+IF (q1lay(i).gt.ridicule) THEN
      ! 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')
-         endif   !if (iso_HDO.gt.0) then
+         endif   !if (iso_HDO.gt.0) THEN
 #endif
      ! end verif R1   
 
 !             qevap=-evap(i)*dtime/Mair ! en kg d'eau par kg d'air
-!             write(*,*) 'iso_surf>rosé 554: qevap=',qevap
-!             write(*,*) 'evap(i),dtime,Mair,q1lay(i)=',
+!             WRITE(*,*) 'iso_surf>rosé 554: qevap=',qevap
+!             WRITE(*,*) 'evap(i),dtime,Mair,q1lay(i)=',
 !     :                   evap(i),dtime,Mair,q1lay(i)            
-  if (tsurf(i).ge.t_coup) then
-    !write(*,*) 'iso_surf>iso_rosee_givre 3181: tsurf(i)=',tsurf(i)
+  if (tsurf(i).ge.t_coup) THEN
+    !WRITE(*,*) 'iso_surf>iso_rosee_givre 3181: tsurf(i)=',tsurf(i)
     do ixt=1,niso
        ! methode 1: condensation à l'équilibre, approx 1er ordre
@@ -2309,8 +2287,8 @@
 !     :           qevap,tsurf(i),0.0,zxtice,zxtliq)    
 !               xtevap(ixt,i)=-zxtliq/dtime*Mair       
-!                write(*,*) 'iso_surf>rosée 545: qevap=', qevap
-!                write(*,*) 'q1lay(i)=',q1lay(i)
-!                write(*,*) 'zxtice=',zxtice
-!                write(*,*) 'zxtliq=',zxtliq               
+!                WRITE(*,*) 'iso_surf>rosée 545: qevap=', qevap
+!                WRITE(*,*) 'q1lay(i)=',q1lay(i)
+!                WRITE(*,*) 'zxtice=',zxtice
+!                WRITE(*,*) 'zxtliq=',zxtliq
         
     enddo !do ixt=1,niso
@@ -2327,10 +2305,10 @@
         CALL iso_verif_noNAN(xtevap(ixt,i),'iso_surf>rosée 557')
       enddo !do ixt=1,niso  
-      if (iso_HDO.gt.0) then            
-!                write(*,*) 'iso_surf>rosée 554: deltaD1=',
+      if (iso_HDO.gt.0) THEN
+!                WRITE(*,*) 'iso_surf>rosée 554: deltaD1=',
 !     :                   deltaD(xt1lay(iso_HDO,i)/q1lay(i))
-!                write(*,*) 'deltaDcond=',
+!                WRITE(*,*) 'deltaDcond=',
 !     :                   deltaD(xtevap(iso_HDO,i)/evap(i))
-      endif ! if (iso_HDO.gt.0)) then 
+      endif ! if (iso_HDO.gt.0)) THEN
 #ifdef ISOTRAC
       CALL iso_verif_tracnps(xtevap(1,i), &
@@ -2339,6 +2317,6 @@
 #endif
       
-  else !if (tsurf(i).ge.t_coup) then
-    !write(*,*) 'iso_surf>iso_rosee_givre 3186: tsurf(i)=',tsurf(i)
+  else !if (tsurf(i).ge.t_coup) THEN
+    !WRITE(*,*) 'iso_surf>iso_rosee_givre 3186: tsurf(i)=',tsurf(i)
     do ixt=1,niso
     ! methode 1: condensation à l'équilibre, approx 1er ordre
@@ -2350,8 +2328,8 @@
 !     :           qevap,tsurf(i),1.0,zxtice,zxtliq)           
 !                xtevap(ixt,i)=-zxtice/dtime*Mair
-!                write(*,*) 'iso_surf>rosée 558: qevap=',qevap
-!                write(*,*) 'q1lay(i)=',q1lay(i)
-!                write(*,*) 'zxtice=',zxtice
-!                write(*,*) 'zxtliq=',zxtliq
+!                WRITE(*,*) 'iso_surf>rosée 558: qevap=',qevap
+!                WRITE(*,*) 'q1lay(i)=',q1lay(i)
+!                WRITE(*,*) 'zxtice=',zxtice
+!                WRITE(*,*) 'zxtliq=',zxtliq
 
     enddo !do ixt=1,niso  
@@ -2365,16 +2343,16 @@
 
 #ifdef ISOVERIF            
-    if (iso_HDO.gt.0) then
-!             write(*,*) 'iso_surf>rosée 571: deltaD1=',
+    if (iso_HDO.gt.0) THEN
+!             WRITE(*,*) 'iso_surf>rosée 571: deltaD1=',
 !     :                   deltaD(xt1lay(iso_HDO,i)/q1lay(i))
-!             write(*,*) 'deltaDcond=',
+!             WRITE(*,*) 'deltaDcond=',
 !     :                   deltaD(xtevap(iso_HDO,i)/evap(i))    
-    endif  !if (iso_HDO.gt.0) then
-    if (iso_eau.gt.0) then
+    endif  !if (iso_HDO.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)
       CALL iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
 &           'iso_surf>iso_rosee_givre 622',errmax,errmaxrel)
-    endif !if (iso_eau.gt.0) then
+    endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
       CALL iso_verif_tracnps(xtevap(1,i), &
@@ -2382,7 +2360,5 @@
 #endif              
 #endif            
-  endif !if (tsurf(i).ge.0.0) then 
-
-  
+  endif !if (tsurf(i).ge.0.0) THEN
   ! verif   
 #ifdef ISOVERIF
@@ -2393,42 +2369,41 @@
 #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                      
+    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    
-                write(*,*) 'zxtalphai(iso_HDO)=',zxtalphai(iso_HDO)
-                write(*,*) 'deltaD1eff=',deltaD(xt1lay(iso_HDO,i)/q1lay(i))
-                write(*,*) 'tsurf(i)=',tsurf(i)
-                write(*,*) 'q1lay(i)=',q1lay(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))
+                WRITE(*,*) 'tsurf(i)=',tsurf(i)
+                WRITE(*,*) 'q1lay(i)=',q1lay(i)
                 !stop  
            endif !if (iso_verif_aberrant_nostop
-      endif  !if (iso_HDO.gt.0) then  
-      if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
+      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) &
 &            /evap(i),xtevap(iso_O18,i) &
-&            /evap(i),'iso_surf>iso_rosee_givre 713').eq.1) then
-          write(*,*) 'tsurf(i)-t_coup=',tsurf(i)-t_coup
-          write(*,*) 'deltaO18, O17excess, 1lay', &
+&            /evap(i),'iso_surf>iso_rosee_givre 713').eq.1) THEN
+          WRITE(*,*) 'tsurf(i)-t_coup=',tsurf(i)-t_coup
+          WRITE(*,*) 'deltaO18, O17excess, 1lay', &
 &                  deltaO(xt1lay(iso_O18,i)/q1lay(i)),o17excess( &
 &                  xt1lay(iso_O17,i)/q1lay(i), &
 &                  xt1lay(iso_O18,i)/q1lay(i)) 
-          write(*,*) 'zxtalphai(:)=',zxtalphai(:)
+          WRITE(*,*) 'zxtalphai(:)=',zxtalphai(:)
           stop
         endif
-      endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
-    endif !if (evap(i).gt.ridicule_rain) then
+      endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
+    endif !if (evap(i).gt.ridicule_rain) THEN
 #endif
   ! end verif
 
-else !if (q1lay(i).gt.0) then
-    write(*,*) 'iso_surf>iso_rosee_givre 3189: evap=',evap(i)
-    write(*,*) 'q1lay(i)=',q1lay(i)
+else !if (q1lay(i).gt.0) THEN
+    WRITE(*,*) 'iso_surf>iso_rosee_givre 3189: evap=',evap(i)
+    WRITE(*,*) 'q1lay(i)=',q1lay(i)
     CALL abort_physic('isotopes_routines_mod', 'iso_surf 2416', 1)
-END IF !if (q1lay(i).gt.0) then
-
+END IF !if (q1lay(i).gt.0) THEN
 END SUBROUTINE  iso_rosee_givre
 
@@ -2559,15 +2534,15 @@
 #endif     
 #ifdef ISOVERIF
-!        write(*,*) 'stewart_explicite 50: entrée'
+!        WRITE(*,*) 'stewart_explicite 50: entrée'
 DO il=1,ncas
 IF (iso_verif_egalite_nostop(( &
 &           Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
-&          'stewart_explicite 37' ).eq.1) then
-  write(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
+&          'stewart_explicite 37' ).eq.1) THEN
+  WRITE(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
 &          il,Pqisup(il),Eqi(il),Pqiinf(il) 
   CALL abort_physic('isotopes_routines_mod', 'stewart 2554', 1)
 END IF !if (iso_verif_egalite
 END DO !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((Pqisup(il)), &
@@ -2579,8 +2554,8 @@
 &          'stewart_explicite 58',errmax,errmaxrel)
    enddo !do il=1,ncas 
- 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
  
-!          write(*,*) 'stewart_explicite 88: Pqisup=',Pqisup
+!          WRITE(*,*) 'stewart_explicite 88: Pqisup=',Pqisup
  do il=1,ncas 
   Pqisup(il)=max(Pqisup(il),0.0)
@@ -2597,9 +2572,9 @@
 DO il=1,ncas ! ******************************
 
-!        write(*,*) 'stewart_explicite 78: il=',il
-!        write(*,*) 'stewart_explicite 112: Pqisup=',Pqisup
+!        WRITE(*,*) 'stewart_explicite 78: il=',il
+!        WRITE(*,*) 'stewart_explicite 112: Pqisup=',Pqisup
 !****** traitement rapide du cas sans pluie:
-IF (Pqisup(il).lt.ridicule**2) then
-!            write(*,*) 'stewart_explicit 96: cas pas de goutte'
+IF (Pqisup(il).lt.ridicule**2) THEN
+!            WRITE(*,*) 'stewart_explicit 96: cas pas de goutte'
     ! pas de pluie, pas de Pqiinf, pas de changement de vap
     ! cam verif
@@ -2608,10 +2583,10 @@
 #ifdef ISOVERIF
     if ((abs(Pqiinf(il)).gt.ridicule) &
-&            .or.(abs(Eqi(il)).gt.ridicule)) then
-        write(*,*) 'stewart_explicite 39'
-        write(*,*) 'Pqisup=',Pqisup(il)
-        write(*,*) 'Eqi=',Eqi(il)
-        write(*,*) 'Eqi*fac_ftmr=',Eqi(il)*fac_ftmr(il)
-        write(*,*) 'Pqiinf=',Pqiinf(il)
+&            .or.(abs(Eqi(il)).gt.ridicule)) THEN
+        WRITE(*,*) 'stewart_explicite 39'
+        WRITE(*,*) 'Pqisup=',Pqisup(il)
+        WRITE(*,*) 'Eqi=',Eqi(il)
+        WRITE(*,*) 'Eqi*fac_ftmr=',Eqi(il)*fac_ftmr(il)
+        WRITE(*,*) 'Pqiinf=',Pqiinf(il)
         stop
     endif     !if ((abs(Pqiinf).gt.ridicule)  
@@ -2621,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
@@ -2628,9 +2603,9 @@
         ! 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)  
            enddo
-        else !if (qp0.gt.ridicule) then
+        else !if (qp0.gt.ridicule) THEN
            ! il n'y a pas encore de vapeur dans le ddft. On est
            ! très embétté, mais on se dit que le ddft sera
@@ -2639,13 +2614,13 @@
            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   !if (qp0.gt.ridicule) then
+        endif   !if (qp0.gt.ridicule) THEN
         do ixt=1,niso
          Exi(ixt,il)=Rb0(ixt,il)*Eqi(il)
          xtnew(ixt,il)=xtp0(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
         enddo ! do ixt=1,niso
-    else !if (abs(Eqi*fac_ftmr).gt.ridicule) then
+    else !if (abs(Eqi*fac_ftmr).gt.ridicule) THEN
         ! ça va, tout est logique, tous les flux d'eau sont nuls
         do ixt=1,niso
@@ -2653,5 +2628,5 @@
           Exi(ixt,il)=0.0
         enddo !do ixt=1,niso
-    endif !if (abs(Eqi*fac_ftmr).gt.ridicule) then
+    endif !if (abs(Eqi*fac_ftmr).gt.ridicule) THEN
 #ifdef ISOVERIF
     do ixt=1,niso
@@ -2661,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)), &
@@ -2674,7 +2649,7 @@
 &                (qp0(il)+Eqi(il)*fac_ftmr(il)), &
 &                'stewart_explicite 218',errmax*10,errmaxrel*50) 
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
        if ((iso_HDO.gt.0).and. &
-&           (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule)) then
+&           (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule)) THEN
          CALL iso_verif_aberrant(( &
 &                   xtnew(iso_HDO,il)/(qp0(il)+Eqi(il) &
@@ -2683,6 +2658,5 @@
 
 #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)
@@ -2695,6 +2669,6 @@
 ! 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
-!            write(*,*) 'stewart_explicite 137: cas pas d''évap'
+IF ((Eqi(il)*fac_ftmr(il).lt.ridicule).and.(h(il).lt.0.99)) THEN
+!            WRITE(*,*) 'stewart_explicite 137: cas pas d''évap'
 
     do ixt=1,niso
@@ -2714,5 +2688,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)), &
@@ -2723,31 +2697,31 @@
 &              (Eqi(il)*fac_ftmr(il)), &
 &              'stewart_explicit 283',errmax*10,errmaxrel*10) &
-&              .eq.1) then
-        write(*,*) 'il=',il
-        write(*,*) 'Eqi(il)=',Eqi(il)
-        write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
+&              .eq.1) THEN
+        WRITE(*,*) 'il=',il
+        WRITE(*,*) 'Eqi(il)=',Eqi(il)
+        WRITE(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
         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 (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
             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
+      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) 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( &
+    endif !if (iso_HDO.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( &
 &               (xtnew(iso_HDO,il)/(qp0(il) &
 &               +Eqi(il)*fac_ftmr(il))))
@@ -2756,10 +2730,9 @@
      ! 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)
 m(il)=max(Pqiinf(il)*deltaP(il)/wt(il),0.0)      
-IF (qp0(il).gt.ridicule*1e-3)  then
+IF (qp0(il).gt.ridicule*1e-3)  THEN
   do ixt=1,niso
    Rb0(ixt,il)=xtp0(ixt,il)/qp0(il)
@@ -2769,20 +2742,20 @@
    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
 END IF
-IF (Pqisup(il).gt.ridicule*1e-3) then
+IF (Pqisup(il).gt.ridicule*1e-3) THEN
   do ixt=1,niso  
    Rl0(ixt,il)=Pxtisup(ixt,il)/Pqisup(il)
   enddo !do ixt=1,niso 
-else ! if (Pqisup(il).gt.ridicule*1e-3) then
+else ! if (Pqisup(il).gt.ridicule*1e-3) THEN
   do ixt=1,niso  
    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
-END IF ! if (Pqisup(il).gt.ridicule*1e-3) then
+END IF ! if (Pqisup(il).gt.ridicule*1e-3) THEN
 f(il)=m(il)/m0(il)    
 ! verifs
@@ -2794,5 +2767,5 @@
   CALL iso_verif_positif(1.0-(f(il)), &
 &        'stewart_explicite 373')        
-!          write(*,*) 'il,m0(il),m(il)=', il,m0(il),m(il)   
+!          WRITE(*,*) 'il,m0(il),m(il)=', il,m0(il),m(il)
   CALL iso_verif_positif((m0(il))- &
 &           (m(il)),'stewart explicite 123') 
@@ -2809,9 +2782,9 @@
 &          'stewart_explicit 357').eq.1).or.  &
 &          (iso_verif_noNaN_nostop((Rb0(ixt,il)), &
-&          'stewart_explicit 359').eq.1)) then
-    write(*,*) 'Pxtisup(ixt,il)=',Pxtisup(ixt,il)
-    write(*,*) 'Pqisup(il)',Pqisup(il)
-    write(*,*) 'xtp0(ixt,il)=',xtp0(ixt,il)
-    write(*,*) 'qp0(il)=',qp0(il)
+&          'stewart_explicit 359').eq.1)) THEN
+    WRITE(*,*) 'Pxtisup(ixt,il)=',Pxtisup(ixt,il)
+    WRITE(*,*) 'Pqisup(il)',Pqisup(il)
+    WRITE(*,*) 'xtp0(ixt,il)=',xtp0(ixt,il)
+    WRITE(*,*) 'qp0(il)=',qp0(il)
     stop
   endif !if ((iso_verif_noNaN_nostop
@@ -2819,5 +2792,5 @@
 #endif              
 #ifdef ISOVERIF
-  if (iso_eau.gt.0) then
+  if (iso_eau.gt.0) THEN
     CALL iso_verif_egalite_choix( &
 &           (xtp0(iso_eau,il)), &
@@ -2827,6 +2800,6 @@
 &           (Rb0(iso_eau,il)),1.0, &
 &           'stewart_explicit 136', &
-&           errmax*10,errmaxrel*10).eq.1) then
-       write(*,*) 'xtp0,qp0,Rb0=', &
+&           errmax*10,errmaxrel*10).eq.1) THEN
+       WRITE(*,*) 'xtp0,qp0,Rb0=', &
 &           xtp0(iso_eau,il),qp0(il),Rb0(iso_eau,il)
        stop
@@ -2837,14 +2810,14 @@
     if (iso_verif_egalite_choix_nostop( &
 &           (Rl0(iso_eau,il)),1.0, &
-&        'stewart_explicit 209',errmax,errmaxrel).eq.1) then
-      write(*,*) 'Pxtisup(iso_eau,il),Pqisup=', &
+&        'stewart_explicit 209',errmax,errmaxrel).eq.1) THEN
+      WRITE(*,*) 'Pxtisup(iso_eau,il),Pqisup=', &
 &                   Pxtisup(iso_eau,il),Pqisup(il)
       stop
     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 !if (iso_HDO.gt.0) THEN
   endif !(iso_eau.gt.0)
 #endif
@@ -2853,6 +2826,6 @@
         
 ! **** cas où m=0 <-> f=0
-IF ((f(il).lt.1e-9).or.(Pqiinf(il).lt.ridicule/10.)) then
-    !write(*,*) 'stewart_explicit 137: cas f=0: il=',il
+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 
     Pxtiinf(ixt,il)=0.0 ! plus rien ne ressors           
@@ -2874,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)), &
@@ -2887,24 +2860,23 @@
 &                  (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
-
+      endif !if (Pqiinf.gt.ridicule) THEN
       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
-                write(*,*) 'xtnew=',xtnew(iso_eau,il)
-                write(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
-                write(*,*) 'Exi=',Exi(iso_eau,il)
-                write(*,*) 'Eqi(il)=',Eqi(il)
-                write(*,*) 'xtp0=',xtp0(iso_eau,il), &
+&                           .eq.1) THEN
+                WRITE(*,*) 'xtnew=',xtnew(iso_eau,il)
+                WRITE(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
+                WRITE(*,*) 'Exi=',Exi(iso_eau,il)
+                WRITE(*,*) 'Eqi(il)=',Eqi(il)
+                WRITE(*,*) 'xtp0=',xtp0(iso_eau,il), &
 &                     'qp0=',qp0(il)
-                write(*,*) 'Pxtisup=',Pxtisup(iso_eau,il), &
+                WRITE(*,*) 'Pxtisup=',Pxtisup(iso_eau,il), &
 &                   ' Pqisup=',pqisup(il)
-                write(*,*) 'Pxtiinf=',Pxtiinf(iso_eau,il), &
+                WRITE(*,*) 'Pxtiinf=',Pxtiinf(iso_eau,il), &
 &                   ' Pqiinf=',pqiinf(il)
                 stop
@@ -2915,26 +2887,24 @@
              !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_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
+       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 420')
-       endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+       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
-         write(*,*) 'stewart_explicit 442: tout se réévapore'
-         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
+     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), &
 &                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
      endif
 #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))
@@ -2946,5 +2916,5 @@
 ! 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
+&           (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)) &
@@ -2961,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)
@@ -2982,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)), &
@@ -2998,37 +2968,37 @@
 &                  (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 (Pqiinf.gt.ridicule) THEN
      endif    !if (iso_eau.gt.0).and.(ixt.eq.iso_eau)  
       
-     if (iso_HDO.gt.0) 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( &
+&                ridicule_rain,deltalim_snow,'stewart_explicite 248').eq.1) THEN
+             WRITE(*,*) 'cas reeq totale, il=',il
+             WRITE(*,*) 'deltaDl0=',deltaD( &
 &                   (Rl0(iso_hdo,il)))
-             write(*,*) 'deltaDb0=',deltaD( &
+             WRITE(*,*) 'deltaDb0=',deltaD( &
 &                   (Rb0(iso_hdo,il)))
-             write(*,*) 'deltaDb=',deltaD( & 
+             WRITE(*,*) 'deltaDb=',deltaD( &
 &                   (Rb(iso_hdo,il)))
              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) 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), &
+     endif  !if (iso_HDO.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), &
 &                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
-         write(*,*) 'deltaDv0,l0=',deltaD( &
+         WRITE(*,*) 'deltaDv0,l0=',deltaD( &
 &                   (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
@@ -3079,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)), &
@@ -3092,79 +3062,78 @@
 &                (Eqi(il)*fac_ftmr(il)), &
 &                'stewart_expilicit 344', &
-&                errmax*10,errmaxrel*10).eq.1) then
-          write(*,*) 'Rl0,Rb0=',Rl0(iso_eau,il),Rb0(iso_eau,il)
-          write(*,*) 'Revap0=',Revap0(iso_eau,il)
-          write(*,*) 'Eqi,Pqisup,Pxtisup,Pqiinf=', &
+&                errmax*10,errmaxrel*10).eq.1) THEN
+          WRITE(*,*) 'Rl0,Rb0=',Rl0(iso_eau,il),Rb0(iso_eau,il)
+          WRITE(*,*) 'Revap0=',Revap0(iso_eau,il)
+          WRITE(*,*) 'Eqi,Pqisup,Pxtisup,Pqiinf=', &
 &                 Eqi(il),Pqisup(il),Pxtisup(iso_eau,il),Pqiinf(il)
-          write(*,*) 'fac_ftmr,qp0,xtp0=', &
+          WRITE(*,*) 'fac_ftmr,qp0,xtp0=', &
 &                   fac_ftmr(il),qp0(il),xtp0(iso_eau,il)
-          write(*,*) 'Revapfin=',Revapfin(iso_eau,il)
+          WRITE(*,*) 'Revapfin=',Revapfin(iso_eau,il)
           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 (Pqiinf.gt.ridicule) THEN
         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
-                write(*,*) 'xtnew=',xtnew(iso_eau,il)
-                write(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
-                write(*,*) 'Exi=',Exi(iso_eau,il)
-                write(*,*) 'Eqi=',Eqi(il)
-                write(*,*) 'xtp0=',xtp0(iso_eau,il), &
+&                           .eq.1) THEN
+                WRITE(*,*) 'xtnew=',xtnew(iso_eau,il)
+                WRITE(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
+                WRITE(*,*) 'Exi=',Exi(iso_eau,il)
+                WRITE(*,*) 'Eqi=',Eqi(il)
+                WRITE(*,*) 'xtp0=',xtp0(iso_eau,il), &
 &                   'qp0=',qp0(il)
-                write(*,*) 'Pxtisup=',Pxtisup(iso_eau,il), &
+                WRITE(*,*) 'Pxtisup=',Pxtisup(iso_eau,il), &
 &                   ' Pqisup=',pqisup(il)
-                write(*,*) 'Pxtiinf=',Pxtiinf(iso_eau,il), &
+                WRITE(*,*) 'Pxtiinf=',Pxtiinf(iso_eau,il), &
 &                   ' Pqiinf=',pqiinf(il)
                 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
+     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 (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
-           write(*,*) 'qp0(il),Eqi(il),fac_ftmr(il)=', &
+&              'stewart_explicite 603').eq.1) THEN
+           WRITE(*,*) 'qp0(il),Eqi(il),fac_ftmr(il)=', &
 &                   qp0(il),Eqi(il),fac_ftmr(il)
-           write(*,*) 'Pqisup(il)=',Pqisup(il)
-           write(*,*) 'Rl0(iso_HDO,il),Rb0(iso_HDO,il)=',    &    
+           WRITE(*,*) 'Pqisup(il)=',Pqisup(il)
+           WRITE(*,*) 'Rl0(iso_HDO,il),Rb0(iso_HDO,il)=',    &
 &                  Rl0(iso_HDO,il),Rb0(iso_HDO,il) 
-           write(*,*)'Revap0(iso_HDO,il),Revapfin(iso_HDO,il)=', &
+           WRITE(*,*)'Revap0(iso_HDO,il),Revapfin(iso_HDO,il)=', &
 &                 Revap0(iso_HDO,il),Revapfin(iso_HDO,il)  
-           write(*,*) 'Revap(iso_HDO,il)=',Revap(iso_HDO,il)
-           write(*,*) 'Rlfin,Rbfin=', &
+           WRITE(*,*) 'Revap(iso_HDO,il)=',Revap(iso_HDO,il)
+           WRITE(*,*) 'Rlfin,Rbfin=', &
 &                   Rlfin(iso_HDO),Rbfin(iso_HDO)
-           write(*,*) 'h(il),alphap(iso_HDO,il),(D/D'')^n=', &
+           WRITE(*,*) 'h(il),alphap(iso_HDO,il),(D/D'')^n=', &
 &              h(il),alphap(iso_HDO,il),tdifrel(iso_HDO)**(tdifexp)
-           write(*,*) 'deltaDl0,deltaDb0=', &
+           WRITE(*,*) 'deltaDl0,deltaDb0=', &
 &               deltaD((Rl0(iso_HDO,il))), &
 &                   deltaD((Rb0(iso_HDO,il)))
-           write(*,*) 'deltaDe0,deltaDefin,deltaDe=', &
+           WRITE(*,*) 'deltaDe0,deltaDefin,deltaDe=', &
 &               deltaD((Revap0(iso_HDO,il))), &
 &               deltaD((Revapfin(iso_HDO,il))), &
 &               deltaD((Revap(iso_HDO,il)))
-           write(*,*) 'deltaDlfin,deltaDbfin=', &
+           WRITE(*,*) 'deltaDlfin,deltaDbfin=', &
 &                   deltaD((Rlfin(iso_HDO))), &
 &                   deltaD((Rbfin(iso_HDO)))       
            stop
          endif !if (iso_verif_aberrant_nostop((
-       endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+       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
-         write(*,*) 'stewart_explicit 663: cas où réévap faible'
-         write(*,*) 'ordre 1 pour la vapeur et le liquide'
-         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
+     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'
+         WRITE(*,*) 'Eqi(il),deltaD=',Eqi(il), &
 &                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
      endif
@@ -3176,6 +3145,6 @@
 
   ! *** cas où pas d'air
-  if ((h(il).lt.1e-3).or.(qp0(il).lt.1e-8)) then
-!              write(*,*) 'stewart_explicit 349: cas pas d''air'
+  if ((h(il).lt.1e-3).or.(qp0(il).lt.1e-8)) THEN
+!              WRITE(*,*) 'stewart_explicit 349: cas pas d''air'
       !**** calcul de Rl
 !                Rl=Rl0*f**beta ! on fait autrement pour éviter
@@ -3210,14 +3179,14 @@
 &                   *(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)) &
 &                   /fac_ftmr(il)
             enddo    
-        else !if (fac_ftmr.gt.0.0) then
+        else !if (fac_ftmr.gt.0.0) THEN
             do ixt=1,niso
                 Exi(ixt,il)=Pxtisup(ixt,il)-Pxtiinf(ixt,il)
             enddo ! do ixt=1,niso    
-        endif !if (fac_ftmr.gt.0.0) then
+        endif !if (fac_ftmr.gt.0.0) THEN
         !Exi=max(Exi,0) 
 
@@ -3234,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)), &
@@ -3247,26 +3216,26 @@
 &                  (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 !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
+          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 (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 (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+             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
-         write(*,*) 'stewart_explicit 767: cas de réévap sèche'
-         write(*,*) 'distill de Rayleigh'
-         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
+     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'
+         WRITE(*,*) 'Eqi(il),deltaD=',Eqi(il), &
 &                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
      endif
@@ -3274,7 +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
@@ -3291,5 +3259,5 @@
 
 
-!                write(*,*) 'stewart_explicit 349: cas Mp=0'
+!                WRITE(*,*) 'stewart_explicit 349: cas Mp=0'
       do ixt=1,niso 
         Rl(ixt,il)=Rl0(ixt,il)*f(il)**beta(ixt,il)
@@ -3311,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)), &
@@ -3324,35 +3292,35 @@
 &                  (Eqi(il)*fac_ftmr(il)), &
 &                  'stewart_expilicit 472b',errmax*10,errmaxrel*10) &
-&                  .eq.1) then
-                write(*,*) 'il=',il
-                write(*,*) 'f,h=',f(il),h(il)
-                write(*,*) 'fac_ftmr,Eqi=',fac_ftmr(il),Eqi(il)
-                write(*,*) 'Pqisup,Pqiinf=', &
+&                  .eq.1) THEN
+                WRITE(*,*) 'il=',il
+                WRITE(*,*) 'f,h=',f(il),h(il)
+                WRITE(*,*) 'fac_ftmr,Eqi=',fac_ftmr(il),Eqi(il)
+                WRITE(*,*) 'Pqisup,Pqiinf=', &
 &                           Pqisup(il),Pqiinf(il)
-                write(*,*) 'Pxtisup,Pxtiinf', &
+                WRITE(*,*) 'Pxtisup,Pxtiinf', &
 &                     Pxtisup(iso_eau,il),Pxtiinf(iso_eau,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)), &
 &                  1.,'stewart_explicite 143',errmax,errmaxrel)
-            endif !if (Pqiinf.gt.ridicule) then 
+            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
+          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 (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 759')
-            endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+            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
-         write(*,*) 'stewart_explicit 831: flux de masse vap~0'
-         write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
+      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), &
 &                   deltaD((Exi(iso_HDO,il)/Eqi(il)))
       endif
@@ -3360,10 +3328,8 @@
         ! end verifs
 
-    else ! else if (fac_ftmr(il).gt.1e18) then
-
-
+    else ! else if (fac_ftmr(il).gt.1e18) THEN
     !**** cas général
 
-!            write(*,*) 'stewart_explicit 403: cas général'
+!            WRITE(*,*) 'stewart_explicit 403: cas général'
     do ixt=1,niso
       interm(ixt,il)=alphap(ixt,il)*(1.0-h(il)) &
@@ -3375,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
@@ -3383,14 +3349,14 @@
             ! 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) &
 &              +gama(ixt,il)*Rb0(ixt,il)*(1.0-f(il)**beta(ixt,il))
         enddo
-       else !if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) then
+       else !if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) THEN
         do ixt=1,niso
            Rl(ixt,il) = gama(ixt,il)*Rb0(ixt,il)
         enddo   
-       endif !if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) then
+       endif !if (-h(il)/(1-h(il))*log(f(il)).gt.30.0) THEN
         do ixt=1,niso
         Rb(ixt,il)=((Rl0(ixt,il)-Rl(ixt,il)*f(il)) &
@@ -3402,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
@@ -3422,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)), &
@@ -3435,53 +3401,53 @@
 &                  (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 !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
+          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 (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
-                   write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
+&                   .eq.1) THEN
+                   WRITE(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
 &                          Eqi(il)*fac_ftmr(il)/qp0(il) 
-                   write(*,*) 'f,h=',f(il),h(il)
-                   write(*,*) 'Eqi(il)= ',Eqi(il)
-                   write(*,*) 'Pqisup(il)= ',Pqisup(il)
-                   write(*,*) 'fac_ftmr(il)= ',fac_ftmr(il)
-                   write(*,*) 'qp0(il)= ',qp0(il)
-                   write(*,*) 'beta(iso_HDO,il)= ', &
+                   WRITE(*,*) 'f,h=',f(il),h(il)
+                   WRITE(*,*) 'Eqi(il)= ',Eqi(il)
+                   WRITE(*,*) 'Pqisup(il)= ',Pqisup(il)
+                   WRITE(*,*) 'fac_ftmr(il)= ',fac_ftmr(il)
+                   WRITE(*,*) 'qp0(il)= ',qp0(il)
+                   WRITE(*,*) 'beta(iso_HDO,il)= ', &
 &                        beta(iso_HDO,il)
-                   write(*,*) 'gama(iso_HDO,il)= ', &
+                   WRITE(*,*) 'gama(iso_HDO,il)= ', &
 &                        gama(iso_HDO,il)
-                   write(*,*) 'deltaDl0,b0=',deltaD( &
+                   WRITE(*,*) 'deltaDl0,b0=',deltaD( &
 &                        (Rl0(iso_HDO,il))),deltaD( &
 &                        (Rb0(iso_HDO,il)))
-                   write(*,*) 'deltaDl,b=',deltaD( &
+                   WRITE(*,*) 'deltaDl,b=',deltaD( &
 &                        (Rl(iso_HDO,il))),deltaD( &
 &                        (Rb(iso_HDO,il)))
-                   write(*,*) 'deltaDe=',deltaD( &
+                   WRITE(*,*) 'deltaDe=',deltaD( &
 &                        (Exi(iso_HDO,il)/Eqi(il)))
-                   write(*,*) 'deltaDgamaRb0=',deltaD( &
+                   WRITE(*,*) 'deltaDgamaRb0=',deltaD( &
 &                        (gama(iso_HDO,il) &
 &                        *Rb0(iso_HDO,il))) 
-                   write(*,*) 'deltaDalphaRb0=',deltaD( &
+                   WRITE(*,*) 'deltaDalphaRb0=',deltaD( &
 &                        (alphap(iso_HDO,il) &
 &                        *Rb0(iso_HDO,il)))
                    stop
                 endif
-             endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+             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. &
-&               (O17_verif)) then
-             if (Pqiinf(il).gt.ridicule_rain) then
+&               (O17_verif)) THEN
+             if (Pqiinf(il).gt.ridicule_rain) THEN
               CALL iso_verif_aberrant_o17( &
 &                  (Pxtiinf(iso_O17,il)/Pqiinf(il)), &
@@ -3490,11 +3456,11 @@
             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
+     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              
 
     else if ((A(il)*m0(il)/qp0(il).gt.10.0).and. &
-&                (1.0-f(il).lt.1e-5)) then
+&                (1.0-f(il).lt.1e-5)) THEN
         ! beaucoup de liquide se réévaporant très peu dans un
         ! tout petit peu de vapeur. Ca peut donner des cas
@@ -3519,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)
@@ -3539,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)), &
@@ -3552,45 +3518,45 @@
 &                  (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 !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
+          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 (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
-                   write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
+&                   .eq.1) THEN
+                   WRITE(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
 &                          Eqi(il)*fac_ftmr(il)/qp0(il) 
-                   write(*,*) 'f,h=',f(il),h(il)
-                   write(*,*) 'deltaDl0,b0=',deltaD( &
+                   WRITE(*,*) 'f,h=',f(il),h(il)
+                   WRITE(*,*) 'deltaDl0,b0=',deltaD( &
 &                        (Rl0(iso_HDO,il))),deltaD( &
 &                        (Rb0(iso_HDO,il)))
-                   write(*,*) 'deltaDl,b=',deltaD( &
+                   WRITE(*,*) 'deltaDl,b=',deltaD( &
 &                        (Rl(iso_HDO,il))),deltaD( &
 &                        (Rb(iso_HDO,il)))
-                   write(*,*) 'deltaDe=',deltaD( &
+                   WRITE(*,*) 'deltaDe=',deltaD( &
 &                        (Exi(iso_HDO,il)/Eqi(il)))
-                   write(*,*) 'deltaDgamaRb0=',deltaD( &
+                   WRITE(*,*) 'deltaDgamaRb0=',deltaD( &
 &                        (gama(iso_HDO,il) &
 &                        *Rb0(iso_HDO,il))) 
-                   write(*,*) 'deltaDalphaRb0=',deltaD( &
+                   WRITE(*,*) 'deltaDalphaRb0=',deltaD( &
 &                        (alphap(iso_HDO,il) &
 &                        *Rb0(iso_HDO,il)))
                    stop
                 endif
-             endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+             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. &
-&               (O17_verif)) then
-             if (Pqiinf(il).gt.ridicule_rain) then
+&               (O17_verif)) THEN
+             if (Pqiinf(il).gt.ridicule_rain) THEN
               CALL iso_verif_aberrant_o17( &
 &                  (Pxtiinf(iso_O17,il)/Pqiinf(il)), &
@@ -3599,14 +3565,13 @@
             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
+     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              
 
-    else !if (Eqi(il)*fac_ftmr(il)/qp0(il).lt.5e-2) then
-
+    else !if (Eqi(il)*fac_ftmr(il)/qp0(il).lt.5e-2) THEN
     !**** cas général
 #ifdef ISOVERIF
-!        write(*,*) 'stewart_explicit 1170: cas général: il=',il
+!        WRITE(*,*) 'stewart_explicit 1170: cas général: il=',il
 DO ixt=1,niso
   CALL iso_verif_noNaN((beta(ixt,il)), &
@@ -3617,5 +3582,5 @@
 !            if ((allow_ordre1v).and.
 !     :           (Eqi(il)*fac_ftmr(il).lt.1e-2*qp0(il)).and.
-!     :            (h.lt.0.97)) then
+!     :            (h.lt.0.97)) THEN
 !               ! peu d'apport d'évap dans la vapeur, et peu diffusf ->
 !               ! peu de modif de la vapeur -> on utilse l'ordre 1 pour
@@ -3633,7 +3598,7 @@
 !     :           .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 
+!     :           .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
+&           (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
         ! une courbe qui colle aux points de repères utilisés
@@ -3654,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
@@ -3677,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)), &
@@ -3698,12 +3663,12 @@
 &            (Exi(iso_eau,il)), &
 &            (Eqi(il)),'stewart_explicite 595', &
-&            errmax*50,errmaxrel*10).eq.1) then
-           write(*,*) 'il,fac_ftmr(il)=',il,fac_ftmr(il)
-           write(*,*) 'xtnew(iso_eau,il),qp(il)=', &
+&            errmax*50,errmaxrel*10).eq.1) THEN
+           WRITE(*,*) 'il,fac_ftmr(il)=',il,fac_ftmr(il)
+           WRITE(*,*) 'xtnew(iso_eau,il),qp(il)=', &
 &                 xtnew(iso_eau,il),qp0(il)+Eqi(il)*fac_ftmr(il)
-           write(*,*) 'xtp0(iso_eau,il),qp0(il)=', &
+           WRITE(*,*) 'xtp0(iso_eau,il),qp0(il)=', &
 &                   xtp0(iso_eau,il),qp0(il)
-           write(*,*) 'il=',il
-           write(*,*) 'xtp0(iso_eau,7),qp0(7)=', &
+           WRITE(*,*) 'il=',il
+           WRITE(*,*) 'xtp0(iso_eau,7),qp0(7)=', &
 &                   xtp0(iso_eau,7),qp0(7)
            stop
@@ -3713,13 +3678,13 @@
 &            (Eqi(il)*fac_ftmr(il)), &
 &            'stewart_expilicit 521',errmax*10,errmaxrel*10) &
-&            .eq.1) then
-           write(*,*) 'il=',il
+&            .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)), &
 &                1.,'stewart_explicite 143',errmax,errmaxrel)
-         endif !if (Pqiinf.gt.ridicule) then 
+         endif !if (Pqiinf.gt.ridicule) THEN
         ! pour meilleure convergence numérique
         !Pxtiinf=Pqiinf
@@ -3729,13 +3694,13 @@
 &                   (qp0(il)+Eqi(il)*fac_ftmr(il)), &
 &                   'stewart_explicite 605',errmax*10,errmaxrel*50) &
-&                           .eq.1) then
-                write(*,*) 'xtnew=',xtnew(iso_eau,il)
-                write(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
-                write(*,*) 'errrel=', & 
+&                           .eq.1) THEN
+                WRITE(*,*) 'xtnew=',xtnew(iso_eau,il)
+                WRITE(*,*) 'qp=',qp0(il)+Eqi(il)*fac_ftmr(il)
+                WRITE(*,*) 'errrel=', &
 &                   (xtnew(iso_eau,il)- &
 &                    (qp0(il)+Eqi(il)*fac_ftmr(il))) &
 &                     /(qp0(il)+Eqi(il)*fac_ftmr(il))
-                write(*,*) 'Rb=',Rb(iso_eau,il)
-                write(*,*) 'Rl=',Rl(iso_eau,il)
+                WRITE(*,*) 'Rb=',Rb(iso_eau,il)
+                WRITE(*,*) 'Rl=',Rl(iso_eau,il)
                 stop
        endif !if (iso_verif_egalite_choix_nostop(
@@ -3743,36 +3708,36 @@
        !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_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
-          write(*,*) 'cas général f petit: il=',il
-          write(*,*) 'Rl,deltaDRl=',Rl(iso_HDO,il), &
+&                   'stewart_explicie 675').eq.1) THEN
+          WRITE(*,*) 'cas général f petit: il=',il
+          WRITE(*,*) 'Rl,deltaDRl=',Rl(iso_HDO,il), &
 &                   deltaD((Rl(iso_HDO,il)))
-          write(*,*) 'gama,h=',gama(iso_HDO,il),h(il)
-          write(*,*) 'Rl0,Rb0,deltaDRl0,RbO=',Rl0(iso_HDO,il), &
+          WRITE(*,*) 'gama,h=',gama(iso_HDO,il),h(il)
+          WRITE(*,*) 'Rl0,Rb0,deltaDRl0,RbO=',Rl0(iso_HDO,il), &
 &                   Rb0(iso_HDO,il), &
 &                   deltaD((Rl0(iso_HDO,il))), &
 &                   deltaD((Rb0(iso_HDO,il)))
-          write(*,*) 'r_l0qp0/(1+r_l0qp0),1/(1+r_l0qp0)=', &
+          WRITE(*,*) 'r_l0qp0/(1+r_l0qp0),1/(1+r_l0qp0)=', &
 &               r_l0qp0(il)/(1.0+r_l0qp0(il)),1.0/(1.0+r_l0qp0(il))
-          write(*,*) 'f,r_l0qp0=',f(il),r_l0qp0(il)
-          write(*,*) 'fac=',(1-f(il)*r_l0qp0(il)) &
+          WRITE(*,*) 'f,r_l0qp0=',f(il),r_l0qp0(il)
+          WRITE(*,*) 'fac=',(1-f(il)*r_l0qp0(il)) &
 &                  /(1-f(il)*r_l0qp0(il)*gama(iso_HDO,il)) 
-          write(*,*) 'Rl=gama*(RlO*r_l0qp0+rb0)/(1+r_l0qp0)*fac'
+          WRITE(*,*) 'Rl=gama*(RlO*r_l0qp0+rb0)/(1+r_l0qp0)*fac'
           stop
         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
+       endif !if (Pqiinf(il).gt.ridicule_rain) 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
-         write(*,*) 'stewart_explicit 991: fcas général'
-         write(*,*) 'mais avec formule simplifiée'
-         write(*,*) 'il,Eqi(il)=',il,Eqi(il)
-         write(*,*) 'deltaD=',deltaD((Exi(iso_HDO,il)/Eqi(il)))
+       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
+         WRITE(*,*) 'stewart_explicit 991: fcas général'
+         WRITE(*,*) 'mais avec formule simplifiée'
+         WRITE(*,*) 'il,Eqi(il)=',il,Eqi(il)
+         WRITE(*,*) 'deltaD=',deltaD((Exi(iso_HDO,il)/Eqi(il)))
        endif
       endif !if (iso_HDO.gt.0)  
@@ -3780,38 +3745,36 @@
   ! 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
         ! func=(x/m)**(-beta-1), intégrable analytiquement:
-!                write(*,*) 'stewart_explicite 684:calcul analytique'
+!                WRITE(*,*) 'stewart_explicite 684:calcul analytique'
         icas_Jsimple=icas_Jsimple+1
         cas_Jsimple(icas_Jsimple)=il
 #ifdef ISOVERIF
-!               write(*,*) 'stewart_expl 894 tmp: '//
+!               WRITE(*,*) 'stewart_expl 894 tmp: '//
 !     :             'icas_jsimple,il=',icas_jsimple,il
        trace(il)=2532
 #endif                
                 
-else !if ((g**(1-beta*gama))-1.0.lt.errmaxrel*10) then
+else !if ((g**(1-beta*gama))-1.0.lt.errmaxrel*10) THEN
         ! dans ce cas, la fonction est trop compliqué à intégrer
         ! analytiquement. On intègre donc numériquement.
-!                write(*,*) 'stewart_explicite 684:calcul numérique'
+!                WRITE(*,*) 'stewart_explicite 684:calcul numérique'
         ! on traitera ce cas en vectoriel:
         icas_rieman=icas_rieman+1
         cas_rieman(icas_rieman)=il
 #ifdef ISOVERIF
-!                write(*,*) 'stewart_expl 895 tmp: '//
+!                WRITE(*,*) 'stewart_expl 895 tmp: '//
 !     :             'icas_rieman,il=',icas_rieman,il
         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(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 (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(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 ! Pqisup.le.0
 END DO ! do il=1,ncas
@@ -3821,14 +3784,14 @@
 ncas_Jsimple=icas_Jsimple
 !#ifdef ISOVERIF
-!      write(*,*) 'stewart_explicite_vectall 812: ncas=',ncas
-!      write(*,*) 'ncas_rieman=',ncas_rieman
-!      write(*,*) 'ncas_Jsimple=',ncas_Jsimple      
+!      WRITE(*,*) 'stewart_explicite_vectall 812: ncas=',ncas
+!      WRITE(*,*) 'ncas_rieman=',ncas_rieman
+!      WRITE(*,*) 'ncas_Jsimple=',ncas_Jsimple
 !#endif      
 
 !******** traitement vectoriel des cas Rieman et Jsimple:
 ! compression
-IF (ncas_Jsimple+ncas_rieman.gt.0) then
+IF (ncas_Jsimple+ncas_rieman.gt.0) THEN
 !#ifdef ISOVERIF         
-!        write(*,*) 'stewart_explicite_vectall 873:compression_calculJ' 
+!        WRITE(*,*) 'stewart_explicite_vectall 873:compression_calculJ'
 !#endif        
 CALL compress_calculJ(ncas,ncas_Rieman,ncas_Jsimple,  &
@@ -3883,6 +3846,6 @@
 &        /m0_cas(icas_Jsimple+ncas_Jsimple)), &
 &       'stewart_explicite_vectall 953b apres compression', &
-&        errmax,errmaxrel).eq.1) then
-      write(*,*) 'icas_Jsimple,cas_rieman(icas_Jsimple)=', &
+&        errmax,errmaxrel).eq.1) THEN
+      WRITE(*,*) 'icas_Jsimple,cas_rieman(icas_Jsimple)=', &
 &           icas_Jsimple,cas_rieman(icas_Jsimple)
       stop
@@ -3892,7 +3855,7 @@
 
 ! ************ traitement vectoriel du cas J simplifié
-IF (ncas_Jsimple.gt.0) then
+IF (ncas_Jsimple.gt.0) THEN
 !#ifdef ISOVERIF
-!          write(*,*) 'traitement vectoriel J simple: x',ncas_Jsimple
+!          WRITE(*,*) 'traitement vectoriel J simple: x',ncas_Jsimple
 !#endif          
 DO il=1,ncas_Jsimple
@@ -3913,10 +3876,7 @@
   enddo  !do ixt=1,niso  
 END DO !do il=1,ncas_Jsimple
-END IF !if (ncas_Jsimple.gt.0) then
-      
-
+END IF !if (ncas_Jsimple.gt.0) THEN
     ! ******* traitement vectoriel du cas Rieman (=2533)
-IF (ncas_rieman.gt.0) then
-            
+IF (ncas_rieman.gt.0) THEN
    icas_rieman=1+ncas_Jsimple
 
@@ -3930,10 +3890,8 @@
 &       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
-!          write(*,*) 'traitement vectoriel commun rieman/Jsimple'
+!          WRITE(*,*) 'traitement vectoriel commun rieman/Jsimple'
 #endif          
    do il=1,ncas_Jsimple+ncas_rieman          
@@ -3965,12 +3923,12 @@
     if ((fac_ftmr_cas(il).gt.0.0).and. &
 &           (Pqiinf_cas(il).gt.(Eqi_cas(il)+qp0_cas(il) &
-&                   /fac_ftmr_cas(il)))) then 
+&                   /fac_ftmr_cas(il)))) THEN
         ! méthode (1)
-!                write(*,*) 'stewart_explicite 739: methode 1'
+!                WRITE(*,*) 'stewart_explicite 739: methode 1'
         Exi_cas(ixt,il)=(xtnew_cas(ixt,il)-xtp0_cas(ixt,il)) &
 &                   /fac_ftmr_cas(il)
     else
        ! méthode (2): 
-!               write(*,*) 'stewart_explicite 743: methode 2'
+!               WRITE(*,*) 'stewart_explicite 743: methode 2'
        Exi_cas(ixt,il)=Pxtisup_cas(ixt,il)-Pxtiinf_cas(ixt,il)
     endif
@@ -3983,31 +3941,31 @@
 &           'stewart_explicite 1348').eq.1).or. &
 &           (iso_verif_noNaN_nostop(xtnew_cas(ixt,il), &
-&           'stewart_explicite 1348b').eq.1)) then
-       write(*,*) 'ixt,ncas_Jsimple,il=',ixt,ncas_Jsimple,il
-       write(*,*) 'Exi_cas(ixt,il)=',Exi_cas(ixt,il)
-       write(*,*) 'Pxtiinf_cas(ixt,il)=',Pxtiinf_cas(ixt,il)
-       write(*,*) 'xtnew_cas(ixt,il)=',xtnew_cas(ixt,il)
-       write(*,*) 'xtp0_cas(ixt,il)=',xtp0_cas(ixt,il)
-       write(*,*) 'Pxtisup_cas(ixt,il)=',Pxtisup_cas(ixt,il)
-       write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-       write(*,*) 'Eqi_cas(il)=',Eqi_cas(il)
-       write(*,*) 'Pqiinf_cas(il)=',Pqiinf_cas(il)
-       write(*,*) 'qp0_cas(il)=',qp0_cas(il)
-       write(*,*) 'm0_cas(il)=',m0_cas(il)
-       write(*,*) 'Rb(ixt,il)=',Rb(ixt,il)
-       write(*,*) 'Rl(ixt,il)=',Rl(ixt,il)
-       write(*,*) 'r_jqp0(ixt,il)=',r_jqp0(ixt,il)
-       write(*,*) 'r_jl0(ixt,il)=',r_jl0(ixt,il)
-       write(*,*) 'J(ixt,il)=',J(ixt,il)
-       write(*,*) 'A_cas(il)=',A_cas(il)
-       write(*,*) 'f_cas(il)=',f_cas(il)
-       write(*,*) 'g_cas(il)=',g_cas(il)
-       write(*,*) 'beta_cas(ixt,il)=',beta_cas(ixt,il)
-       write(*,*) 'gama_cas(ixt,il)=',gama_cas(ixt,il)
-       write(*,*) 'f**beta=',f_cas(il)**beta_cas(ixt,il)
-       write(*,*) 'f**(beta+1)=',f_cas(il)**(beta_cas(ixt,il)+1)
-       write(*,*) 'g*(-beta*gama)=',g_cas(il)** &
+&           'stewart_explicite 1348b').eq.1)) THEN
+       WRITE(*,*) 'ixt,ncas_Jsimple,il=',ixt,ncas_Jsimple,il
+       WRITE(*,*) 'Exi_cas(ixt,il)=',Exi_cas(ixt,il)
+       WRITE(*,*) 'Pxtiinf_cas(ixt,il)=',Pxtiinf_cas(ixt,il)
+       WRITE(*,*) 'xtnew_cas(ixt,il)=',xtnew_cas(ixt,il)
+       WRITE(*,*) 'xtp0_cas(ixt,il)=',xtp0_cas(ixt,il)
+       WRITE(*,*) 'Pxtisup_cas(ixt,il)=',Pxtisup_cas(ixt,il)
+       WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+       WRITE(*,*) 'Eqi_cas(il)=',Eqi_cas(il)
+       WRITE(*,*) 'Pqiinf_cas(il)=',Pqiinf_cas(il)
+       WRITE(*,*) 'qp0_cas(il)=',qp0_cas(il)
+       WRITE(*,*) 'm0_cas(il)=',m0_cas(il)
+       WRITE(*,*) 'Rb(ixt,il)=',Rb(ixt,il)
+       WRITE(*,*) 'Rl(ixt,il)=',Rl(ixt,il)
+       WRITE(*,*) 'r_jqp0(ixt,il)=',r_jqp0(ixt,il)
+       WRITE(*,*) 'r_jl0(ixt,il)=',r_jl0(ixt,il)
+       WRITE(*,*) 'J(ixt,il)=',J(ixt,il)
+       WRITE(*,*) 'A_cas(il)=',A_cas(il)
+       WRITE(*,*) 'f_cas(il)=',f_cas(il)
+       WRITE(*,*) 'g_cas(il)=',g_cas(il)
+       WRITE(*,*) 'beta_cas(ixt,il)=',beta_cas(ixt,il)
+       WRITE(*,*) 'gama_cas(ixt,il)=',gama_cas(ixt,il)
+       WRITE(*,*) 'f**beta=',f_cas(il)**beta_cas(ixt,il)
+       WRITE(*,*) 'f**(beta+1)=',f_cas(il)**(beta_cas(ixt,il)+1)
+       WRITE(*,*) 'g*(-beta*gama)=',g_cas(il)** &
 &          (-beta_cas(ixt,il)*gama_cas(ixt,il))
-       write(*,*) 'g*(-beta*gama-1)=',g_cas(il)** &
+       WRITE(*,*) 'g*(-beta*gama-1)=',g_cas(il)** &
 &          (-beta_cas(ixt,il)*gama_cas(ixt,il)-1.0)
        stop
@@ -4016,42 +3974,42 @@
 #endif
 #ifdef ISOVERIF         
-    if (iso_eau.gt.0) then
+    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 
-         write(*,*) 'il=',il
-         if (il.le.ncas_Jsimple) then
-            write(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
-         else !if (il.le.ncas_Jsimple) then
-            write(*,*) 'cas_rieman(il)=',cas_rieman(il)
-         endif !if (il.le.ncas_Jsimple) then
-         write(*,*) 'Rl=',Rl(iso_eau,il),' Rb=',Rb(iso_eau,il)
-         write(*,*) 'g**(1-beta*gama)=',g_cas(il)** &
+&           errmax*50,errmaxrel*50).eq.1) THEN
+         WRITE(*,*) 'il=',il
+         if (il.le.ncas_Jsimple) THEN
+            WRITE(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
+         else !if (il.le.ncas_Jsimple) THEN
+            WRITE(*,*) 'cas_rieman(il)=',cas_rieman(il)
+         endif !if (il.le.ncas_Jsimple) THEN
+         WRITE(*,*) 'Rl=',Rl(iso_eau,il),' Rb=',Rb(iso_eau,il)
+         WRITE(*,*) 'g**(1-beta*gama)=',g_cas(il)** &
 &                 (1-beta_cas(iso_eau,il)*gama_cas(iso_eau,il))
-         write(*,*) 'j=',j(iso_eau,il)
+         WRITE(*,*) 'j=',j(iso_eau,il)
 !#ifdef rieman                 
-!                 write(*,*) 'e=',e(iso_eau,il)
+!                 WRITE(*,*) 'e=',e(iso_eau,il)
 !#endif                 
-!                 write(*,*) 'ntot_cas(il)=',ntot_cas(il)
-         write(*,*) 'gama=',gama_cas(iso_eau,il), &
+!                 WRITE(*,*) 'ntot_cas(il)=',ntot_cas(il)
+         WRITE(*,*) 'gama=',gama_cas(iso_eau,il), &
 &                   ' beta=',beta_cas(iso_eau,il)
-         if (il.le.ncas_Jsimple) then
-           write(*,*) 'h=',h(cas_Jsimple(il)), &
+         if (il.le.ncas_Jsimple) THEN
+           WRITE(*,*) 'h=',h(cas_Jsimple(il)), &
 &                   ' Tevap=',Tevap(cas_Jsimple(il))
-         else !if (il.le.ncas_Jsimple) then
-             write(*,*) 'h=',h(cas_rieman(il)), &
+         else !if (il.le.ncas_Jsimple) THEN
+             WRITE(*,*) 'h=',h(cas_rieman(il)), &
 &                   ' Tevap=',Tevap(cas_rieman(il))
-         endif !if (il.le.ncas_Jsimple) then
-         write(*,*) 'f=',f_cas(il),' g=',g_cas(il)
-         write(*,*) 'r_jl0=',r_jl0(iso_eau,il), &
+         endif !if (il.le.ncas_Jsimple) THEN
+         WRITE(*,*) 'f=',f_cas(il),' g=',g_cas(il)
+         WRITE(*,*) 'r_jl0=',r_jl0(iso_eau,il), &
 &                   ' r_jqp0=',r_jqp0(iso_eau,il)
-         write(*,*) 'r_l0qp0=',r_l0qp0_cas(il)
-         write(*,*) 'm0=',m0_cas(il),' m=',m_cas(il), &
+         WRITE(*,*) 'r_l0qp0=',r_l0qp0_cas(il)
+         WRITE(*,*) 'm0=',m0_cas(il),' m=',m_cas(il), &
 &                           ' m0-m=',m0_cas(il)-m_cas(il)
-         write(*,*) 'A=',A_cas(il),' qp0=',qp0_cas(il)
-         write(*,*) 'Rl0=',Rl0_cas(iso_eau,il), &
+         WRITE(*,*) 'A=',A_cas(il),' qp0=',qp0_cas(il)
+         WRITE(*,*) 'Rl0=',Rl0_cas(iso_eau,il), &
 &           ' Rb0=',Rb0_cas(iso_eau,il)
-         write(*,*) 'pond Rl0=',(f_cas(il) &
+         WRITE(*,*) 'pond Rl0=',(f_cas(il) &
 &               **beta_cas(iso_eau,il)) &
 &                   *(g_cas(il)**(-beta_cas(iso_eau,il) &
@@ -4059,12 +4017,12 @@
 &                 +beta_cas(iso_eau,il)*gama_cas(iso_eau,il) &
 &              *r_jqp0(iso_eau,il)/f_cas(il)/g_cas(il)
-         write(*,*) 'pond Rb0=', &
+         WRITE(*,*) 'pond Rb0=', &
 &              gama_cas(iso_eau,il)*beta_cas(iso_eau,il) &
 &              *r_jl0(iso_eau,il)/f_cas(il)/g_cas(il)
-         write(*,*) 'fac1=', &
+         WRITE(*,*) 'fac1=', &
 &                  f_cas(il)**beta_cas(iso_eau,il)
-         write(*,*) 'fac2=',g_cas(il) &
+         WRITE(*,*) 'fac2=',g_cas(il) &
 &             **(-beta_cas(iso_eau,il)*gama_cas(iso_eau,il)) 
-         write(*,*) 't3=',beta_cas(iso_eau,il) &
+         WRITE(*,*) 't3=',beta_cas(iso_eau,il) &
 &               *gama_cas(iso_eau,il)*r_jqp0(iso_eau,il) &
 &           /f_cas(il)/g_cas(il)    
@@ -4075,37 +4033,37 @@
 &           (qp0_cas(il)+Eqi_cas(il) &
 &           *fac_ftmr_cas(il)),'stewart_explicite 1026', &
-&           errmax*50,errmaxrel*50).eq.1) then 
-         write(*,*) 'il=',il                 
-         if (il.le.ncas_Jsimple) then
-            write(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
-         else !if (il.le.ncas_Jsimple) then
-            write(*,*) 'cas_rieman(il)=',cas_rieman(il)
-         endif !if (il.le.ncas_Jsimple) then
-         write(*,*) 'Rl=',Rl(iso_eau,il),' Rb=',Rb(iso_eau,il)
-         write(*,*) 'g**(1-beta*gama)=',g_cas(il)** &
+&           errmax*50,errmaxrel*50).eq.1) THEN
+         WRITE(*,*) 'il=',il
+         if (il.le.ncas_Jsimple) THEN
+            WRITE(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
+         else !if (il.le.ncas_Jsimple) THEN
+            WRITE(*,*) 'cas_rieman(il)=',cas_rieman(il)
+         endif !if (il.le.ncas_Jsimple) THEN
+         WRITE(*,*) 'Rl=',Rl(iso_eau,il),' Rb=',Rb(iso_eau,il)
+         WRITE(*,*) 'g**(1-beta*gama)=',g_cas(il)** &
 &                 (1-beta_cas(iso_eau,il)*gama_cas(iso_eau,il))
-         write(*,*) 'J=',J(iso_eau,il)
+         WRITE(*,*) 'J=',J(iso_eau,il)
 !#ifdef rieman                 
-!                 write(*,*) 'e=',e(iso_eau,il)
+!                 WRITE(*,*) 'e=',e(iso_eau,il)
 !#endif                   
-!                 write(*,*) 'ntot_cas(il)=',ntot_cas(il)
-         write(*,*) 'gama=',gama_cas(iso_eau,il), &
+!                 WRITE(*,*) 'ntot_cas(il)=',ntot_cas(il)
+         WRITE(*,*) 'gama=',gama_cas(iso_eau,il), &
 &                   ' beta=',beta_cas(iso_eau,il)
-         if (il.le.ncas_Jsimple) then
-           write(*,*) 'h=',h(cas_Jsimple(il)), &
+         if (il.le.ncas_Jsimple) THEN
+           WRITE(*,*) 'h=',h(cas_Jsimple(il)), &
 &                   ' Tevap=',Tevap(cas_Jsimple(il))
-         else !if (il.le.ncas_Jsimple) then
-             write(*,*) 'h=',h(cas_rieman(il)), &
+         else !if (il.le.ncas_Jsimple) THEN
+             WRITE(*,*) 'h=',h(cas_rieman(il)), &
 &                   ' Tevap=',Tevap(cas_rieman(il))
-         endif !if (il.le.ncas_Jsimple) then
-         write(*,*) 'f=',f_cas(il),' g=',g_cas(il)
-         write(*,*) 'r_jl0=',r_jl0(iso_eau,il), &
+         endif !if (il.le.ncas_Jsimple) THEN
+         WRITE(*,*) 'f=',f_cas(il),' g=',g_cas(il)
+         WRITE(*,*) 'r_jl0=',r_jl0(iso_eau,il), &
 &                   ' r_jqp0=',r_jqp0(iso_eau,il)
-         write(*,*) 'r_l0qp0=',r_l0qp0_cas(il)
-         write(*,*) 'm0=',m0_cas(il),' m=',m_cas(il)
-         write(*,*) 'A=',A_cas(il),' qp0=',qp0_cas(il)
-         write(*,*) 'Rl0=',Rl0_cas(iso_eau,il), &
+         WRITE(*,*) 'r_l0qp0=',r_l0qp0_cas(il)
+         WRITE(*,*) 'm0=',m0_cas(il),' m=',m_cas(il)
+         WRITE(*,*) 'A=',A_cas(il),' qp0=',qp0_cas(il)
+         WRITE(*,*) 'Rl0=',Rl0_cas(iso_eau,il), &
 &           ' Rb0=',Rb0_cas(iso_eau,il)
-         write(*,*) 'pond Rl0=',r_l0qp0_cas(il)* (1/g_cas(il) &
+         WRITE(*,*) 'pond Rl0=',r_l0qp0_cas(il)* (1/g_cas(il) &
 &              -(f_cas(il)**(beta_cas(iso_eau,il)+1)) &
 &              *(g_cas(il)**(-beta_cas(iso_eau,il) &
@@ -4114,5 +4072,5 @@
 &                   *r_jqp0(iso_eau,il) &
 &                   /g_cas(il)/g_cas(il))
-         write(*,*) 'pond Rb0=',(1/g_cas(il)  &
+         WRITE(*,*) 'pond Rb0=',(1/g_cas(il)  &
 &              - 1/g_cas(il)/g_cas(il) * gama_cas(iso_eau,il) &
 &             *beta_cas(iso_eau,il)*r_jqp0(iso_eau,il))
@@ -4127,56 +4085,56 @@
 &            (Eqi_cas(il)*fac_ftmr_cas(il)), &
 &           'stewart_explicite 586', &
-&            errmax*3000,errmaxrel*800).eq.1)) then  
-          write(*,*) 'il=',il                 
-         if (il.le.ncas_Jsimple) then
-            write(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
-         else !if (il.le.ncas_Jsimple) then
-            write(*,*) 'cas_rieman(il)=',cas_rieman(il)
-         endif !if (il.le.ncas_Jsimple) then
-          write(*,*) 'g**(1-beta*gama)=',g_cas(il) &
+&            errmax*3000,errmaxrel*800).eq.1)) THEN
+          WRITE(*,*) 'il=',il
+         if (il.le.ncas_Jsimple) THEN
+            WRITE(*,*) 'cas_Jsimple(il)=',cas_Jsimple(il)
+         else !if (il.le.ncas_Jsimple) THEN
+            WRITE(*,*) 'cas_rieman(il)=',cas_rieman(il)
+         endif !if (il.le.ncas_Jsimple) THEN
+          WRITE(*,*) 'g**(1-beta*gama)=',g_cas(il) &
 &                **(1-beta_cas(iso_eau,il)*gama_cas(iso_eau,il))
-          write(*,*) 'Eqi,Exi,fac_ftmr,Pqiinf=',Eqi_cas(il), &
+          WRITE(*,*) 'Eqi,Exi,fac_ftmr,Pqiinf=',Eqi_cas(il), &
 &             Exi_cas(iso_eau,il),fac_ftmr_cas(il),Pqiinf_cas(il)
-          write(*,*) 'xtnew(iso_eau,il),xtp0(iso_eau,il)=', &
+          WRITE(*,*) 'xtnew(iso_eau,il),xtp0(iso_eau,il)=', &
 &              xtnew_cas(iso_eau,il),xtp0_cas(iso_eau,il)     
           stop
      endif
-    endif  !if (iso_eau.gt.0) then
-    if (iso_HDO.gt.0) then
+    endif  !if (iso_eau.gt.0) THEN
+    if (iso_HDO.gt.0) THEN
        if (qp0_cas(il)+Eqi_cas(il)*fac_ftmr_cas(il) &
-&                   .gt.ridicule) then
+&                   .gt.ridicule) THEN
          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
-           write(*,*) 'il,fac_ftmr_cas(il)=',il,fac_ftmr_cas(il)
-           write(*,*) 'h(il)=',h(il)
-           write(*,*) 'alphap(iso_HDO,il)=',alphap(iso_HDO,il)
-           write(*,*) 'Di/D)^n=',tdifrel(iso_HDO)**(tdifexp)
-           write(*,*) 'qp0_cas(il)=',qp0_cas(il)   
-           write(*,*) 'Eqi_cas(il)=',Eqi_cas(il)   
-           write(*,*) 'Pqiinf_cas(il)=',Pqiinf_cas(il) 
-           write(*,*) 'm0_cas(il)=',m0_cas(il)
-           write(*,*) 'deltaD(Rb0(iso_HDO,il))=', &
+&                'stewart_explicite 1316').eq.1) THEN
+           WRITE(*,*) 'il,fac_ftmr_cas(il)=',il,fac_ftmr_cas(il)
+           WRITE(*,*) 'h(il)=',h(il)
+           WRITE(*,*) 'alphap(iso_HDO,il)=',alphap(iso_HDO,il)
+           WRITE(*,*) 'Di/D)^n=',tdifrel(iso_HDO)**(tdifexp)
+           WRITE(*,*) 'qp0_cas(il)=',qp0_cas(il)
+           WRITE(*,*) 'Eqi_cas(il)=',Eqi_cas(il)
+           WRITE(*,*) 'Pqiinf_cas(il)=',Pqiinf_cas(il)
+           WRITE(*,*) 'm0_cas(il)=',m0_cas(il)
+           WRITE(*,*) 'deltaD(Rb0(iso_HDO,il))=', &
 &               deltaD(Rb0(iso_HDO,il))
-           write(*,*) 'deltaD(Rl0(iso_HDO,il))=', &
+           WRITE(*,*) 'deltaD(Rl0(iso_HDO,il))=', &
 &               deltaD(Rl0(iso_HDO,il))
-           write(*,*) 'deltaD(Rb(iso_HDO,il))=', &
+           WRITE(*,*) 'deltaD(Rb(iso_HDO,il))=', &
 &               deltaD(Rb(iso_HDO,il))
-           write(*,*) 'deltaD(Rl(iso_HDO,il))=', &
+           WRITE(*,*) 'deltaD(Rl(iso_HDO,il))=', &
 &               deltaD(Rl(iso_HDO,il))
-           write(*,*) 'r_jqp0(iso_HDO,il)=',r_jqp0(iso_HDO,il)
-           write(*,*) 'r_jl0(iso_HDO,il)=',r_jl0(iso_HDO,il)
-           write(*,*) 'J(iso_HDO,il)=',J(iso_HDO,il)
-           write(*,*) 'A_cas(il)=',A_cas(il)
-           write(*,*) 'f_cas(il)=',f_cas(il)
-           write(*,*) 'g_cas(il)=',g_cas(il)
-           write(*,*) 'beta_cas(iso_HDO,il)=', &
+           WRITE(*,*) 'r_jqp0(iso_HDO,il)=',r_jqp0(iso_HDO,il)
+           WRITE(*,*) 'r_jl0(iso_HDO,il)=',r_jl0(iso_HDO,il)
+           WRITE(*,*) 'J(iso_HDO,il)=',J(iso_HDO,il)
+           WRITE(*,*) 'A_cas(il)=',A_cas(il)
+           WRITE(*,*) 'f_cas(il)=',f_cas(il)
+           WRITE(*,*) 'g_cas(il)=',g_cas(il)
+           WRITE(*,*) 'beta_cas(iso_HDO,il)=', &
 &               beta_cas(iso_HDO,il)
-           write(*,*) 'gama_cas(iso_HDO,il)=', &
+           WRITE(*,*) 'gama_cas(iso_HDO,il)=', &
 &               gama_cas(iso_HDO,il)
            stop
          endif
-        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+        endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) THEN
       endif !if (iso_HDO.gt.0)
 #endif            
@@ -4220,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
@@ -4231,7 +4189,7 @@
 &         'stewart_explicite 620').eq.1).or. &
 &         (iso_verif_noNaN_nostop((xtnew(ixt,il)), &
-&         'stewart_explicite 622').eq.1)) then
-       write(*,*) 'ixt,il=',ixt,il
-       write(*,*) 'icas_Jsimple,ncas_Jsimple=', &
+&         'stewart_explicite 622').eq.1)) THEN
+       WRITE(*,*) 'ixt,il=',ixt,il
+       WRITE(*,*) 'icas_Jsimple,ncas_Jsimple=', &
 &                  icas_Jsimple,ncas_Jsimple
        stop
@@ -4242,19 +4200,19 @@
 #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_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 
-          write(*,*) 'icas_Jsimple,il,trace(il)=', &
+&           errmax*50,errmaxrel*50).eq.1) THEN
+          WRITE(*,*) 'icas_Jsimple,il,trace(il)=', &
 &                    icas_Jsimple,il,trace(il) 
-          write(*,*) 'Pqiinf_cas(icas_Jsimple)=', &
+          WRITE(*,*) 'Pqiinf_cas(icas_Jsimple)=', &
 &                   Pqiinf_cas(icas_Jsimple)
-          write(*,*) 'Pxtiinf_cas(iso_eau,icas_Jsimple)=', &
+          WRITE(*,*) 'Pxtiinf_cas(iso_eau,icas_Jsimple)=', &
 &                   Pxtiinf_cas(iso_eau,icas_Jsimple)
           stop
@@ -4269,9 +4227,9 @@
 &            (Eqi(il)*fac_ftmr(il)), &
 &           'stewart_explicite 587', &
-&            errmax*3000,errmaxrel*800).eq.1)) then  
-          write(*,*) 'il,icas_Jsimple=',il,icas_Jsimple
-          write(*,*) 'g**(1-beta*gama)=', &
+&            errmax*3000,errmaxrel*800).eq.1)) THEN
+          WRITE(*,*) 'il,icas_Jsimple=',il,icas_Jsimple
+          WRITE(*,*) 'g**(1-beta*gama)=', &
 &                   g(il)**(1-beta(iso_eau,il)*gama(iso_eau,il))
-          write(*,*) 'Eqi,Exi,fac_ftmr=', &
+          WRITE(*,*) 'Eqi,Exi,fac_ftmr=', &
 &                   Eqi(il),Exi(iso_eau,il),fac_ftmr(il)
           stop
@@ -4279,45 +4237,44 @@
 
      ! le 6 dec 2011: on relache ridicule en ridicule*2
-     if (Pqiinf(il).gt.ridicule*2) then
+     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
-         write(*,*) 'il=',il
-         write(*,*) 'Pqiinf,Pxtiinf=', &
+&            errmax*10,errmaxrel*50).eq.1) THEN
+         WRITE(*,*) 'il=',il
+         WRITE(*,*) 'Pqiinf,Pxtiinf=', &
 &                 Pqiinf(il),Pxtiinf(iso_eau,il)
-         write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-         write(*,*) 'f,h(il)=',f(il),h(il)
-         write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
+         WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+         WRITE(*,*) 'f,h(il)=',f(il),h(il)
+         WRITE(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
 &                 Eqi(il)*fac_ftmr(il)/qp0(il)        
-         write(*,*) 'g(il)=',g(il)           
+         WRITE(*,*) 'g(il)=',g(il)
          stop
        endif !if (iso_verif_egalite_choix_nostop
-     endif !if (Pqiinf.gt.ridicule) then
-     
+     endif !if (Pqiinf.gt.ridicule) THEN
      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
-                write(*,*) 'icas_Jsimple,il,trace(il)=', &
+&                           .eq.1) THEN
+                WRITE(*,*) 'icas_Jsimple,il,trace(il)=', &
 &                    icas_Jsimple,il,trace(il) 
-                write(*,*) 'xtnew_cas(iso_eau,icas_Jsimple)=', &
+                WRITE(*,*) 'xtnew_cas(iso_eau,icas_Jsimple)=', &
 &                   xtnew_cas(iso_eau,icas_Jsimple)
-                write(*,*) 'xtnew(iso_eau,il)=', &
+                WRITE(*,*) 'xtnew(iso_eau,il)=', &
 &                           xtnew(iso_eau,il)
-                write(*,*) 'qp0(il)=',qp0(il)
-                write(*,*) 'qp0_cas(icas_Jsimple)=', &
+                WRITE(*,*) 'qp0(il)=',qp0(il)
+                WRITE(*,*) 'qp0_cas(icas_Jsimple)=', &
 &                           qp0(icas_Jsimple)
-                write(*,*) 'Eqi(il)=',Eqi(il)
-                write(*,*) 'Eqi_cas(icas_Jsimple)=', &
+                WRITE(*,*) 'Eqi(il)=',Eqi(il)
+                WRITE(*,*) 'Eqi_cas(icas_Jsimple)=', &
 &                           Eqi(icas_Jsimple)
-                write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
-                write(*,*) 'fac_ftmr_cas(icas_Jsimple)=', &
+                WRITE(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
+                WRITE(*,*) 'fac_ftmr_cas(icas_Jsimple)=', &
 &                           fac_ftmr_cas(icas_Jsimple)
                 stop
      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)
@@ -4327,73 +4284,71 @@
    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_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( &
+&                   'stewart_explicite 871').eq.1)  THEN
+      WRITE(*,*) 'deltaDl0=',deltaD( &
 &           (Rl0(iso_HDO,il)))
-        write(*,*) 'deltaDb0=',deltaD( &
+        WRITE(*,*) 'deltaDb0=',deltaD( &
 &           (Rb0(iso_HDO,il)))
         stop
       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
+     endif !if (Pqiinf(il).gt.ridicule_rain) 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 1461')
-     endif !if (qp0(il)+Eqi(il)*fac_ftmr(il).gt.ridicule) then
+     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
-          write(*,*) 'stewart_explicit 1558: cas avec calcul J'
-          write(*,*) 'Eqi(il),deltaD=',Eqi(il), &
+    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
-               write(*,*) 'calcul J par simple'
+          if (icas_Jsimple.le.ncas_Jsimple) THEN
+               WRITE(*,*) 'calcul J par simple'
           else
-               write(*,*) 'calcul J par Rieman'
+               WRITE(*,*) 'calcul J par Rieman'
           endif
-          write(*,*) 'stewart_explict 1051: h(il)=',h(il)
-          write(*,*) 'f(il)=',f(il)
-          write(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
+          WRITE(*,*) 'stewart_explict 1051: h(il)=',h(il)
+          WRITE(*,*) 'f(il)=',f(il)
+          WRITE(*,*) 'Eqi(il)*fac_ftmr(il)/qp0(il)=', &
 &              Eqi(il)*fac_ftmr(il)/qp0(il)
-          write(*,*) 'Pqisup,deltaD=',Pqisup(il),deltaD( &
+          WRITE(*,*) 'Pqisup,deltaD=',Pqisup(il),deltaD( &
 &             (Pxtisup(iso_HDO,il)/Pqisup(il)))
-          write(*,*) 'qp0,deltaD=',qp0(il),deltaD( &
+          WRITE(*,*) 'qp0,deltaD=',qp0(il),deltaD( &
 &             (xtp0(iso_HDO,il)/qp0(il)))
-          write(*,*) 'f_cas(icas)=',f_cas(icas_Jsimple)
-          write(*,*) 'g_cas(icas)=',g_cas(icas_Jsimple)
-          write(*,*) 'beta_cas(icas)=', &
+          WRITE(*,*) 'f_cas(icas)=',f_cas(icas_Jsimple)
+          WRITE(*,*) 'g_cas(icas)=',g_cas(icas_Jsimple)
+          WRITE(*,*) 'beta_cas(icas)=', &
 &                   beta_cas(iso_HDO,icas_Jsimple)
-          write(*,*) 'gama_cas(icas)=', &
+          WRITE(*,*) 'gama_cas(icas)=', &
 &                   gama_cas(iso_HDO,icas_Jsimple)
-          write(*,*) 'r_jqp0(icas)=', &
+          WRITE(*,*) 'r_jqp0(icas)=', &
 &                   r_jqp0(iso_HDO,icas_Jsimple)
-          write(*,*) 'r_jl0(icas)=',r_jl0(iso_HDO,icas_Jsimple)
-          write(*,*) 'r_l0qp0(icas)=', &
+          WRITE(*,*) 'r_jl0(icas)=',r_jl0(iso_HDO,icas_Jsimple)
+          WRITE(*,*) 'r_l0qp0(icas)=', &
 &                   r_l0qp0_cas(icas_Jsimple)
-          write(*,*) 'J(icas)=',J(iso_HDO,icas_Jsimple)
-          write(*,*) 'deltaDl0(icas)=',deltaD &
+          WRITE(*,*) 'J(icas)=',J(iso_HDO,icas_Jsimple)
+          WRITE(*,*) 'deltaDl0(icas)=',deltaD &
 &                 ((Rl0_cas(iso_HDO,icas_Jsimple)))
-          write(*,*) 'deltaDb0(icas)=',deltaD &
+          WRITE(*,*) 'deltaDb0(icas)=',deltaD &
 &                 ((Rb0_cas(iso_HDO,icas_Jsimple)))
-          write(*,*) 'deltaDl(icas)=',deltaD &
+          WRITE(*,*) 'deltaDl(icas)=',deltaD &
 &                 ((Rl(iso_HDO,icas_Jsimple)))
-          write(*,*) 'deltaDb(icas)=',deltaD &
+          WRITE(*,*) 'deltaDb(icas)=',deltaD &
 &                 ((Rb(iso_HDO,icas_Jsimple)))
-          write(*,*) 'Pqiinf_cas(icas)=', &
+          WRITE(*,*) 'Pqiinf_cas(icas)=', &
 &                   Pqiinf_cas(icas_Jsimple)
-          write(*,*) 'Eqi_cas(icas)=',Eqi_cas(icas_Jsimple)
-          write(*,*) 'qp0_cas(icas)=',qp0_cas(icas_Jsimple)
-          write(*,*) 'fac_ftmr_cas(icas)=', &
+          WRITE(*,*) 'Eqi_cas(icas)=',Eqi_cas(icas_Jsimple)
+          WRITE(*,*) 'qp0_cas(icas)=',qp0_cas(icas_Jsimple)
+          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  
-END IF !if (ncas_rieman+ncas_Jsimple.gt.0) then
-
-#ifdef ISOVERIF
-          write(*,*) 'stewart_explicite vectall 1179: fin'
+END IF !if (ncas_rieman+ncas_Jsimple.gt.0) THEN
+#ifdef ISOVERIF
+          WRITE(*,*) 'stewart_explicite vectall 1179: fin'
 #endif         
 
@@ -4437,5 +4392,5 @@
 integer ixt,il        
 
-!        write(*,*) 'sttewart_glace 39: entrée'
+!        WRITE(*,*) 'sttewart_glace 39: entrée'
 
 
@@ -4446,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
@@ -4459,14 +4414,14 @@
 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
-        write(*,*) 'stewart_loop 39'
-        write(*,*) 'Pqisup=',Pqisup(il)
-        write(*,*) 'Eqi=',Eqi(il)
-        write(*,*) 'Pqiinf=',Pqiinf(il)
+&            .or.(abs(Eqi(il)).gt.ridicule)) THEN
+        WRITE(*,*) 'stewart_loop 39'
+        WRITE(*,*) 'Pqisup=',Pqisup(il)
+        WRITE(*,*) 'Eqi=',Eqi(il)
+        WRITE(*,*) 'Pqiinf=',Pqiinf(il)
         stop
     endif  
@@ -4478,6 +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
@@ -4490,5 +4444,5 @@
 ! calcul de Pxtiinf et Exi
 ! séparation en 2 cas pour une meilleure convergence numérique        
-IF (f(il).lt.0.9) then
+IF (f(il).lt.0.9) THEN
  do ixt=1,niso   
     Pxtiinf(ixt,il)=Pxtisup(ixt,il)*Pqiinf(il)*zxtalphai(ixt,il) &
@@ -4502,6 +4456,5 @@
     Pxtiinf(ixt,il)=Pxtisup(ixt,il)-Exi(ixt,il)
  enddo !do ixt=1,niso
-END IF !if (f.lt.0.9) then
-
+END IF !if (f.lt.0.9) THEN
 ! verif
 #ifdef ISOVERIF
@@ -4512,13 +4465,13 @@
 &           '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 ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
 #endif
 IF ((bidouille_anti_divergence).and. &
-&            (iso_eau.gt.0)) then
+&            (iso_eau.gt.0)) THEN
   ! assurer la convergence numérique pour ixt=4:
   Exi(iso_eau,il)=Eqi(il)
@@ -4540,16 +4493,16 @@
 END DO !do ixt=1,niso
   if ((iso_HDO.gt.0).and. &
-&            (Pqisup(il).gt.ridicule_rain)) then
+&            (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
 
 ! ************ fin des calculs ***************
 
-!        write(*,*) 'sttewart_glace 155: sortie'
+!        WRITE(*,*) 'sttewart_glace 155: sortie'
 END SUBROUTINE  stewart_glace_vectall
 
@@ -4599,5 +4552,5 @@
 !#endif        
 
-!        write(*,*) 'sttewart_glace 39: entrée'
+!        WRITE(*,*) 'sttewart_glace 39: entrée'
 
 ! quelques verifs de bilan d'eau
@@ -4606,10 +4559,10 @@
 IF (iso_verif_egalite_nostop(( &
 &           Pqisup(il)-Eqi(il)-Pqiinf(il)),0.0, &
-&           'stewart_sublim_nofrac 37').eq.1) then
-  write(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
+&           'stewart_sublim_nofrac 37').eq.1) THEN
+  WRITE(*,*) 'il,Pqisup(il),Eqi(il),Pqiinf(il)=', &
 &          il,Pqisup(il),Eqi(il),Pqiinf(il)         
   stop
 END IF
-IF (iso_eau.gt.0) then
+IF (iso_eau.gt.0) THEN
    CALL iso_verif_egalite((Pqisup(il)), &
 &           (Pxtisup(iso_eau,il)), &
@@ -4618,5 +4571,5 @@
 &           (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), &
@@ -4631,14 +4584,14 @@
 DO il=1,ncas
 ! traitement rapide de quelques cas particuliers:
-IF (Pqisup(il).le.0) then
+IF (Pqisup(il).le.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
-        write(*,*) 'stewart_sublim 57'
-        write(*,*) 'Pqisup=',Pqisup(il)
-        write(*,*) 'Eqi=',Eqi(il)
-        write(*,*) 'Pqiinf=',Pqiinf(il)
+&            .or.(abs(Eqi(il)).gt.ridicule)) THEN
+        WRITE(*,*) 'stewart_sublim 57'
+        WRITE(*,*) 'Pqisup=',Pqisup(il)
+        WRITE(*,*) 'Eqi=',Eqi(il)
+        WRITE(*,*) 'Pqiinf=',Pqiinf(il)
         stop
      endif   
@@ -4648,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
@@ -4658,9 +4611,9 @@
         ! 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)
                    enddo
-                else !if (qp0.gt.ridicule) then
+                else !if (qp0.gt.ridicule) THEN
                    ! il n'y a pas encore de vapeur dans le ddft. On est
                    ! très embétté, mais on se dit que le ddft sera
@@ -4669,13 +4622,13 @@
                      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   !if (qp0.gt.ridicule) then
+                endif   !if (qp0.gt.ridicule) THEN
                 do ixt=1,niso
                   Exi(ixt,il)=Rb0(ixt,il)*Eqi(il)
                   xtnew(ixt,il)=xt(ixt,il)+Exi(ixt,il)*fac_ftmr(il)
                 enddo !do ixt=1,niso
-            else !if (abs(Eqi*fac_ftmr).gt.ridicule) then
+            else !if (abs(Eqi*fac_ftmr).gt.ridicule) THEN
                 ! ça va, tout est logique, tous les flux d'eau sont nuls
                 do ixt=1,niso
@@ -4683,7 +4636,7 @@
                   Exi(ixt,il)=0.0
                 enddo !do ixt=1,niso
-            endif !if (abs(Eqi*fac_ftmr).gt.ridicule) then
-#ifdef ISOVERIF
-              if (iso_eau.gt.0) then
+            endif !if (abs(Eqi*fac_ftmr).gt.ridicule) THEN
+#ifdef ISOVERIF
+              if (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite_choix( &
                    (Exi(iso_eau,il)*fac_ftmr(il)), &
@@ -4700,6 +4653,5 @@
                endif
 #endif
-        else !if (Pqisup(il).le.0) then
-
+        else !if (Pqisup(il).le.0) THEN
         ! dorénavant, Pqisup est différenent de 0
         
@@ -4719,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)), &
@@ -4725,9 +4677,9 @@
            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 ((iso_eau.gt.0).and.(ixt.eq.iso_eau)) THEN
 #endif
 
          if ((bidouille_anti_divergence).and. &
-                 (iso_eau.gt.0)) then
+                 (iso_eau.gt.0)) THEN
           ! assurer la convergence numérique pour ixt=4:
           Exi(iso_eau,il)=Eqi(il)          
@@ -4749,29 +4701,29 @@
         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_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
-              write(*,*) 'q(il)=',q(il)
-              write(*,*) 'Eqi(il)=',Eqi(il)
-              write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
+                        errmax,errmaxrel).eq.1) THEN
+              WRITE(*,*) 'q(il)=',q(il)
+              WRITE(*,*) 'Eqi(il)=',Eqi(il)
+              WRITE(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
               stop
             endif !if (iso_verif_egalite_choix_nostop
-            endif !if (q(il)+Eqi(il)*fac_ftmr(il).ge.0.0) then
+            endif !if (q(il)+Eqi(il)*fac_ftmr(il).ge.0.0) THEN
             if (iso_verif_egalite_choix_nostop( &
                         (Pxtiinf(iso_eau,il)), &
                         (Pqiinf(il)),'stewart_sublim 204', &
-                        errmax,errmaxrel).eq.1) then
-              write(*,*) 'Pqisup(il)=',Pqisup(il)
+                        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
@@ -4783,5 +4735,5 @@
         ! ************ fin des calculs ***************
 
-!        write(*,*) 'sttewart_sublim 155: sortie'
+!        WRITE(*,*) 'sttewart_sublim 155: sortie'
         END SUBROUTINE  stewart_sublim_nofrac_vectall
 
@@ -4848,15 +4800,15 @@
 
 #ifdef ISOVERIF
-!         write(*,*) 'compress_stewart 45: entrée compress_calculJ'
-!         write(*,*) 'ncas_Jsimple=',ncas_Jsimple
+!         WRITE(*,*) 'compress_stewart 45: entrée compress_calculJ'
+!         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
+!           WRITE(*,*) 'compress_stewart 50: il=',il
            m0_cas(il)=m0(cas_Jsimple(il))
-!           write(*,*) 'compress_stewart 51: il=',il
+!           WRITE(*,*) 'compress_stewart 51: il=',il
            m_cas(il)=m(cas_Jsimple(il))
            qp0_cas(il)=qp0(cas_Jsimple(il))
-!           write(*,*) 'compress_stewart 54: il=',il
+!           WRITE(*,*) 'compress_stewart 54: il=',il
            A_cas(il)=A(cas_Jsimple(il))                     
            f_cas(il)=f(cas_Jsimple(il))
@@ -4866,14 +4818,14 @@
                 'compress_stewart 66',errmax,errmaxrel)
 #endif           
-!           write(*,*) 'compress_stewart 56: il=',il
+!           WRITE(*,*) 'compress_stewart 56: il=',il
            g_cas(il)=g(cas_Jsimple(il))
            r_l0qp0_cas(il)=r_l0qp0(cas_Jsimple(il))
            Eqi_cas(il)=Eqi(cas_Jsimple(il))
-!           write(*,*) 'compress_stewart 60: il=',il
+!           WRITE(*,*) 'compress_stewart 60: il=',il
            fac_ftmr_cas(il)=fac_ftmr(cas_Jsimple(il))
            Pqiinf_cas(il)=Pqiinf(cas_Jsimple(il))
-!           write(*,*) 'compress_stewart 61: il=',il
+!           WRITE(*,*) 'compress_stewart 61: il=',il
            do ixt=1,niso
-!             write(*,*) 'il,ixt=',il,ixt
+!             WRITE(*,*) 'il,ixt=',il,ixt
              xtp0_cas(ixt,il)=xtp0(ixt,cas_Jsimple(il))
              beta_cas(ixt,il)=beta(ixt,cas_Jsimple(il))
@@ -4884,7 +4836,6 @@
            enddo !do ixt=1,niso
          enddo !do il=1,ncas_Jsimple
-        endif !if (ncas_Jsimple.gt.0) then   
-
-        if (ncas_rieman.gt.0) then 
+        endif !if (ncas_Jsimple.gt.0) THEN
+        if (ncas_rieman.gt.0) THEN
          do il=1,ncas_rieman
            m0_cas(il+ncas_Jsimple)=m0(cas_rieman(il))
@@ -4928,5 +4879,5 @@
 !#endif     
 !#ifdef ISOVERIF           
-!!           write(*,*) ' f,h,ntot_cas=',f(cas_rieman(il)),
+!!           WRITE(*,*) ' f,h,ntot_cas=',f(cas_rieman(il)),
 !!     :           h(cas_rieman(il)),ntot_cas(il+ncas_Jsimple)     
 !           CALL iso_verif_positif(float(ntot_cas(il+ncas_Jsimple))-1.0,
@@ -4934,6 +4885,5 @@
 !#endif           
          enddo !do il=1,ncas_rieman
-       endif !if (ncas_rieman.gt.0) then 
-                
+       endif !if (ncas_rieman.gt.0) THEN
 #ifdef ISOVERIF
         ! vérif de la compression:
@@ -4951,5 +4901,5 @@
                  'compress_stewart  117',errmax,errmaxrel)
         enddo !do icas_Jsimple=1,ncas_Jsimple
-!       write(*,*) 'compress_stewart 91: fin compress_calculJ'   
+!       WRITE(*,*) 'compress_stewart 91: fin compress_calculJ'
 #endif  
        
@@ -5111,6 +5061,6 @@
             qp_cas(il)=qp(cas(il))
             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)
+                '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)
             endif !if (iso_verif_positif_nostop
@@ -5188,6 +5138,6 @@
             evap_cas(il)=evap(cas(il))
             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)
+                '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)
             endif !if (iso_verif_positif_nostop
@@ -5363,5 +5313,5 @@
           do il=1,ncas
             if ((water(cas(il)).gt.ridicule/100).and. &
-                  (Pqiinf_par(cas(il)).le.0.0)) then
+                  (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
              ! alors que le bilan de masse n'enprédit pas.
@@ -5369,13 +5319,13 @@
              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
+                else !if (Eqi(cas(il)).gt.0.0) THEN
                     ! cas ajouté le 7 dec 2012: si Eqi est négatif,
                     ! alors on plante dans compress_stewart 977b
@@ -5384,7 +5334,7 @@
                     ! très faible)
                    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 (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
          enddo !do il=1,ncas
 
@@ -5396,16 +5346,16 @@
               .or.(iso_verif_positif_nostop(( &
               Eqi_stewart(il))*fac_ftmr_cas(il), &
-              'compress_stewart 977b').eq.1)) then
-              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
-              write(*,*) 'Pqisup=',Pqisup(cas(il))
-              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
-              write(*,*) 'Eqi=',Eqi(cas(il))
-              write(*,*) 'Eqi_par=',Eqi_par(cas(il))
-              write(*,*) 'Eqi_prime=',Eqi_prime(cas(il))
-              write(*,*) 'Eqi_stewart=',Eqi_stewart(il)
-              write(*,*) 'il,cas=',il,cas(il)
-              write(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
-              write(*,*) 'qp_avantevap_cas=',qp_avantevap_cas(il)
-              write(*,*) 'qp_cas=',qp_cas(il)
+              'compress_stewart 977b').eq.1)) THEN
+              WRITE(*,*) 'Pqiinf=',Pqiinf(cas(il))
+              WRITE(*,*) 'Pqisup=',Pqisup(cas(il))
+              WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
+              WRITE(*,*) 'Eqi=',Eqi(cas(il))
+              WRITE(*,*) 'Eqi_par=',Eqi_par(cas(il))
+              WRITE(*,*) 'Eqi_prime=',Eqi_prime(cas(il))
+              WRITE(*,*) 'Eqi_stewart=',Eqi_stewart(il)
+              WRITE(*,*) 'il,cas=',il,cas(il)
+              WRITE(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
+              WRITE(*,*) 'qp_avantevap_cas=',qp_avantevap_cas(il)
+              WRITE(*,*) 'qp_cas=',qp_cas(il)
               stop
           endif
@@ -5419,10 +5369,10 @@
         do il=1,ncas
           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)
-              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
-              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
-              write(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
+                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+              WRITE(*,*) 'compress_stewart 498: evap liq:'
+              WRITE(*,*) 'water(il,i)=', water_cas(il)
+              WRITE(*,*) 'Pqiinf=',Pqiinf(cas(il))
+              WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
+              WRITE(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
               stop                   
           endif
@@ -5462,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
@@ -5516,13 +5466,12 @@
           enddo  !do il=1,ncas  
 
-!       write(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
+!       WRITE(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
 !     :   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))           
             enddo !do il=1,ncas     
-          endif !if (frac_sublim) then
-
+          endif !if (frac_sublim) THEN
           ! calculs des flux de masses à mettre en argument de stewart:
       ! comme l'eau n'est pas bien concervée dans les ddfts, on est
@@ -5536,5 +5485,5 @@
           do il=1,ncas
             if ((water(cas(il)).gt.ridicule/100).and. &
-                  (Pqiinf_par(cas(il)).le.0.0)) then
+                  (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
              ! alors que le bilan de masse n'enprédit pas.
@@ -5542,10 +5491,10 @@
              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!
@@ -5553,5 +5502,5 @@
                      (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
+                     (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))
@@ -5559,6 +5508,6 @@
                      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 (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 
 
@@ -5566,16 +5515,16 @@
 #ifdef ISOVERIF        
 !        il=1  
-!        write(*,*) 'compress_stewart 1249& il=',il
-!        write(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
-!        write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
-!        write(*,*) 'Pqisup_cas=',Pqisup_cas(il)
+!        WRITE(*,*) 'compress_stewart 1249& il=',il
+!        WRITE(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
+!        WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
+!        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
-              write(*,*) 'compress_stewart 498: evap glace:'
-              write(*,*) 'water(il,i)=', water_cas(il)
-              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
-              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
-              write(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
+                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+              WRITE(*,*) 'compress_stewart 498: evap glace:'
+              WRITE(*,*) 'water(il,i)=', water_cas(il)
+              WRITE(*,*) 'Pqiinf=',Pqiinf(cas(il))
+              WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
+              WRITE(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
               stop                   
           endif
@@ -5760,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
@@ -5766,7 +5715,7 @@
          
 #ifdef ISOVERIF
-        if (iso_eau.gt.0) then
+        if (iso_eau.gt.0) THEN
             do il=1,ncas
-!              write(*,*) 'il=',il
+!              WRITE(*,*) 'il=',il
               CALL iso_verif_egalite_choix(zrfl_ancien(cas(il)), &
                  zxtrfl_ancien(iso_eau,cas(il)), &
@@ -5778,5 +5727,5 @@
                  errmax,errmaxrel)
             enddo
-        endif  !if (iso_eau.gt.0) then
+        endif  !if (iso_eau.gt.0) THEN
 #endif
 
@@ -5834,11 +5783,11 @@
         
         ! *** verifs
-!        write(*,*) 'ntot=',ntot
+!        WRITE(*,*) 'ntot=',ntot
         
 #ifdef ISOVERIF     
       do il=1,ncas   
-        if (m0(il).lt.m(il)) then
-            write(*,*) 'integrale_rieman 25'
-            write(*,*) 'binf=',m(il),' bsup=',m0(il)
+        if (m0(il).lt.m(il)) THEN
+            WRITE(*,*) 'integrale_rieman 25'
+            WRITE(*,*) 'binf=',m(il),' bsup=',m0(il)
             stop
         endif
@@ -5846,17 +5795,17 @@
 #endif        
 
-!        write(*,*) 'binf=',binf,' bsup=',bsup
+!        WRITE(*,*) 'binf=',binf,' bsup=',bsup
         
         !*** 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
@@ -5865,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
@@ -5874,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
@@ -5886,5 +5835,5 @@
            w(5)=0.23692688505618908751
         else
-            write(*,*) 'integrale gauss: non prévu: ndeg=',ndeg
+            WRITE(*,*) 'integrale gauss: non prévu: ndeg=',ndeg
             stop
         endif  
@@ -5967,7 +5916,7 @@
        ! end verif
             
-!       write(*,*) 'I=',I
-!       write(*,*) 'Imax=',Imax,'Imin=',Imin
-!       write(*,*) 'e=',e
+!       WRITE(*,*) 'I=',I
+!       WRITE(*,*) 'Imax=',Imax,'Imin=',Imin
+!       WRITE(*,*) 'e=',e
 
        END SUBROUTINE  integrale_gauss_vectall
@@ -5999,5 +5948,5 @@
 &       compress_cond_facftmr_zone,compress_cond_nofftmr_zone
 #ifdef ISOVERIF
-USE isotrac_routines_mod, only: iso_verif_traceur_pbidouille
+USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
 #endif
 #endif
@@ -6109,10 +6058,10 @@
               
 
-!      write(*,*) 'appel stewart 48: entrée, i=',i
+!      WRITE(*,*) 'appel stewart 48: entrée, i=',i
 
       ! definition de quelques constantes:
 
       !gravité:
-      if (cvflag_grav) then
+      if (cvflag_grav) THEN
           g=1/ginv
       else
@@ -6133,12 +6082,12 @@
       
 #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
+      endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
       do il=1,ncum
@@ -6148,22 +6097,21 @@
 #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)
-            endif !if (iso_eau.gt.0) then
+            endif !if (iso_eau.gt.0) THEN
             do ixt=1,ntraciso
               CALL iso_verif_noNAN(xtevap(ixt,il,j), &
@@ -6175,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 
 
@@ -6194,18 +6142,18 @@
       
       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
+        else !if (Mp(il,i).gt.Mp(il,i+1)) THEN
+          if (Mp(il,i+1).gt.Mpmin) THEN
               ! cas non entrainant, mais flux existe
               fac_ftmr(il)=1.0/Mp(il,i+1)
-          else !if (Mp(il,i+1).gt.Mpmin) then
+          else !if (Mp(il,i+1).gt.Mpmin) THEN
               ! pas de flux de masse, XTP reste constant
               fac_ftmr(il)=0.0
-          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 !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
       enddo !do il=1,ncum
 
@@ -6213,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)
@@ -6223,6 +6171,6 @@
                  +xt(ixt,il,i)*(1-rat(il))
           enddo
-         else !if (Mp(il,i).gt.Mp(il,i+1)) then
-           if (Mp(il,i+1).gt.Mpmin) then
+         else !if (Mp(il,i).gt.Mp(il,i+1)) THEN
+           if (Mp(il,i+1).gt.Mpmin) THEN
               ! cas non entrainant, mais flux existe
               qp_avantevap(il)=qp(il,i+1)
@@ -6231,6 +6179,5 @@
               enddo
               
-           else    !if (Mp(il,i+1).gt.0) then    
-              
+           else    !if (Mp(il,i+1).gt.0) THEN
               ! pas de flux de masse, on ne calcule rien
               ! on garde le qp calculé dans cv3_unsat, original
@@ -6238,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), &
@@ -6246,15 +6193,12 @@
                  xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
                 enddo
-              else !if (qp(il,i).gt.0) then
+              else !if (qp(il,i).gt.0) THEN
                   ! si qp est négatif, on met les isos dedans à 0
                 do ixt=1,ntraciso
                  xtp_avantevap(ixt,il)=0.0
                 enddo
-              endif !if (qp(il,i).gt.0) then
-               
-          endif !if (Mp(il,i+1).gt.0) then
-          
-         endif  !if (Mp(il,i).gt.Mp(il,i+1)) then
-      
+              endif !if (qp(il,i).gt.0) THEN
+          endif !if (Mp(il,i+1).gt.0) THEN
+         endif  !if (Mp(il,i).gt.Mp(il,i+1)) THEN
         else ! if i.lt.INB
           ! cas ou i=inb
@@ -6263,29 +6207,29 @@
           ! 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)
             enddo
-          else !if (qp(il,i).gt.0) then
+          else !if (qp(il,i).gt.0) THEN
               ! si qp négatif, on met les isotopes dedans à 0
             do ixt=1,ntraciso
              xtp_avantevap(ixt,il)=0.0
             enddo
-          endif !if (qp(il,i).gt.0) then
+          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
+      endif !if (iso_eau.gt.0) THEN
 #endif
 
@@ -6294,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
@@ -6309,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', &
@@ -6321,12 +6265,12 @@
 !#ifdef ISOTRAC
 !        if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) then
+!     :           (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
-!          write(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
-!          write(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
-!          write(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
+!     :          'appel_stewart 332').eq.1) THEN
+!          WRITE(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
+!          WRITE(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
+!          WRITE(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
 !          stop
 !        endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
@@ -6336,18 +6280,18 @@
         
 !      il=370 
-!      write(*,*) 'appel_stewart 327: il=',il
-!      write(*,*) 'Pqisup,Pqiinf,Eqi_prime,Eqi,Pqiinf_par,Eqi_par=',
+!      WRITE(*,*) 'appel_stewart 327: il=',il
+!      WRITE(*,*) 'Pqisup,Pqiinf,Eqi_prime,Eqi,Pqiinf_par,Eqi_par=',
 !     :     Pqisup(il),Pqiinf(il),Eqi_prime(il),Eqi(il),
 !     :     Pqiinf_par(il),Eqi_par(il)
-!      write(*,*) 'fac_ftmr=',fac_ftmr(il)
-!      write(*,*) 'qp_avantevap,qp=',qp_avantevap(il),qp(il,i)
+!      WRITE(*,*) 'fac_ftmr=',fac_ftmr(il)
+!      WRITE(*,*) 'qp_avantevap,qp=',qp_avantevap(il),qp(il,i)
 #endif      
 
       ! petite vérif sur les flux
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) 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
+               .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
@@ -6355,8 +6299,8 @@
             ! l'eau sortant, Eqi_par<0 -> condensation! On est donc très
             ! embétté car Eqi_prime indique qu'il y a évaporation...   
-!            write(*,*) 'appel_stewart 239: cas génant'  
+!            WRITE(*,*) 'appel_stewart 239: cas génant'
 
             if (Eqi_prime(il)*fac_ftmr(il).lt. &
-                qp_avantevap(il)*1e-2) then
+                qp_avantevap(il)*1e-2) THEN
                 ! ouf: Eqi_prime a peut d'effet sur la vapeur du ddft.
                 ! on peut donc condenser tranquillement pour obtenir de
@@ -6365,12 +6309,12 @@
                 Eqi_prime(il)=Eqi_par(il)
             else
-             write(*,*) 'appel_stewart 222: ce cas est très génant'
+             WRITE(*,*) 'appel_stewart 222: ce cas est très génant'
              stop
             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)
@@ -6389,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
@@ -6395,17 +6339,17 @@
         endif
       enddo !do il=1,ncum
-!      if (ncum.ge.602) then
-!          write(*,*) 'appel_stewart tmp 379: avant parsage'
+!      if (ncum.ge.602) THEN
+!          WRITE(*,*) 'appel_stewart tmp 379: avant parsage'
 !          il=602
-!          write(*,*) 'il,Eqi_prime(il)=',il,Eqi_prime(il)
-!          write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
-!          write(*,*) 'ridicule,errmax=',ridicule,errmax
+!          WRITE(*,*) 'il,Eqi_prime(il)=',il,Eqi_prime(il)
+!          WRITE(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
+!          WRITE(*,*) 'ridicule,errmax=',ridicule,errmax
 !      endif
 #endif      
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) then 
-!        write(*,*) 'tmp 417: il,Eqi_prime=',il,Eqi_prime(il)   
+       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. &
-              (Eqi_prime(il)*fac_ftmr(il).lt.-ridicule*10)) then
+              (Eqi_prime(il)*fac_ftmr(il).lt.-ridicule*10)) THEN
             ! modif le 10 mai 2009: si Eqi_prime très petit, on le
             ! traite comme du 0
@@ -6414,6 +6358,6 @@
             ! noevap
           ! 1: Eqi_prime<0: condensation
-!          write(*,*) 'tmp 426: condensation'
-          if (fac_ftmr(il).gt.ridicule/100.) then
+!          WRITE(*,*) 'tmp 426: condensation'
+          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
@@ -6423,5 +6367,5 @@
             trace_cas(il)=11
 #endif            
-          else !if (fac_ftmr.gt.0.0) then
+          else !if (fac_ftmr.gt.0.0) THEN
             ! 1.2: si Mpi=0
             icas_condensation_nofacftmr=icas_condensation_nofacftmr+1  
@@ -6430,9 +6374,9 @@
             trace_cas(il)=12
 #endif
-          endif !if (fac_ftmr.gt.0.0) then
+          endif !if (fac_ftmr.gt.0.0) THEN
 !        else if ((abs(Eqi_prime(il)).lt.ridicule*1e-3).and.
-!     :      (abs(Eqi_prime(il)*fac_ftmr(il)).lt.ridicule*10)) then 
+!     :      (abs(Eqi_prime(il)*fac_ftmr(il)).lt.ridicule*10)) THEN
         else if ((Eqi_prime(il).lt.ridicule*1e-3).and. & 
-           (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) then
+           (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) THEN
             ! 2: Eqi_prime est compris entre 1e-14 et -1e-14: rien 
 !            ! 27 mai 2009: on remplace le seuil pour Eqi_prime(il)*fac_ftmr(il)
@@ -6445,5 +6389,5 @@
             ! dans le trou entre condensation et noevap, et ça part dans
             ! l'évap positive! -> on enlève la valeur absolue.
-!            write(*,*) 'tmp 457: noevap'
+!            WRITE(*,*) 'tmp 457: noevap'
             icas_noevap=icas_noevap+1  
             cas_noevap(icas_noevap)=il
@@ -6451,42 +6395,42 @@
             trace_cas(il)=2
             if ((Pqisup(il).le.0.0).and. &
-                (water(il,i).gt.ridicule)) then
-            write(*,*) 'appel_stewart 420: water=',water(il,i)
-            write(*,*) 'Pqisup,Eqi_prime,fac_ftmr=',Pqisup(il), &
+                (water(il,i).gt.ridicule)) THEN
+            WRITE(*,*) 'appel_stewart 420: water=',water(il,i)
+            WRITE(*,*) 'Pqisup,Eqi_prime,fac_ftmr=',Pqisup(il), &
                  Eqi_prime(il),fac_ftmr(il)
             stop
          endif
 #endif
-        else    !if (Eqi_prime.lt.0.0) then
+        else    !if (Eqi_prime.lt.0.0) THEN
         ! 3: Eqi_prime>0 
 #ifdef ISOVERIF  
-!        write(*,*) 'tmp 473: evap'
+!        WRITE(*,*) 'tmp 473: evap'
         ! quelques vérifs du bilan de masse d'eau 
              if (iso_verif_positif_nostop(( &
                  Pqisup(il)-Eqi_prime(il)), &
-                 'appel_stewart 388').eq.1) then
-               write(*,*) 'Pqisup=',Pqisup(il)
-               write(*,*) 'Eqi_prime=',Eqi_prime(il)
-               write(*,*) 'Pqiinf=',Pqiinf(il)
-!               write(*,*) 'stop temporaire, à enlever'
+                 'appel_stewart 388').eq.1) THEN
+               WRITE(*,*) 'Pqisup=',Pqisup(il)
+               WRITE(*,*) 'Eqi_prime=',Eqi_prime(il)
+               WRITE(*,*) 'Pqiinf=',Pqiinf(il)
+!               WRITE(*,*) 'stop temporaire, à enlever'
 !               stop
               endif
               if (iso_verif_positif_choix_nostop(( &
                 Pqisup(il)-Pqiinf_par(il)),errmax, &
-                'appel_stewart 442').eq.1) then
-                write(*,*) 'appel_stewart 174'
-                write(*,*) 'Pqisup=',Pqisup(il), &
+                'appel_stewart 442').eq.1) THEN
+                WRITE(*,*) 'appel_stewart 174'
+                WRITE(*,*) 'Pqisup=',Pqisup(il), &
                 ' Pqiinf_par=',Pqiinf_par(il)
                 stop
               endif               
               if (iso_verif_positif_nostop((Eqi_par(il)), &
-                'appel_stewart 559b').eq.1) then
-                write(*,*) 'Eqi(il),Eqi_plus1(il),Eqi_prime(il)=', &
+                'appel_stewart 559b').eq.1) THEN
+                WRITE(*,*) 'Eqi(il),Eqi_plus1(il),Eqi_prime(il)=', &
                        Eqi(il),Eqi_plus1(il),Eqi_prime(il)
-                write(*,*) 'Pqisup(il),Pqiinf(il),Eqi_par(il)=', &
+                WRITE(*,*) 'Pqisup(il),Pqiinf(il),Eqi_par(il)=', &
                         Pqisup(il),Pqiinf(il),Eqi_par(il)
               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  
@@ -6495,5 +6439,5 @@
                 trace_cas(il)=31
 #endif
-              else !if (T(il,i).ge.ztglace_kelvin) then
+              else !if (T(il,i).ge.ztglace_kelvin) THEN
                 ! 3.2: evap de la glace
                 icas_evap_glace=icas_evap_glace+1  
@@ -6502,7 +6446,7 @@
                 trace_cas(il)=32
 #endif  
-              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 (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
       enddo  !do il=1,ncum 
 
@@ -6514,27 +6458,27 @@
 
 #ifdef ISOVERIF
-!      write(*,*) 'appel_stewart vectoriel 355: parsage des cas:'
-!      if (ncum.ge.602) then
-!          write(*,*) 'trace_cas(602)=',trace_cas(602)
+!      WRITE(*,*) 'appel_stewart vectoriel 355: parsage des cas:'
+!      if (ncum.ge.602) THEN
+!          WRITE(*,*) 'trace_cas(602)=',trace_cas(602)
 !      endif  
       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
       enddo
-!      write(*,*) 'i,ncum,ncas_tot=',i,ncum,ncas_tot
-!      write(*,*) 'ncas_condensation_facftmr=',ncas_condensation_facftmr
-!      write(*,*) 'ncas_condensation_nofacftmr=',
+!      WRITE(*,*) 'i,ncum,ncas_tot=',i,ncum,ncas_tot
+!      WRITE(*,*) 'ncas_condensation_facftmr=',ncas_condensation_facftmr
+!      WRITE(*,*) 'ncas_condensation_nofacftmr=',
 !     :            ncas_condensation_nofacftmr
-!      write(*,*) 'ncas_noevap=',ncas_noevap
-!      write(*,*) 'ncas_evap_liq_=',ncas_evap_liq
-!      write(*,*) 'ncas_evap_glace=',ncas_evap_glace
+!      WRITE(*,*) 'ncas_noevap=',ncas_noevap
+!      WRITE(*,*) 'ncas_evap_liq_=',ncas_evap_liq
+!      WRITE(*,*) 'ncas_evap_glace=',ncas_evap_glace
       if (ncas_tot.ne.ncas_condensation_facftmr &
                +ncas_condensation_nofacftmr&
                +ncas_noevap&
                +ncas_evap_liq &
-               +ncas_evap_glace) then
-         write(*,*) 'mauvais parsage'
+               +ncas_evap_glace) THEN
+         WRITE(*,*) 'mauvais parsage'
          stop
        endif !if (ncas_tot.ne.ncas_condensation_facftmr
@@ -6544,6 +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, &
@@ -6566,9 +6509,9 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-      write(*,*) 'appel_stewart tmp 506: ', &
+      WRITE(*,*) 'appel_stewart tmp 506: ', &
                 'après compress_condensation_facftmr'
-      write(*,*) 'cas_condensation_facftmr(1)=', &
+      WRITE(*,*) 'cas_condensation_facftmr(1)=', &
                 cas_condensation_facftmr(1)
-      write(*,*) 'sigd_cas(1:3)=',sigd_cas(1:3)  
+      WRITE(*,*) 'sigd_cas(1:3)=',sigd_cas(1:3)
       do il=1,ncas_condensation_facftmr
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -6580,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 +6529,5 @@
               'appel_stewart 520: compression condensation_facftmr',&
               errmax,errmax)
-        endif ! if (iso_eau.gt.0) then
+        endif ! if (iso_eau.gt.0) THEN
       enddo ! do il=1,ncas_condensation_facftmr
 #endif                  
@@ -6623,5 +6566,5 @@
 
 !#ifdef ISOVERIF     
-!       write(*,*) 'appel_stewart tmp 538: condensation_facftmr, izone=',
+!       WRITE(*,*) 'appel_stewart tmp 538: condensation_facftmr, izone=',
 !     &         izone
 !#endif      
@@ -6643,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( &
@@ -6650,5 +6593,5 @@
                 'appel_stewart 558',errmax,errmaxrel)
           enddo !do il=1,ncas_condensation_nofacftmr
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif
         CALL make_condensation_facftmr(ncas_condensation_facftmr, &
@@ -6682,17 +6625,17 @@
 
 #ifdef ISOVERIF
-!        write(*,*) 'appel_stewart tmp 574: ',
+!        WRITE(*,*) 'appel_stewart tmp 574: ',
 !     :           'fin cas condensation_facftmr'
             do il=1,ncas_condensation_facftmr
-!               write(*,*) 'il,cas_condensation_facftmr(il)=',
+!               WRITE(*,*) 'il,cas_condensation_facftmr(il)=',
 !     :           il,cas_condensation_facftmr(il)
-!               write(*,*) 'xtp(1:ntraciso:3)=',xtp(1:ntraciso:3,
+!               WRITE(*,*) 'xtp(1:ntraciso:3)=',xtp(1:ntraciso:3,
 !     :           cas_condensation_facftmr(il),i)
-!               write(*,*) 'xtp_avantevap(1:ntraciso:3)=',
+!               WRITE(*,*) 'xtp_avantevap(1:ntraciso:3)=',
 !     :           xtp_avantevap(1:ntraciso:3,
 !     :           cas_condensation_facftmr(il))
-!               if (il.eq.cas_condensation_facftmr(602)) then
-!                write(*,*) 'appel_stewart 638: il=602'
-!                write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
+!               if (il.eq.cas_condensation_facftmr(602)) THEN
+!                WRITE(*,*) 'appel_stewart 638: il=602'
+!                WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
 !     :           xtp(iso_eau:ntraciso:3,cas_condensation_facftmr(il),i)
 !               endif
@@ -6712,11 +6655,8 @@
         !#ifdef ISOTRAC    
 
-           endif !if (ncas_condensation_facftmr.gt.0) then
-
-
+           endif !if (ncas_condensation_facftmr.gt.0) THEN
         ! ****** 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, &
@@ -6739,7 +6679,7 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-!      write(*,*) 'appel_stewart tmp 616: ', &
+!      WRITE(*,*) 'appel_stewart tmp 616: ', &
 !     &           'après compress condensation_nofacftmr'
-!      write(*,*) 'iso_routines 6854: sigd_cas(1:3)=', sigd_cas(1:3)
+!      WRITE(*,*) 'iso_routines 6854: sigd_cas(1:3)=', sigd_cas(1:3)
       do il=1,ncas_condensation_nofacftmr
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -6778,5 +6718,5 @@
 #ifdef ISOTRAC
        do izone=1,ntraceurs_zone
-!         write(*,*) 'appel_stewart 718: izone=',izone
+!         WRITE(*,*) 'appel_stewart 718: izone=',izone
 
          CALL compress_cond_nofftmr_zone( &
@@ -6818,5 +6758,5 @@
        enddo !do izone=1,ntraceurs_zone
 #ifdef ISOVERIF
-!       write(*,*) 'appel_stewart tmp 690: ',
+!       WRITE(*,*) 'appel_stewart tmp 690: ',
 !     :           'fin du cas condensation_nofacftmr'
             do il=1,ncas_condensation_nofacftmr
@@ -6835,10 +6775,8 @@
 #endif            
        
-        endif !if (ncas_condensation_nofacftmr.gt.0) then
-
-        
+        endif !if (ncas_condensation_nofacftmr.gt.0) THEN
         ! ****** traitement vectoriel du cas 2
 
-      if (ncas_noevap.gt.0) then
+      if (ncas_noevap.gt.0) THEN
       CALL compress_noevap(ncas_noevap, &
          cas_noevap, &
@@ -6856,5 +6794,5 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-!      write(*,*) 'appel stewart 719: après compression iso noevap'
+!      WRITE(*,*) 'appel stewart 719: après compression iso noevap'
       do il=1,ncas_noevap
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -6864,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)), &
@@ -6877,5 +6815,5 @@
                 qp_cas(il), &
                 'appel_stewart 735',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
       enddo !do il=1,ncas_noevap
 #endif      
@@ -6913,5 +6851,5 @@
 
 #ifdef ISOVERIF
-!        write(*,*) 'appel stewart 765: après compression isotrac'
+!        WRITE(*,*) 'appel stewart 765: après compression isotrac'
         do il=1,ncas_noevap
           CALL iso_verif_egalite_choix( &
@@ -6938,5 +6876,5 @@
 
 #ifdef ISOVERIF
-!        write(*,*) 'appel_stewart tmp 806: ',
+!        WRITE(*,*) 'appel_stewart tmp 806: ',
 !     :           'fin du cas noevap'
        do il=1,ncas_noevap
@@ -6952,12 +6890,8 @@
 #endif       
 
-        endif !if (ncas_noevap.gt.0) then
-
-
+        endif !if (ncas_noevap.gt.0) THEN
         ! ****** 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, &
@@ -6986,9 +6920,9 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-!      write(*,*) 'appel_stewart tmp 899: ',
+!      WRITE(*,*) 'appel_stewart tmp 899: ',
 !     :           'après compress_evap_liq'
       do il=1,ncas_evap_liq
-!       write(*,*) 'il=',il
-!      write(*,*) 'qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il)=',
+!       WRITE(*,*) 'il=',il
+!      WRITE(*,*) 'qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il)=',
 !     :    qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il) 
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -7005,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)), &
@@ -7019,9 +6953,9 @@
       enddo   !do il=1,ncas_evap_liq
 
-!      write(*,*) 'appel tmp 802: xtp_avantevap_cas(iso_eau,2)=',
+!      WRITE(*,*) 'appel tmp 802: xtp_avantevap_cas(iso_eau,2)=',
 !     :           xtp_avantevap_cas(iso_eau,2)
-!      write(*,*) 'appel tmp 1490: qp_avantevap_cas(2)=',
+!      WRITE(*,*) 'appel tmp 1490: qp_avantevap_cas(2)=',
 !     :           qp_avantevap_cas(2)
-!       write(*,*) 'appel_stewart 933: make_cas_evap_liq pr eau normale'
+!       WRITE(*,*) 'appel_stewart 933: make_cas_evap_liq pr eau normale'
 
        ! ici, ptrac ne sera pas utilisé
@@ -7054,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
@@ -7069,8 +7003,8 @@
       do izone=1,ntraceurs_zone      
       
-!       write(*,*) 'appel_stewart 924 tmp: cas liq: izone=',izone 
-!       write(*,*) 'appel 924: xtp_avantevap(c,cas(2))=',
+!       WRITE(*,*) 'appel_stewart 924 tmp: cas liq: izone=',izone
+!       WRITE(*,*) 'appel 924: xtp_avantevap(c,cas(2))=',
 !     :           xtp_avantevap(1:ntraciso:3,cas_evap_liq(2))
-!       write(*,*) 'Pxtisup(1:ntraciso:3,cas(2))=',
+!       WRITE(*,*) 'Pxtisup(1:ntraciso:3,cas(2))=',
 !     :           Pxtisup(1:ntraciso:3,cas_evap_liq(2))
        CALL compress_evap_liq_zone(30,ncas_evap_liq, &
@@ -7093,23 +7027,23 @@
 
 #ifdef ISOVERIF
-!       write(*,*) 'appel_stewart tmp 941'
-!       if (ncas_evap_liq.ge.162) then
-!          write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(162)
-!           write(*,*) 'Pqisup=',Pqisup(cas_evap_liq(162))
-!           write(*,*) 'Eqi_prime=',Eqi_prime(cas_evap_liq(162))
-!           write(*,*) 'Pxtisup=',
+!       WRITE(*,*) 'appel_stewart tmp 941'
+!       if (ncas_evap_liq.ge.162) THEN
+!          WRITE(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(162)
+!           WRITE(*,*) 'Pqisup=',Pqisup(cas_evap_liq(162))
+!           WRITE(*,*) 'Eqi_prime=',Eqi_prime(cas_evap_liq(162))
+!           WRITE(*,*) 'Pxtisup=',
 !     :           Pxtisup(iso_eau:ntraciso:3,cas_evap_liq(162))
 !       endif
-!        write(*,*) 'qp_avantevap_cas(2)=',
+!        WRITE(*,*) 'qp_avantevap_cas(2)=',
 !     :           qp_avantevap_cas(2)
-!       write(*,*) 'xtp_avantevap(iso_eau,cas_evap_liq(1))=',
+!       WRITE(*,*) 'xtp_avantevap(iso_eau,cas_evap_liq(1))=',
 !     :           xtp_avantevap(iso_eau,cas_evap_liq(1))
-!       write(*,*) 'xtp_avantevap_cas(iso_eau,2)=',
+!       WRITE(*,*) 'xtp_avantevap_cas(iso_eau,2)=',
 !     :           xtp_avantevap_cas(iso_eau,2)
-!       write(*,*) 'xtp_avantevaptrac_cas(iso_eau,2)=',
+!       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
+!             WRITE(*,*) 'appel_stewart tmp 943: il=',il
              CALL iso_verif_egalite_choix( &
               (qp_avantevap(cas_evap_liq(il))), &
@@ -7133,18 +7067,18 @@
                 errmax,errmaxrel)
 !             if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) then
-!               if (izone.eq.izone_cond) then
+!     :           (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 (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
+       endif !if (iso_eau.gt.0) THEN
 #endif       
 
@@ -7172,13 +7106,13 @@
               '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 (izone.eq.izone_cond) THEN
 !        endif !if ((option_traceurs.eq.17).or.        
       enddo !do il=1,ncas_evap_liq
@@ -7200,25 +7134,25 @@
            
            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))=', &
+                '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
-                 write(*,*) 'cas evap_liq'
-                 write(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
+             if (trace_cas(cas_evap_liq(il)).eq.31) THEN
+                 WRITE(*,*) 'cas evap_liq'
+                 WRITE(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
                    xtp(:,cas_evap_liq(il),i)
-                 write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-                 write(*,*) 'Eqi_stewart(il),Eqi_prime=', &
+                 WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+                 WRITE(*,*) 'Eqi_stewart(il),Eqi_prime=', &
                         Eqi_stewart(il),Eqi_prime(cas_evap_liq(il))
-                 write(*,*) 'Pxtisup(:,cas_evap_liq(il))=', &
+                 WRITE(*,*) 'Pxtisup(:,cas_evap_liq(il))=', &
                         Pxtisup(:,cas_evap_liq(il))
-                 write(*,*) 'xtp_avantevap(:,cas_evap_liq(il))=', &
+                 WRITE(*,*) 'xtp_avantevap(:,cas_evap_liq(il))=', &
                        xtp_avantevap(:,cas_evap_liq(il))
-                 write(*,*) 'Exi(:,cas_evap_liq(il))=', &
+                 WRITE(*,*) 'Exi(:,cas_evap_liq(il))=', &
                        Exi(:,cas_evap_liq(il))
-                 write(*,*) 'T_cas(il)=',T_cas(il)
-                 write(*,*) 'h(il)=',thumxt1+(1.0-thumxt1)* &
+                 WRITE(*,*) 'T_cas(il)=',T_cas(il)
+                 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
@@ -7236,5 +7170,5 @@
            CALL iso_verif_traceur_justmass(xtevap(1,cas_evap_liq(il),i), &
                 'appel_stewart_vectall 1258')
-!           write(*,*) 'appel_stewart tmp 1172: il,i=',il,i          
+!           WRITE(*,*) 'appel_stewart tmp 1172: il,i=',il,i
            CALL iso_verif_traceur(xtwater(1,cas_evap_liq(il),i), &
                 'appel_stewart_vectall 1260')
@@ -7243,14 +7177,8 @@
 #endif
 
-        endif !if (ncas_evap_liq.gt.0) then
-
-       
-        
-
+        endif !if (ncas_evap_liq.gt.0) THEN
                 ! ****** 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, &
@@ -7275,11 +7203,11 @@
 
 #ifdef ISOVERIF
-!      write(*,*) 'appel_stewart tmp 898 après compress glace'
-!      write(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
+!      WRITE(*,*) 'appel_stewart tmp 898 après compress glace'
+!      WRITE(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
 !     :    qp_avantevap_cas(1),qp_avantevap(cas_evap_glace(1))   
       ! vérif de la compression
       do il=1,ncas_evap_glace
-!       write(*,*) 'il=',il
-!      write(*,*) 'qp_avantevap_cas(il),qp_avantevap(cas(il))=',
+!       WRITE(*,*) 'il=',il
+!      WRITE(*,*) 'qp_avantevap_cas(il),qp_avantevap(cas(il))=',
 !     &   qp_avantevap_cas(il),qp_avantevap(cas_evap_glace(il)) 
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -7305,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)), &
@@ -7311,7 +7239,7 @@
               'appel_stewart 919: compression evap_glace',&
                errmax,errmax)
-        endif   !if (iso_eau.gt.0) then   
+        endif   !if (iso_eau.gt.0) THEN
       enddo !do il=1,ncas_evap_glace
-!       write(*,*) 'appel_stewart tmp 1054 appel make_cas_evap_glace'
+!       WRITE(*,*) 'appel_stewart tmp 1054 appel make_cas_evap_glace'
 #endif   
       
@@ -7332,5 +7260,5 @@
 
 !#ifdef ISOVERIF    
-!        write(*,*) 'appel_stewart tmp 1073 après make_cas_evap_glace'
+!        WRITE(*,*) 'appel_stewart tmp 1073 après make_cas_evap_glace'
 !#endif
 
@@ -7346,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
@@ -7355,8 +7283,7 @@
            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
+!       WRITE(*,*) 'tmp appel_stewart 1284: izone=',izone
 
        CALL compress_evap_glace_zone(30, &
@@ -7377,5 +7304,5 @@
 
 !#ifdef ISOVERIF    
-!        write(*,*) 'appel_stewart tmp 1101 CALL make_cas_evap_glace'
+!        WRITE(*,*) 'appel_stewart tmp 1101 CALL make_cas_evap_glace'
 !#endif       
        CALL make_cas_evap_glace(ncas_evap_glace, &
@@ -7395,8 +7322,8 @@
 
 !#ifdef ISOVERIF    
-!        write(*,*) 'appel_stewart tmp 1134 après make_cas_evap_glace'
-!        write(*,*) 'izone,xtp_avantevap_cas(1)=',izone,
+!        WRITE(*,*) 'appel_stewart tmp 1134 après make_cas_evap_glace'
+!        WRITE(*,*) 'izone,xtp_avantevap_cas(1)=',izone,
 !     :            xtp_avantevap_cas(1:niso,1)
-!        write(*,*) 'izone,xtp_avantevaptrac_cas(1)=',izone,
+!        WRITE(*,*) 'izone,xtp_avantevaptrac_cas(1)=',izone,
 !     &           xtp_avantevaptrac_cas(1:niso,1)
 !#endif          
@@ -7413,26 +7340,26 @@
 
 #ifdef ISOVERIF    
-!        write(*,*) 'appel_stewart tmp 1117: ',
+!        WRITE(*,*) 'appel_stewart tmp 1117: ',
 !     :           'fin du cas evap_glace'   
         do il=1,ncas_evap_glace
-!           write(*,*) 'appel_stewart tmp 1146: il=',il            
-!           write(*,*) 'xtp_avantevap=',xtp_avantevap
+!           WRITE(*,*) 'appel_stewart tmp 1146: il=',il
+!           WRITE(*,*) 'xtp_avantevap=',xtp_avantevap
 !     :           (1:ntraciso,cas_evap_glace(il))
-!           write(*,*) 'xtp=',xtp(1:ntraciso,cas_evap_glace(il),i)
+!           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
-             write(*,*) 'il,cas_evap_glace(il)=',il,cas_evap_glace(il)
-             write(*,*) 'trace_cas(cas_evap_glace(il))=', &
+                '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))=', &
                 trace_cas(cas_evap_glace(il))
-             write(*,*) 'cas evap_glace'
-             write(*,*) 'xtp(:,cas_evap_glace(il),i)=', &
+             WRITE(*,*) 'cas evap_glace'
+             WRITE(*,*) 'xtp(:,cas_evap_glace(il),i)=', &
                    xtp(:,cas_evap_glace(il),i)
-             write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-             write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
-             write(*,*) 'Pxtisup(:,cas_evap_glace(il))=', &
+             WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+             WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
+             WRITE(*,*) 'Pxtisup(:,cas_evap_glace(il))=', &
                         Pxtisup(:,cas_evap_glace(il))
-             write(*,*) 'xtp_avantevap(:,cas_evap_glace(il))=', &
+             WRITE(*,*) 'xtp_avantevap(:,cas_evap_glace(il))=', &
                        xtp_avantevap(:,cas_evap_glace(il))
-             write(*,*) 'Exi(:,cas_evap_glace(il))=', &
+             WRITE(*,*) 'Exi(:,cas_evap_glace(il))=', &
                        Exi(:,cas_evap_glace(il))
              ! on laisse quand même une chance
@@ -7449,7 +7376,5 @@
 #endif
 
-        endif !if (ncas_evap_glace.gt.0) then
-
-
+        endif !if (ncas_evap_glace.gt.0) THEN
        ! ****** dernières vérifs et bidouilles
 
@@ -7457,6 +7382,6 @@
 #ifdef ISOVERIF
         do il=1,ncum 
-           if (i.le.inb(il) .and. lwork(il)) then
-!             write(*,*) 'appel_stewart 1380 temp: il,trace_cas(il)=',
+           if (i.le.inb(il) .and. lwork(il)) THEN
+!             WRITE(*,*) 'appel_stewart 1380 temp: il,trace_cas(il)=',
 !     &          il,trace_cas(il)  
              do ixt=1,ntraciso
@@ -7468,15 +7393,15 @@
                         'appel_stewart 1661')
              enddo !do ixt=1,ntraciso
-             if (iso_eau.gt.0) then
+             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
-               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
+              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( &
               xtp(iso_eau,il,i),qp(il,i),'appel stewart 1278', &
-              errmax,errmaxrel*50).eq.1) then
-               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
+              errmax,errmaxrel*50).eq.1) THEN
+               WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(
@@ -7484,19 +7409,19 @@
               xtevap(iso_eau,il,i),evap(il,i), &
               'appel stewart 1279', &
-              errmax,errmaxrel).eq.1) then
-               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
+              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
+             endif !if (iso_eau.gt.0) THEN
              if ((iso_HDO.gt.0).and. &
-                (qp(il,i).gt.ridicule)) then
+                (qp(il,i).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
                 xtp(iso_HDO,il,i)/qp(il,i), &
                 'appel_stewart 1498')
-             endif  ! if (iso_HDO.gt.0) then
+             endif  ! if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
-!           if (il.eq.602) then
-!              write(*,*) 'appel_stewart 1334: il,i=',il,i
-!              write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
+!           if (il.eq.602) THEN
+!              WRITE(*,*) 'appel_stewart 1334: il,i=',il,i
+!              WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
 !     :          xtp(iso_eau:ntraciso:3,il,i) 
 !           endif
@@ -7508,21 +7433,21 @@
                 'appel_stewart_vectall 1636')
 !           if ((option_traceurs.eq.17).or.
-!     &          (option_traceurs.eq.18)) then
+!     &          (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
-!             write(*,*) 'il,trace_cas=',il,trace_cas(il)
+!     &          '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  
-           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) 
@@ -7540,10 +7465,9 @@
 #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
-
+        endif !if (bidouille_anti_divergence) THEN
 !#ifdef ISOVERIF
-!        write(*,*) 'appel_stewart tmp 1197: sortie'
+!        WRITE(*,*) 'appel_stewart tmp 1197: sortie'
 !#endif
 
@@ -7604,8 +7528,8 @@
 !#endif
 
-!        write(*,*) 'ncas=',ncas
+!        WRITE(*,*) 'ncas=',ncas
        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)), &
@@ -7616,12 +7540,12 @@
                 'appel_stewart 1357a')
          if (iso_verif_noNaN_nostop((fac_ftmr_cas(il)), &
-                'appel_stewart 1357b').eq.1) then
-            write(*,*) 'il=',il
+                'appel_stewart 1357b').eq.1) THEN
+            WRITE(*,*) 'il=',il
          endif
-!         if (il.eq.1) then
-!         write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(il)
-!         write(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
-!         write(*,*) 'Pqisup_cas=',Pqisup_cas(il)
-!         write(*,*) 'qp_avantevap_cas=',qp_avantevap_cas(il)
+!         if (il.eq.1) THEN
+!         WRITE(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(il)
+!         WRITE(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
+!         WRITE(*,*) 'Pqisup_cas=',Pqisup_cas(il)
+!         WRITE(*,*) 'qp_avantevap_cas=',qp_avantevap_cas(il)
 !         endif
 #endif   
@@ -7629,9 +7553,9 @@
         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
+           (Pqisup_cas(il).le.0.0)) THEN
           fcond(il)=1.0
           cond(il)=0.0
 !#ifdef ISOVERIF          
-!         write(*,*) 'tmp 1399: il,cond,Eqi,fac_ftmr_cas=', &
+!         WRITE(*,*) 'tmp 1399: il,cond,Eqi,fac_ftmr_cas=', &
 !     &         il,cond(il),Eqi_prime_cas(il),fac_ftmr_cas(il)
 !#endif          
@@ -7640,11 +7564,11 @@
          cond(il)=-Eqi_prime_cas(il)*fac_ftmr_cas(il)
 #ifdef ISOVERIF             
-!         write(*,*) 'tmp 1404: il,cond,Eqi,fac_ftmr_cas=',
+!         WRITE(*,*) 'tmp 1404: il,cond,Eqi,fac_ftmr_cas=',
 !     :          il,cond(il),Eqi_prime_cas(il),fac_ftmr_cas(il)
-!         write(*,*) 'Pqisup_cas,qp_cas=',Pqisup_cas(il),qp_cas(il)
+!         WRITE(*,*) 'Pqisup_cas,qp_cas=',Pqisup_cas(il),qp_cas(il)
 #endif         
         endif
 
-         if (T_cas(il).ge.ztglace_kelvin) then
+         if (T_cas(il).ge.ztglace_kelvin) THEN
                fice(il)=0.0
          else
@@ -7652,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
@@ -7665,6 +7589,6 @@
                  xtp0(ixt,il)=xtp_avantevap_cas(ixt,il)
               enddo !do ixt=1,niso  
-         else ! if (cond(il).gt.qp_avantevap_cas(il)) then    
-           if (cond(il).lt.1e-11) then
+         else ! if (cond(il).gt.qp_avantevap_cas(il)) THEN
+           if (cond(il).lt.1e-11) THEN
               ! pour des raisons numériques, ça ne marchera pas
               cond(il)=cond(il)*1e4
@@ -7673,14 +7597,14 @@
                  xtp0(ixt,il)=xtp_avantevap_cas(ixt,il)*1e4
               enddo !do ixt=1,niso  
-           else !if (cond(il).lt.1e-11) then
+           else !if (cond(il).lt.1e-11) THEN
               qp0(il)=qp_avantevap_cas(il)  
               do ixt=1,niso
                xtp0(ixt,il)=xtp_avantevap_cas(ixt,il)
               enddo                             
-           endif !if (cond(il).lt.1e-11) then
-         endif ! if (cond(il).gt.qp0(il)) then
-#ifdef ISOVERIF
-!        write(*,*) 'appel_stewart 1378 tmp: il=',il
-!         write(*,*) 'cond(il),qp0(il)=',cond(il),qp0(il)
+           endif !if (cond(il).lt.1e-11) THEN
+         endif ! if (cond(il).gt.qp0(il)) THEN
+#ifdef ISOVERIF
+!        WRITE(*,*) 'appel_stewart 1378 tmp: il=',il
+!         WRITE(*,*) 'cond(il),qp0(il)=',cond(il),qp0(il)
          CALL iso_verif_noNaN(qp0(il),'appel_stewart 1384a')
          CALL iso_verif_noNaN(cond(il),'appel_stewart 1384b')
@@ -7691,14 +7615,14 @@
 #ifdef ISOVERIF     
          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=', &
+                'appel_stewart 1664').eq.1) THEN
+           WRITE(*,*) 'il,qp0,cond=',il,qp0(il),cond(il)
+           WRITE(*,*) 'qp_avantevap_cas,qp_cas=', &
                 qp_avantevap_cas(il),qp_cas(il)
-           write(*,*) 'Eqi_prime_cas,Pqisup_cas=', &
+           WRITE(*,*) 'Eqi_prime_cas,Pqisup_cas=', &
                 Eqi_prime_cas,Pqisup_cas
-           write(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
+           WRITE(*,*) 'fac_ftmr_cas=',fac_ftmr_cas(il)
            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)
@@ -7712,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)
@@ -7722,5 +7646,5 @@
                    (fice(il)*zxtalphai+(1.0-fice(il))*zxtalphal)
             enddo !do ixt=1,niso   
-          else !if (cond(il).gt.ridicule*1e-2) then   
+          else !if (cond(il).gt.ridicule*1e-2) THEN
             do ixt=1,niso
               Rcond(ixt,il)=Rdefault(ixt)
@@ -7731,23 +7655,23 @@
 
 #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                   
+!           WRITE(*,*) 'tmp il,cond(il)=',il ,cond(il)
+          if (cond(il).gt.errmax/50) THEN
               CALL iso_verif_egalite_choix( &
                (Rcond(iso_eau,il)),1.0, &
                'appel_stewart 257',errmax,errmaxrel*50)
-          endif !if (cond.gt.errmax/50) then
+          endif !if (cond.gt.errmax/50) THEN
          enddo
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif
         do il=1,ncas
           ! 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)
              enddo !do ixt=1,niso
-          else !if (Pqisup.gt.0.0) then
+          else !if (Pqisup.gt.0.0) THEN
               ! il n'y avait pas d'eau au dessus
               ! on vérifie que toute l'eau en i provient de la rosée: on
@@ -7765,9 +7689,9 @@
                Risup(ixt,il)=Rdefault(ixt)
              enddo !do ixt=1,niso
-          endif  !if (Pqisup.gt.0.0) then 
+          endif  !if (Pqisup.gt.0.0) THEN
          enddo  !do il=1,ncas_condensation_facftmr
 #ifdef ISOVERIF
          do il=1,ncas
-!          write(*,*) 'tmp 1487: il,cond,Eqi,fac_ftmr_cas=',
+!          WRITE(*,*) 'tmp 1487: il,cond,Eqi,fac_ftmr_cas=',
 !     :          il,cond(il),Eqi_prime_cas(il),fac_ftmr_cas(il)
 
@@ -7776,17 +7700,17 @@
                '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
-               write(*,*) 'ixt,il=',ixt,il
-               write(*,*) 'Pxtisup_cas(ixt,il)=',Pxtisup_cas(ixt,il)
-               write(*,*) 'Pqisup_cas(il)=',Pqisup_cas(il)
-               write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-               write(*,*) 'T_cas(il)=',T_cas(il)
-               write(*,*) 'fcond(il)=',fcond(il)
-               write(*,*) 'cond(il)=',cond(il)
-               write(*,*) 'qp_avantevap_cas(il)=',qp_avantevap_cas(il)
-               write(*,*) 'fice(il)=',fice(il)
-               write(*,*) 'xtice(ixt,il)=',xtice(ixt,il)
-               write(*,*) 'xtliq(ixt,il)=',xtliq(ixt,il)
+               'appel_stewart 1484, cas 1.1, Risup').eq.1)) THEN
+               WRITE(*,*) 'ixt,il=',ixt,il
+               WRITE(*,*) 'Pxtisup_cas(ixt,il)=',Pxtisup_cas(ixt,il)
+               WRITE(*,*) 'Pqisup_cas(il)=',Pqisup_cas(il)
+               WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+               WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+               WRITE(*,*) 'T_cas(il)=',T_cas(il)
+               WRITE(*,*) 'fcond(il)=',fcond(il)
+               WRITE(*,*) 'cond(il)=',cond(il)
+               WRITE(*,*) 'qp_avantevap_cas(il)=',qp_avantevap_cas(il)
+               WRITE(*,*) 'fice(il)=',fice(il)
+               WRITE(*,*) 'xtice(ixt,il)=',xtice(ixt,il)
+               WRITE(*,*) 'xtliq(ixt,il)=',xtliq(ixt,il)
                stop
             endif
@@ -7800,10 +7724,10 @@
          do il=1,ncas
 !#ifdef ISOVERIF   
-!          if (iso_eau.gt.0) then      
-!             write(*,*) 'appel_stewart 1489: il,fac_ftmr_cas(il)=',
+!          if (iso_eau.gt.0) THEN
+!             WRITE(*,*) 'appel_stewart 1489: il,fac_ftmr_cas(il)=',
 !     :           il,fac_ftmr_cas(il)
-!             write(*,*) 'xtp_avantevap_cas(iso_eau,il)=',
+!             WRITE(*,*) 'xtp_avantevap_cas(iso_eau,il)=',
 !     :           xtp_avantevap_cas(iso_eau,il)
-!             write(*,*) 'Eqi_prime_cas(il),Rcond(iso_eau,il)=',
+!             WRITE(*,*) 'Eqi_prime_cas(il),Rcond(iso_eau,il)=',
 !     :           Eqi_prime_cas(il),Rcond(iso_eau,il)
 !          endif
@@ -7823,12 +7747,12 @@
           enddo !do il=1,ncas_condensation_facftmr
 !          il=1
-!          write(*,*) 'appel_stewart 1745: il=',il 
-!          write(*,*) 'xtp_cas(iso_eau,il)=',xtp_cas(iso_eau,il)
-!          write(*,*) 'xtp_avantevap_cas(iso_eau,il)=',
+!          WRITE(*,*) 'appel_stewart 1745: il=',il
+!          WRITE(*,*) 'xtp_cas(iso_eau,il)=',xtp_cas(iso_eau,il)
+!          WRITE(*,*) 'xtp_avantevap_cas(iso_eau,il)=',
 !     :        xtp_avantevap_cas(iso_eau,il)
-!          write(*,*) 'qp_cas(il)=',qp_cas(il)
-!          write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-!          write(*,*) 'Exi_prime(iso_eau,il)=',Exi_prime(iso_eau,il)
-!          write(*,*) 'oktrac=',oktrac
+!          WRITE(*,*) 'qp_cas(il)=',qp_cas(il)
+!          WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+!          WRITE(*,*) 'Exi_prime(iso_eau,il)=',Exi_prime(iso_eau,il)
+!          WRITE(*,*) 'oktrac=',oktrac
 
 #ifdef ISOVERIF
@@ -7836,16 +7760,16 @@
              do ixt=1,niso
               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)
-                write(*,*) 'Rcond(ixt,il)=',Rcond(ixt,il)
-                write(*,*) 'fcond(il)=',fcond(il)
-                write(*,*) 'Risup(ixt,il)=',Risup(ixt,il)
-                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-                write(*,*) 'T_cas(il)=',T_cas(il)
-                write(*,*) 'cond(il)=',cond(il)
-                write(*,*) 'Pqisup_cas(il)=',Pqisup_cas(il)
-                write(*,*) 'qp_avantevap_cas(il)=',qp_avantevap_cas(il)
+                'appel_stewart 1487').eq.1) THEN
+                WRITE(*,*) 'ixt,il=',ixt,il
+                WRITE(*,*) 'water_cas(il)=',water_cas(il)
+                WRITE(*,*) 'Rcond(ixt,il)=',Rcond(ixt,il)
+                WRITE(*,*) 'fcond(il)=',fcond(il)
+                WRITE(*,*) 'Risup(ixt,il)=',Risup(ixt,il)
+                WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+                WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+                WRITE(*,*) 'T_cas(il)=',T_cas(il)
+                WRITE(*,*) 'cond(il)=',cond(il)
+                WRITE(*,*) 'Pqisup_cas(il)=',Pqisup_cas(il)
+                WRITE(*,*) 'qp_avantevap_cas(il)=',qp_avantevap_cas(il)
                 stop
               endif
@@ -7854,5 +7778,5 @@
 #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), &
@@ -7860,17 +7784,17 @@
                 errmax,errmaxrel)
               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
-               write(*,*) 'xtwater(iso_eau,il,i)=', &
+                (water_cas(il).gt.ridicule)) THEN
+               WRITE(*,*) 'appel_stewart 1535, cas 1.1, il=',il
+               WRITE(*,*) 'xtwater(iso_eau,il,i)=', &
                         xtwater_cas(iso_eau,il)
-               write(*,*) 'water(il,i)=',water_cas(il)
-               write(*,*) 'Rcond(iso_eau,il)=',Rcond(iso_eau,il)
-               write(*,*) 'Risup(iso_eau,il)=',Risup(iso_eau,il)
-               write(*,*) 'fcond(il)=',fcond(il)
-               write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+               WRITE(*,*) 'water(il,i)=',water_cas(il)
+               WRITE(*,*) 'Rcond(iso_eau,il)=',Rcond(iso_eau,il)
+               WRITE(*,*) 'Risup(iso_eau,il)=',Risup(iso_eau,il)
+               WRITE(*,*) 'fcond(il)=',fcond(il)
+               WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+               WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
                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), &
@@ -7880,32 +7804,32 @@
                 evap_cas(il), &
                 'appel_stewart 275, cas 1.1', &
-                errmax,errmaxrel).eq.1) then
-!                write(*,*) 'il,cas_condensation_facftmr(il)=',
+                errmax,errmaxrel).eq.1) THEN
+!                WRITE(*,*) 'il,cas_condensation_facftmr(il)=',
 !     &                  il,cas_condensation_facftmr(il)
-                write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
+                WRITE(*,*) 'xtevapsup_cas(iso_eau,il)=', &
                         xtevapsup_cas(iso_eau,il)
-!                write(*,*) 'evap(cas_condensation_facftmr(il),i+1)=',
+!                WRITE(*,*) 'evap(cas_condensation_facftmr(il),i+1)=',
 !     &                 evap(cas_condensation_facftmr(il),i+1)
-                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-                write(*,*) 'Exi_prime(iso_eau,il)=', &
+                WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+                WRITE(*,*) 'Exi_prime(iso_eau,il)=', &
                         Exi_prime(iso_eau,il)
                 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
+            endif ! if (iso_eau.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')
-              endif !if (qp(cas_condensation_facftmr(il),i).gt.ridicule) then
+              endif !if (qp(cas_condensation_facftmr(il),i).gt.ridicule) THEN
              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
+            endif  ! if (iso_HDO.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), &
@@ -7913,6 +7837,6 @@
                 endif !if (qp(cas_condensation_nofacftmr(il),i)
                enddo ! do il=1,ncas
-              endif  ! if (iso_HDO.gt.0) then
-           endif  !if (oktrac.eq.0) then
+              endif  ! if (iso_HDO.gt.0) THEN
+           endif  !if (oktrac.eq.0) THEN
 #endif   
 
@@ -7967,5 +7891,5 @@
         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))
@@ -7973,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)
@@ -7992,23 +7916,23 @@
                Renv(ixt,il)=Rdefault(ixt)
              enddo !do ixt=1,niso 
-           endif !if (qp_avantevap_cas(il).gt.0) then
+           endif !if (qp_avantevap_cas(il).gt.0) THEN
          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)
              enddo ! do ixt=1,niso
-           else !if (T(il).ge.ztglace_Kelvin) then
+           else !if (T(il).ge.ztglace_Kelvin) THEN
                do ixt=1,niso
                 Rcond(ixt,il)=zxtalphai(ixt,il)*Renv(ixt,il)
                enddo ! do ixt=1,niso               
-           endif !if (T(il).ge.ztglace_Kelvin) then 
+           endif !if (T(il).ge.ztglace_Kelvin) THEN
          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)
              enddo !do ixt=1,niso
-          else !if (Pqisup.gt.0.0) then
+          else !if (Pqisup.gt.0.0) THEN
 #ifdef ISOVERIF
               CALL iso_verif_egalite_choix(fcond(il),1.0, &
@@ -8018,8 +7942,8 @@
                Risup(ixt,il)=Rdefault(ixt)
              enddo !do ixt=1,niso
-          endif  !if (Pqisup.gt.0.0) then 
+          endif  !if (Pqisup.gt.0.0) THEN
          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( &
@@ -8032,5 +7956,5 @@
                 errmax,errmaxrel)
           enddo !do il=1,ncas
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
         do il=1,ncas
           CALL iso_verif_noNAN((Eqi_prime_cas(il)), &
@@ -8063,10 +7987,10 @@
                         '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
-                write(*,*) 'ixt,il=',ixt,il
-                write(*,*) 'Exi_prime(ixt,il)=',Exi_prime(ixt,il)
-                write(*,*) 'delP_cas(il)=',delP_cas(il)
-                write(*,*) 'sigd_cas(il)=',sigd_cas(il)
-                write(*,*) 'xtevapsup_cas(ixt,il)=',xtevapsup_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)
+                WRITE(*,*) 'delP_cas(il)=',delP_cas(il)
+                WRITE(*,*) 'sigd_cas(il)=',sigd_cas(il)
+                WRITE(*,*) 'xtevapsup_cas(ixt,il)=',xtevapsup_cas(ixt,il)
                 CALL abort_physic('isotopes_routines_mod', 'appel_stewart 286.12: cas 1.2, xtevap', 1)
               endif !if (iso_verif_noNAN_nostop(xtevap_cas(ixt,il)
@@ -8075,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), &
@@ -8082,12 +8006,12 @@
                 errmax,errmaxrel)
               if ((xtwater_cas(iso_eau,il).eq.0).and. &
-                (water_cas(il).gt.ridicule)) then
-               write(*,*) 'appel_stewart 263.12, cas 1.2'
-               write(*,*) 'xtwater(iso_eau,il,i)=', &
+                (water_cas(il).gt.ridicule)) THEN
+               WRITE(*,*) 'appel_stewart 263.12, cas 1.2'
+               WRITE(*,*) 'xtwater(iso_eau,il,i)=', &
                 xtwater_cas(iso_eau,il)
-               write(*,*) 'water_cas(il)=',water_cas(il)
+               WRITE(*,*) 'water_cas(il)=',water_cas(il)
                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) &
@@ -8096,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                
+            endif ! if (iso_eau.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), &
@@ -8108,9 +8032,9 @@
                endif !if (qp(cas_condensation_nofacftmr(il),i)
               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
+            endif  ! if (iso_HDO.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), &
@@ -8118,6 +8042,6 @@
                 endif !if (qp(cas_condensation_nofacftmr(il),i)
                enddo ! do il=1,ncas
-              endif  ! if (iso_HDO.gt.0) then
-           endif !if (oktrac.eq.0) then
+              endif  ! if (iso_HDO.gt.0) THEN
+           endif !if (oktrac.eq.0) THEN
 #endif
 
@@ -8159,7 +8083,7 @@
         !real 
 
-!        write(*,*) 'appel_stewart tmp 1530: Pxtisup_cas(iso_eau,2)=',
+!        WRITE(*,*) 'appel_stewart tmp 1530: Pxtisup_cas(iso_eau,2)=',
 !     :           Pxtisup_cas(iso_eau,2)
-!        write(*,*) 'Pqisup_cas(2)=',Pqisup_cas(2)
+!        WRITE(*,*) 'Pqisup_cas(2)=',Pqisup_cas(2)
         do il=1,ncas
          do ixt=1,niso
@@ -8171,13 +8095,13 @@
        do il=1,ncas
         if ((Pqisup_cas(il).le.0.0).and. &
-                (water_cas(il).gt.ridicule*10)) then
+                (water_cas(il).gt.ridicule*10)) THEN
             ! 27 mai 2009: on est plus laxiste dans le cas des traceurs
             ! d'eau: on met ridicule*10
-            write(*,*) 'appel_stewart 372: water(il,i)=', &
+            WRITE(*,*) 'appel_stewart 372: water(il,i)=', &
               water_cas(il)
-            write(*,*) 'appel_stewart 372: Pqisup=',Pqisup_cas(il)
+            WRITE(*,*) 'appel_stewart 372: Pqisup=',Pqisup_cas(il)
             stop
          endif
-         if (iso_eau.gt.0) then
+         if (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix( &
                 (Pxtisup_cas(iso_eau,il)), &
@@ -8190,14 +8114,14 @@
 #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)
               xtwater_cas(ixt,il)=water_cas(il)*Risup(ixt,il)
             enddo !do ixt=1,niso
-         else !if (Pqisup.gt.0.0) then
+         else !if (Pqisup.gt.0.0) THEN
            do ixt=1,niso
             xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
            enddo !do ixt=1,niso  
-         endif  !if (Pqisup.gt.0.0) then  
+         endif  !if (Pqisup.gt.0.0) THEN
         enddo !do il=1,ncas_noevap 
 
@@ -8213,5 +8137,5 @@
             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), &
@@ -8219,12 +8143,12 @@
                 errmax,errmaxrel)
               if ((xtwater_cas(iso_eau,il).eq.0).and. &
-                (water_cas(il).gt.ridicule)) then
-               write(*,*) 'appel_stewart 263.2, cas 1.1'
-               write(*,*) 'xtwater(iso_eau,il)=',xtwater_cas(iso_eau,il)
-               write(*,*) 'water(il)=',water_cas(il)
+                (water_cas(il).gt.ridicule)) THEN
+               WRITE(*,*) 'appel_stewart 263.2, cas 1.1'
+               WRITE(*,*) 'xtwater(iso_eau,il)=',xtwater_cas(iso_eau,il)
+               WRITE(*,*) 'water(il)=',water_cas(il)
                stop
               endif
-              if (oktrac.eq.0) then
-!                  write(*,*) 'appel_stewart 1743 noevap tmp: il=',il
+              if (oktrac.eq.0) THEN
+!                  WRITE(*,*) 'appel_stewart 1743 noevap tmp: il=',il
              CALL iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
                 qp_cas(il) &
@@ -8234,18 +8158,18 @@
                 '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
+            endif ! if (iso_eau.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')
-                endif !if (qp(cas_noevap(il),i).gt.ridicule) then   
+                endif !if (qp(cas_noevap(il),i).gt.ridicule) THEN
               enddo !do il=1,ncas 
-            endif  ! if (iso_HDO.gt.0) then
-            endif !if (oktrac.eq.0) then
+            endif  ! if (iso_HDO.gt.0) THEN
+            endif !if (oktrac.eq.0) THEN
 #endif           
 
@@ -8274,5 +8198,5 @@
 #endif
 #ifdef ISOTRAC
-USE isotrac_mod, only: ridicule_trac
+USE isotrac_mod, ONLY: ridicule_trac
 #endif
         IMPLICIT NONE
@@ -8325,13 +8249,13 @@
 
 #ifdef ISOVERIF
-!        if (ncas.ge.162) then
-!        write(*,*) 'appel tmp 1975: xtp_avantevap_cas(iso_eau,162)=',
+!        if (ncas.ge.162) THEN
+!        WRITE(*,*) 'appel tmp 1975: xtp_avantevap_cas(iso_eau,162)=',
 !     :           xtp_avantevap_cas(iso_eau,162)
-!        write(*,*) 'appel tmp 1975b: qp_avantevap_cas(162)=',
+!        WRITE(*,*) 'appel tmp 1975b: qp_avantevap_cas(162)=',
 !     :           qp_avantevap_cas(162)
-!        endif !if (ncas_evap_liq.ge.162) then
-      if (iso_eau.gt.0) then
+!        endif !if (ncas_evap_liq.ge.162) THEN
+      if (iso_eau.gt.0) THEN
           do il=1,ncas
-!            write(*,*) 'appel tmp 1492: il=',il
+!            WRITE(*,*) 'appel tmp 1492: il=',il
             CALL iso_verif_egalite_choix( &
              (xtp_avantevap_cas(iso_eau,il)), &
@@ -8348,15 +8272,15 @@
              errmax,errmaxrel)
            enddo !do il=1,ncas
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
 #endif   
 
 #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)
@@ -8365,5 +8289,5 @@
                Pxtisup_cas(ixt,il)=Pxtisup_cas(ixt,il)/ptrac(il)
              enddo
-            else !if (ptrac(il).gt.0.0) then
+            else !if (ptrac(il).gt.0.0) THEN
 #ifdef ISOVERIF                
              CALL iso_verif_egalite((Pqisup_cas(il)), &
@@ -8380,11 +8304,11 @@
                Pxtisup_cas(ixt,il)=0.0
              enddo   
-            endif !if (ptrac(il).gt.0.0) then
+            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), &
@@ -8393,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), &
@@ -8405,9 +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
@@ -8426,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( &
@@ -8442,11 +8365,11 @@
                 '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)), &
                    1.,'appel_setwart 575a', errmax*10, errmaxrel*10)
-                endif !if (Pqiinf_par.gt.ridicule) then
+                endif !if (Pqiinf_par.gt.ridicule) THEN
            enddo !do il=1,ncas     
-        endif !if (iso_eau.gt.0) then  
+        endif !if (iso_eau.gt.0) THEN
         do il=1,ncas 
            CALL iso_verif_noNAN(water_cas(il),  &
@@ -8465,15 +8388,15 @@
         ! 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) &
                    *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
                enddo
-             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
+             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) THEN
                  ! normalement, ce cas a déjà été interdit dans
                  ! compress_evp_glace
@@ -8482,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
         
@@ -8491,24 +8414,24 @@
                '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 (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
-!               write(*,*) 'i=',i
-               write(*,*) 'Tevap=',T_cas(il)
-               write(*,*) 'xtwater(iso_eau,il,i)=', &
+                'appel stewart 155',errmax*10,errmaxrel*10).eq.1) THEN
+!               WRITE(*,*) 'i=',i
+               WRITE(*,*) 'Tevap=',T_cas(il)
+               WRITE(*,*) 'xtwater(iso_eau,il,i)=', &
                         xtwater_cas(iso_eau,il)
-               write(*,*) 'water(il,i)=',water_cas(il)
-               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+               WRITE(*,*) 'water(il,i)=',water_cas(il)
+               WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                          Pxtiinf_stewart(iso_eau,il)
-!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
+!               WRITE(*,*) 'Pqiinf_par,Pqiinf_stewart=',
 !     &             Pqiinf_par(cas_evap_liq(il)),Pqiinf_stewart(il)
                stop
              endif  !if (iso_verif_egalite_nostop(
-         endif !if (water(il,i).gt.ridicule) then
-        endif !if (iso_eau.gt.0) then
+         endif !if (water(il,i).gt.ridicule) THEN
+        endif !if (iso_eau.gt.0) THEN
        enddo !do il=1,ncas
 #endif
@@ -8519,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) &
@@ -8526,5 +8449,5 @@
                  -xtevapsup_cas(ixt,il)
          enddo ! do ixt=1,niso
-        else !if (Eqi_stewart.gt.0.0) then
+        else !if (Eqi_stewart.gt.0.0) THEN
             ! il peut quand même y a voir de la diffusion
             do ixt=1,niso
@@ -8533,5 +8456,5 @@
                  -xtevapsup_cas(ixt,il)
             enddo !do ixt=1,niso    
-        endif !if (Eqi_stewart.gt.0.0) then
+        endif !if (Eqi_stewart.gt.0.0) THEN
        enddo !do il=1,ncas
       
@@ -8541,28 +8464,28 @@
           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_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
-              write(*,*) 'il=',il
-              write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-              write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
-              write(*,*) 'Exi_stewart(iso_eau,il)=', &
+                errmax,errmaxrel).eq.1) THEN
+              WRITE(*,*) 'il=',il
+              WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+              WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
+              WRITE(*,*) 'Exi_stewart(iso_eau,il)=', &
                 Exi_stewart(iso_eau,il)
-              write(*,*) '1/100/delP_cas(il)/sigd(il)*g*2=', &
+              WRITE(*,*) '1/100/delP_cas(il)/sigd(il)*g*2=', &
                  1.0/100.0/delP_cas(il)/sigd(il)*g*2.0
-              write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
+              WRITE(*,*) 'xtevapsup_cas(iso_eau,il)=', &
                 xtevapsup_cas(iso_eau,il)
               stop
             endif
-        endif !if (iso_eau.gt.0) then
-        endif !if (oktrac.eq.0) then 
+        endif !if (iso_eau.gt.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)), &
@@ -8570,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
@@ -8579,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)
@@ -8588,14 +8511,13 @@
                        *Exi_stewart(ixt,il)/Eqi_stewart(il),0.0)
                enddo !do ixt=1,niso
-             else ! if (Eqi_stewart.gt.ridicule) then
-                if (qp_cas(il).gt.0.0) then 
-
+             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) &
-                         then
+                         THEN
                         ! il va manquer quelque chose: il faut augmenter
                         ! xtp en lui ajoutant l'évap du niveau d'eau
                         ! dessus
                         ! pour l'instant, on bidouille:
-                        write(*,*) 'appel_stewart 2487: il=',il
+                        WRITE(*,*) 'appel_stewart 2487: il=',il
                         do ixt=1,niso               
                         xtnew(ixt,il)=xtnew(ixt,il) &
@@ -8614,20 +8536,19 @@
                       ! modif 1 mai 2009, pour le cas des traceurs
                     enddo !do ixt=1,niso
-!                    write(*,*) 'appel_stewart 1963 tmp: ',
+!                    WRITE(*,*) 'appel_stewart 1963 tmp: ',
 !     :                  'xtp_cas(iso_eau,il)=',xtp_cas(iso_eau,il)
-                else !if (qp(il,i).gt.0.0) then 
+                else !if (qp(il,i).gt.0.0) THEN
                   do ixt=1,niso               
                     xtp_cas(ixt,il)=0.0
                   enddo !do ixt=1,niso
-                endif  !if (qp(il,i).gt.0.0) then 
-            endif !if (Eqi_stewart.gt.ridicule) then 
-
+                endif  !if (qp(il,i).gt.0.0) THEN
+            endif !if (Eqi_stewart.gt.ridicule) THEN
 #ifdef ISOVERIF       
-!            if (il.eq.87) then
-!                write(*,*) 'appel_stewart 2244: tmp, après calcul xtp'
-!                write(*,*) 'xtnew(:,il)=',xtnew(:,il)
-!                write(*,*) 'Pxtiinf_stewart(:,il)=',
+!            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), &
@@ -8635,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
@@ -8645,28 +8566,28 @@
                 xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
                 ridicule_trac,deltalimtrac, &
-                'appel_stewart 2090').eq.1) then
-                  write(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
+                'appel_stewart 2090').eq.1) THEN
+                  WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
                    xtp_avantevaptrac_cas(iso_eau,il),deltaD &
                    ((xtp_avantevaptrac_cas(iso_HDO,il)) &
                    /(xtp_avantevaptrac_cas(iso_eau,il)))
-                  write(*,*) 'xtp_avantevap_cas(iso_eau),deltaD=', &
+                  WRITE(*,*) 'xtp_avantevap_cas(iso_eau),deltaD=', &
                    xtp_avantevap_cas(iso_eau,il),deltaD &
                    ((xtp_avantevap_cas(iso_HDO,il)) &
                    /(xtp_avantevap_cas(iso_eau,il)))
-                  write(*,*) 'xtnew(iso_eau),deltaD=', &
+                  WRITE(*,*) 'xtnew(iso_eau),deltaD=', &
                    xtnew(iso_eau,il),deltaD &
                    ((xtnew(iso_HDO,il)) &
                    /(xtnew(iso_eau,il)))
-                  write(*,*) 'xtp_cas(iso_eau),deltaD=', &
+                  WRITE(*,*) 'xtp_cas(iso_eau),deltaD=', &
                    xtp_cas(iso_eau,il),deltaD &
                    (xtp_cas(iso_HDO,il)/xtp_cas(iso_eau,il))
-                  write(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il)=', &
+                  WRITE(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il)=', &
                         Eqi_stewart(il),fac_ftmr_cas(il)
-                  write(*,*) 'Eqi_prime_cas(il)=', &
+                  WRITE(*,*) 'Eqi_prime_cas(il)=', &
                         Eqi_prime_cas(il)
-                  write(*,*) 'deltaD_Eqi_stewart=', &
+                  WRITE(*,*) 'deltaD_Eqi_stewart=', &
                         deltaD(( &
                         Exi_stewart(iso_HDO,il)/Eqi_stewart(il)))
-                  write(*,*) 'xtnew-xtp_avantevap_cas,deltaD=', &
+                  WRITE(*,*) 'xtnew-xtp_avantevap_cas,deltaD=', &
                       xtnew(iso_eau,il)-xtp_avantevap_cas(iso_eau,il), &
                       deltaD(((xtnew(iso_HDO,il) &
@@ -8674,43 +8595,42 @@
                       (xtnew(iso_eau,il) &
                       -xtp_avantevap_cas(iso_eau,il))))
-                  write(*,*) 'Pqisup,deltaD=', &
+                  WRITE(*,*) 'Pqisup,deltaD=', &
                         Pqisup_cas(il),deltaD(( &
                         Pxtisup_cas(iso_HDO,il)/Pqisup_cas(il)))
                   stop
                 endif
-        endif !if (iso_HDO.gt.0) then
-       endif !if (oktrac.eq.1) then
+        endif !if (iso_HDO.gt.0) 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
-
+           endif !if (iso_eau.gt.0) THEN
            if ((iso_HDO.gt.0).and. &
-                (qp_cas(il).gt.ridicule)) then
+                (qp_cas(il).gt.ridicule)) THEN
              if (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
               qp_cas(il), &
-              'appel_stewart_vectall 1079').eq.1) then
-               write(*,*) 'i,qp(cas_evap_liq(il),i)=', &
+              'appel_stewart_vectall 1079').eq.1) THEN
+               WRITE(*,*) 'i,qp(cas_evap_liq(il),i)=', &
                         i,qp_cas(il)
-               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-               write(*,*) 'deltaDxtnew=',deltaD(( &
+               WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+               WRITE(*,*) 'deltaDxtnew=',deltaD(( &
                 xtnew(iso_HDO,il))/qp_cas(il))
                stop
              endif
-           endif !if (iso_HDO.gt.0) then 
-        endif ! if (oktrac.eq.0) then
+           endif !if (iso_HDO.gt.0) THEN
+        endif ! if (oktrac.eq.0) THEN
 #endif              
 
-          else !if (fac_ftmr.gt.0.0) then
+          else !if (fac_ftmr.gt.0.0) THEN
               ! ca veut dire que Mp=0, xtp pas définit
              do ixt=1,niso
                xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
              enddo !do ixt=1,niso
-         endif !if (fac_ftmr.gt.0.0) then
-      else !if (i.lt.INB) then
+         endif !if (fac_ftmr.gt.0.0) THEN
+      else !if (i.lt.INB) THEN
           ! si i=inb, on ne change rien au calcul original, et on
           ! suppose que la composition du ddft est égale à celle de
@@ -8721,5 +8641,5 @@
                     !dans ce cas là
                   enddo
-      endif !if (i.lt.INB) then
+      endif !if (i.lt.INB) THEN
       enddo !do il=1,ncas
 
@@ -8732,17 +8652,17 @@
         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), &
                 ridicule,deltalim,'appel_stewart 2138')
           endif
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #endif
       enddo !do il=1,ncas  
       
 !#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( &
@@ -8750,38 +8670,38 @@
                  qp_cas(il), &
                 'appel stewart 197', &
-                errmax,errmaxrel*50).eq.1) then
-          write(*,*) 'i=',i,' INB=',INB_cas(il)
-          write(*,*) 'Tevap=',T_cas(il)
-          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
-          write(*,*) 'qp(il,i)=',qp_cas(il)
-          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
-          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
-!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_liq(il),i)
-          write(*,*) 'xtp_avantevap(iso_eau)=', &
+                errmax,errmaxrel*50).eq.1) THEN
+          WRITE(*,*) 'i=',i,' INB=',INB_cas(il)
+          WRITE(*,*) 'Tevap=',T_cas(il)
+          WRITE(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
+          WRITE(*,*) 'qp(il,i)=',qp_cas(il)
+          WRITE(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
+          WRITE(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
+!          WRITE(*,*) 'Mp(il,i)=',Mp(cas_evap_liq(il),i)
+          WRITE(*,*) 'xtp_avantevap(iso_eau)=', &
                 xtp_avantevap_cas(iso_eau,il)
-          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
-!          write(*,*) 'Exi_prime(iso_eau)=',Exi_prime(iso_eau,il)
-!          write(*,*) 'Eqi_prime=',Eqi_prime(il)       
-          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+          WRITE(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
+!          WRITE(*,*) 'Exi_prime(iso_eau)=',Exi_prime(iso_eau,il)
+!          WRITE(*,*) 'Eqi_prime=',Eqi_prime(il)
+          WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                  Pxtiinf_stewart(iso_eau,il)
-!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_liq(il))
-          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
-          write(*,*) 'Pqisup=',Pqisup_cas(il)
+!          WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_liq(il))
+          WRITE(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
+          WRITE(*,*) 'Pqisup=',Pqisup_cas(il)
           stop
          endif !if iso_verif_egalite_choix_nostop
         enddo !do il=1,ncas
-      endif !if (iso_eau.gt.0) then
-      if (iso_HDO.gt.0) then            
+      endif !if (iso_eau.gt.0) THEN
+      if (iso_HDO.gt.0) THEN
        do il=1,ncas
-!        write(*,*) 'appel_stewart 2166: fin make_cas_evap_liq, ',
+!        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), &
                 'appel_stewart 1130')
-        endif !if (qp(cas_evap_liq(il),i).gt.ridicule) then
+        endif !if (qp(cas_evap_liq(il),i).gt.ridicule) THEN
        enddo !do il=1,ncas     
       endif 
-      endif ! if (oktrac.eq.0) then
+      endif ! if (oktrac.eq.0) THEN
 !#endif
 ! ISOTRAC
@@ -8849,6 +8769,6 @@
 
 #ifdef ISOVERIF  
-!      write(*,*) 'appel_stewart 2052: entrée dans make_cas_evap_glace'
-      if (iso_eau.gt.0) then
+!      WRITE(*,*) 'appel_stewart 2052: entrée dans make_cas_evap_glace'
+      if (iso_eau.gt.0) THEN
           do il=1,ncas
             CALL iso_verif_egalite_choix( &
@@ -8862,5 +8782,5 @@
              errmax,errmaxrel)
            enddo !do il=1,ncas 
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
 #endif    
      
@@ -8876,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), &
@@ -8883,7 +8803,7 @@
              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'
+!            WRITE(*,*) 'appel_stewart_explicite 2736'
 !#endif          
             CALL stewart_sublim_nofrac_vectall( &
@@ -8893,10 +8813,8 @@
              Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
              fac_ftmr_cas(1))
-      endif !if (frac_sublim.eq.1) then
-      
-
-#ifdef ISOVERIF
-!       write(*,*) 'appel_stewart 2096: dans make_cas_evap_glace'
-       if (iso_eau.gt.0) 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
           do il=1,ncas       
              CALL iso_verif_egalite_choix( &
@@ -8909,18 +8827,18 @@
                 'appel_stewart 586', &
                errmax,errmaxrel)
-             if (Pqiinf_stewart(il).gt.ridicule) then
+             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
-                   write(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
-!                   write(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
-                   write(*,*) 'Pxtiinf_stewart(iso_eau,il)=', &
+                 .eq.1) THEN
+                   WRITE(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
+!                   WRITE(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
+                   WRITE(*,*) 'Pxtiinf_stewart(iso_eau,il)=', &
                         Pxtiinf_stewart(iso_eau,il)
                    stop
                 endif
-             endif !if (Pqiinf_par.gt.ridicule) then
+             endif !if (Pqiinf_par.gt.ridicule) THEN
            enddo !do il=1,ncas       
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif     
 
@@ -8929,15 +8847,15 @@
         ! 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) &
                    *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
                enddo
-             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
+             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) THEN
                  ! normalement, ce cas a déjà été interdit dans
                  ! compress_evp_glace
@@ -8946,9 +8864,9 @@
                 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
         
 #ifdef ISOVERIF
-!       write(*,*) 'appel_stewart 2563: dans make_cas_evap_glace'
+!       WRITE(*,*) 'appel_stewart 2563: dans make_cas_evap_glace'
        do il=1,ncas
         do ixt=1,niso
@@ -8956,24 +8874,24 @@
                 '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 (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
-               write(*,*) 'i=',i
-               write(*,*) 'Tevap=',T_cas(il)
-               write(*,*) 'xtwater(iso_eau,il,i)=', &
+                'appel stewart 155b',errmax*10,errmaxrel*10).eq.1) THEN
+               WRITE(*,*) 'i=',i
+               WRITE(*,*) 'Tevap=',T_cas(il)
+               WRITE(*,*) 'xtwater(iso_eau,il,i)=', &
                         xtwater_cas(iso_eau,il)
-               write(*,*) 'water(il,i)=',water_cas(il)
-               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+               WRITE(*,*) 'water(il,i)=',water_cas(il)
+               WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                          Pxtiinf_stewart(iso_eau,il)
-!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
+!               WRITE(*,*) 'Pqiinf_par,Pqiinf_stewart=',
 !     &                  Pqiinf_par(il),Pqiinf_stewart(il)
                stop
              endif  !if (iso_verif_egalite_nostop(
-         endif !if (water(il,i).gt.ridicule) then
-        endif !if (iso_eau.gt.0) then
+         endif !if (water(il,i).gt.ridicule) THEN
+        endif !if (iso_eau.gt.0) THEN
        enddo !do il=1,ncas
 #endif
@@ -8984,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) &
@@ -8991,5 +8909,5 @@
                  -xtevapsup_cas(ixt,il)
          enddo ! do ixt=1,niso
-        else !if (Eqi_stewart.gt.0.0) then
+        else !if (Eqi_stewart.gt.0.0) THEN
             ! il peut quand même y a voir de la diffusion
             do ixt=1,niso
@@ -8998,5 +8916,5 @@
                  -xtevapsup_cas(ixt,il)
             enddo !do ixt=1,niso    
-        endif !if (Eqi_stewart.gt.0.0) then
+        endif !if (Eqi_stewart.gt.0.0) THEN
        enddo !do il=1,ncas
       
@@ -9006,35 +8924,35 @@
           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_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
-                write(*,*) 'i,il=',i,il
-                write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
+              'appel stewart 142b',errmax,errmaxrel).eq.1) THEN
+                WRITE(*,*) 'i,il=',i,il
+                WRITE(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
                         Exi_stewart(iso_eau,il),Eqi_stewart(il)
-                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-                write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
+                WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+                WRITE(*,*) 'xtevapsup_cas(iso_eau,il)=', &
                   xtevapsup_cas(iso_eau,il)
-!                write(*,*) 'evap,evapsup=',evap(cas_evap_glace(il),i),
+!                WRITE(*,*) 'evap,evapsup=',evap(cas_evap_glace(il),i),
 !     &            evap(cas_evap_glace(il),i+1)
               stop 
             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 (iso_eau.gt.0) THEN
+       endif ! if (oktrac.eq.0) THEN
       enddo !do il=1,ncas 
 #endif
 
-!      write(*,*) 'appel_stewart tmp 2243: Eqi_stewart(1)=',
+!      WRITE(*,*) 'appel_stewart tmp 2243: Eqi_stewart(1)=',
 !     &          Eqi_stewart(1)
-!      write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(1)
+!      WRITE(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(1)
       ! 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)           
@@ -9043,14 +8961,13 @@
                      *Exi_stewart(ixt,il)/Eqi_stewart(il),0.0)
                enddo !do ixt=1,niso
-             else ! if (Eqi_stewart.gt.ridicule) then
-                if (qp_cas(il).gt.0.0) then 
-
+             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) &
-                         then
+                         THEN
                         ! il va manquer quelque chose: il faut augmenter
                         ! xtp en lui ajoutant l'évap du niveau d'eau
                         ! dessus
                         ! pour l'instant, on bidouille:
-                        write(*,*) 'appel_stewart 2930: il=',il
+                        WRITE(*,*) 'appel_stewart 2930: il=',il
                         do ixt=1,niso               
                         xtnew(ixt,il)=xtnew(ixt,il) &
@@ -9067,11 +8984,10 @@
                         -xtp_avantevap_cas(ixt,il))
                     enddo !do ixt=1,niso
-                else !if (qp(il,i).gt.0.0) then 
+                else !if (qp(il,i).gt.0.0) THEN
                   do ixt=1,niso               
                     xtp_cas(ixt,il)=0.0
                   enddo !do ixt=1,niso
-                endif  !if (qp(il,i).gt.0.0) then 
-             endif !if (Eqi_stewart.gt.ridicule) then 
-
+                endif  !if (qp(il,i).gt.0.0) THEN
+             endif !if (Eqi_stewart.gt.ridicule) THEN
 #ifdef ISOVERIF
                do ixt=1,niso
@@ -9079,38 +8995,38 @@
                        'appel stewart 684b')
                 enddo ! do ixt=1,niso
-             if (oktrac.eq.0) then
-                if (iso_eau.gt.0) then
+             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
-                    write(*,*) 'il=',il
-                    write(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
+                    .eq.1) THEN
+                    WRITE(*,*) 'il=',il
+                    WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
                         xtp_avantevaptrac_cas(iso_eau,il)
-                    write(*,*) 'qp_avantevap_cas(il)=', &
+                    WRITE(*,*) 'qp_avantevap_cas(il)=', &
                         qp_avantevap_cas(il)
-                    write(*,*) 'fac_ftmr_cas(il),Eqi_prime_cas(il)=', &
+                    WRITE(*,*) 'fac_ftmr_cas(il),Eqi_prime_cas(il)=', &
                         fac_ftmr_cas(il),Eqi_prime_cas(il)
-                    write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart=', &
+                    WRITE(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart=', &
                         Exi_stewart(iso_eau,il),Eqi_stewart(il)
                     stop
                   endif
-               endif !if (iso_eau.gt.0) then 
+               endif !if (iso_eau.gt.0) THEN
               if ((iso_HDO.gt.0).and. &
-                (qp_cas(il).gt.ridicule)) then
+                (qp_cas(il).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
                 'appel_stewart 1384')
-              endif  ! if (iso_HDO.gt.0) then
-            endif ! if (oktrac.eq.0) then
+              endif  ! if (iso_HDO.gt.0) THEN
+            endif ! if (oktrac.eq.0) THEN
 #endif 
 
-          else !if (fac_ftmr.gt.0.0) then
+          else !if (fac_ftmr.gt.0.0) THEN
               ! ca veut dire que Mp=0, xtp pas définit
              do ixt=1,niso
                xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
              enddo !do ixt=1,niso
-         endif !if (fac_ftmr.gt.0.0) then
-      else !if (i.lt.INB) then
+         endif !if (fac_ftmr.gt.0.0) THEN
+      else !if (i.lt.INB) THEN
           ! si i=inb, on ne change rien au calcul original, et on
           ! suppose que la composition du ddft est égale à celle de
@@ -9121,5 +9037,5 @@
                     !dans ce cas là
                   enddo
-      endif !if (i.lt.INB) then      
+      endif !if (i.lt.INB) THEN
       enddo !do il=1,ncas
 
@@ -9132,6 +9048,6 @@
          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( &
@@ -9139,39 +9055,39 @@
                  qp_cas(il), &
                 'appel stewart 197b: cas_evap_glace', &
-                errmax,errmaxrel*50).eq.1) then
-          write(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
+                errmax,errmaxrel*50).eq.1) THEN
+          WRITE(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
 !     &          ,' cas(il)=',cas_evap_glace(il)
-          write(*,*) 'Tevap=',T_cas(il)
-          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
-          write(*,*) 'qp(il,i)=',qp_cas(il)
-          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
-          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
-!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_glace(il),i)
-          write(*,*) 'xtp_avantevap(iso_eau)=', &
+          WRITE(*,*) 'Tevap=',T_cas(il)
+          WRITE(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
+          WRITE(*,*) 'qp(il,i)=',qp_cas(il)
+          WRITE(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
+          WRITE(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
+!          WRITE(*,*) 'Mp(il,i)=',Mp(cas_evap_glace(il),i)
+          WRITE(*,*) 'xtp_avantevap(iso_eau)=', &
                 xtp_avantevap_cas(iso_eau,il)
-          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
-          write(*,*) 'Exi_stewart(iso_eau)=',Exi_stewart(iso_eau,il)
-          write(*,*) 'Eqi_stewart=',Eqi_stewart(il)
-!          write(*,*) 'Eqi_prime=',Eqi_prime_cas(il)        
-          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+          WRITE(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
+          WRITE(*,*) 'Exi_stewart(iso_eau)=',Exi_stewart(iso_eau,il)
+          WRITE(*,*) 'Eqi_stewart=',Eqi_stewart(il)
+!          WRITE(*,*) 'Eqi_prime=',Eqi_prime_cas(il)
+          WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                  Pxtiinf_stewart(iso_eau,il)
-!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_glace(il))
-          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
-          write(*,*) 'Pqisup=',Pqisup_cas(il)
+!          WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_glace(il))
+          WRITE(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
+          WRITE(*,*) 'Pqisup=',Pqisup_cas(il)
           stop
          endif !if iso_verif_egalite_choix_nostop
          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), &
                 'appel_stewart 1449')
-            endif !if (qp_cas(il).gt.ridicule) then
+            endif !if (qp_cas(il).gt.ridicule) THEN
           enddo !do il=1,ncas
-        endif  ! if (iso_HDO.gt.0) then
-       endif ! if (oktrac.eq.0) then
-!       write(*,*) 'appel_stewart 2331: sortie de make_cas_evap_glace'
+        endif  ! if (iso_HDO.gt.0) THEN
+       endif ! if (oktrac.eq.0) THEN
+!       WRITE(*,*) 'appel_stewart 2331: sortie de make_cas_evap_glace'
 #endif
 
@@ -9202,5 +9118,5 @@
 #ifdef ISOTRAC
 USE isotrac_mod, ONLY: izone_revap, option_revap,ridicule_trac
-USE isotrac_routines_mod, only: &
+USE isotrac_routines_mod, ONLY: &
 &       iso_verif_traceur_jbidouille,uncompress_commun_zone_revap, &
 &       compress_evap_glace_zone,compress_evap_liq_zone, &
@@ -9208,5 +9124,5 @@
 &       compress_cond_facftmr_zone,compress_cond_nofftmr_zone
 #ifdef ISOVERIF
-USE isotrac_routines_mod, only: iso_verif_traceur_pbidouille
+USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
 #endif
 #endif
@@ -9326,10 +9242,10 @@
               
 
-!      write(*,*) 'appel_stewart_np 48: entrée, i=',i
+!      WRITE(*,*) 'appel_stewart_np 48: entrée, i=',i
 
       ! definition de quelques constantes:
 
       !gravité:
-      if (cvflag_grav) then
+      if (cvflag_grav) THEN
           g=1/ginv
       else
@@ -9345,12 +9261,12 @@
       
 #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
+      endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
       do il=1,ncum
@@ -9360,17 +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
@@ -9379,15 +9294,15 @@
             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)
-            endif !if (iso_eau.gt.0) then
+            endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
             CALL iso_verif_traceur(xtp(1,il,j), &
@@ -9395,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 
 
@@ -9414,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)
@@ -9430,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
 
@@ -9436,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)
@@ -9446,6 +9361,6 @@
                 +xt(ixt,il,i)*(1-rat(il))
           enddo
-         else !if (Mp(il,i).gt.Mp(il,i+1)) then
-           if (Mp(il,i+1).gt.Mpmin) then
+         else !if (Mp(il,i).gt.Mp(il,i+1)) THEN
+           if (Mp(il,i+1).gt.Mpmin) THEN
               ! cas non entrainant, mais flux existe
               qp_avantevap(il)=qp(il,i+1)
@@ -9454,6 +9369,5 @@
               enddo
               
-           else    !if (Mp(il,i+1).gt.0) then    
-              
+           else    !if (Mp(il,i+1).gt.0) THEN
               ! pas de flux de masse, on ne calcule rien
               ! on garde le qp calculé dans cv3_unsat, original
@@ -9461,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), &
@@ -9469,15 +9383,12 @@
                  xtp_avantevap(ixt,il)=xt(ixt,il,i)/q(il,i)*qp(il,i)
                 enddo
-              else !if (qp(il,i).gt.0) then
+              else !if (qp(il,i).gt.0) THEN
                   ! si qp est négatif, on met les isos dedans à 0
                 do ixt=1,ntraciso
                  xtp_avantevap(ixt,il)=0.0
                 enddo
-              endif !if (qp(il,i).gt.0) then
-               
-          endif !if (Mp(il,i+1).gt.0) then
-          
-         endif  !if (Mp(il,i).gt.Mp(il,i+1)) then
-      
+              endif !if (qp(il,i).gt.0) THEN
+          endif !if (Mp(il,i+1).gt.0) THEN
+         endif  !if (Mp(il,i).gt.Mp(il,i+1)) THEN
         else ! if i.lt.INB
           ! cas ou i=inb
@@ -9486,9 +9397,9 @@
           ! 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)
             enddo
-          else !if (qp(il,i).gt.0) then
+          else !if (qp(il,i).gt.0) THEN
               ! si qp négatif, on met les isotopes dedans à 0
             qp_avantevap(il)=0.0  
@@ -9496,20 +9407,20 @@
              xtp_avantevap(ixt,il)=0.0
             enddo
-          endif !if (qp(il,i).gt.0) then
+          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
+      endif !if (iso_eau.gt.0) THEN
 #endif
 
@@ -9518,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
@@ -9533,5 +9444,5 @@
             (Pqiinf(il).ge.Pqisup(il)).and. &
             (Pqisup(il).gt.0.0).and. &
-            (Pqisup(il)-Eqi_prime(il).gt.0.0)) then
+            (Pqisup(il)-Eqi_prime(il).gt.0.0)) THEN
                 ! rustine au cas patho en 1D pour -90hPa/d
                 Pqiinf_par(il)=Pqisup(il)-Eqi_prime(il)
@@ -9544,34 +9455,34 @@
                  +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 
-!      write(*,*) 'appel_stewart_np 335 nostop '
+!      WRITE(*,*) 'appel_stewart_np 335 nostop '
 !      il=1
-!      write(*,*) 'Pqisup=',Pqisup(il)
-!      write(*,*) 'Pqiinf=',Pqiinf(il)
-!      write(*,*) 'Eqi_prime=',Eqi_prime(il)
-!      write(*,*) 'Eqi=',Eqi(il)
-!      write(*,*) 'Eqi_plus1=',Eqi_plus1(il)
-!      write(*,*) 'Pqiinf_par=',Pqiinf_par(il)
-!      write(*,*) 'Eqi_par=',Eqi_par(il)
-!      write(*,*) 'qp=',qp(il,i)
-!      write(*,*) 'qp_avantevap=',qp_avantevap(il)
+!      WRITE(*,*) 'Pqisup=',Pqisup(il)
+!      WRITE(*,*) 'Pqiinf=',Pqiinf(il)
+!      WRITE(*,*) 'Eqi_prime=',Eqi_prime(il)
+!      WRITE(*,*) 'Eqi=',Eqi(il)
+!      WRITE(*,*) 'Eqi_plus1=',Eqi_plus1(il)
+!      WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(il)
+!      WRITE(*,*) 'Eqi_par=',Eqi_par(il)
+!      WRITE(*,*) 'qp=',qp(il,i)
+!      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
-            write(*,*) 'il,i,ixt=',il,i,ixt
-            write(*,*) 'xtwater(ixt,il,i+1)=',xtwater(ixt,il,i+1)
-            write(*,*) 'xtwdtrain(ixt,il)=',xtwdtrain(ixt,il)
-            write(*,*) 'wt(il,i+1)=',wt(il,i+1)
-            write(*,*) 'water(il,i+1)=',water(il,i+1)
-            write(*,*) 'wdtrain(il)=',wdtrain(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)
+            WRITE(*,*) 'xtwdtrain(ixt,il)=',xtwdtrain(ixt,il)
+            WRITE(*,*) 'wt(il,i+1)=',wt(il,i+1)
+            WRITE(*,*) 'water(il,i+1)=',water(il,i+1)
+            WRITE(*,*) 'wdtrain(il)=',wdtrain(il)
             stop
           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
@@ -9579,10 +9490,10 @@
 #ifdef ISOVERIF   
 !      il =243
-!      write(*,*) 'appel_stewart 327: il=',il
-!      write(*,*) 'Pqisup,Pqiinf,Eqi_prime,Eqi,Pqiinf_par,Eqi_par=',
+!      WRITE(*,*) 'appel_stewart 327: il=',il
+!      WRITE(*,*) 'Pqisup,Pqiinf,Eqi_prime,Eqi,Pqiinf_par,Eqi_par=',
 !     :     Pqisup(il),Pqiinf(il),Eqi_prime(il),Eqi(il),
 !     :     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', &
@@ -9591,12 +9502,12 @@
 !#ifdef ISOTRAC
 !        if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) then
+!     :           (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
-!          write(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
-!          write(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
-!          write(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
+!     :          'appel_stewart_np 332').eq.1) THEN
+!          WRITE(*,*) 'Pxtisup(:,il)=',Pxtisup(:,il)
+!          WRITE(*,*) 'xtwater(:,il,i+1)=',xtwater(:,il,i+1)
+!          WRITE(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il)
 !          stop
 !        endif !if (iso_verif_positif_nostop(Pxtisup(iso_eau,il)-
@@ -9605,17 +9516,17 @@
       enddo !do il=1,ncum 
 !      il=243     
-!         write(*,*) 'il,Pqisup,Pqiinf,Pqiinf_par=',
+!         WRITE(*,*) 'il,Pqisup,Pqiinf,Pqiinf_par=',
 !     ;         il,Pqisup(il),Pqiinf(il),Pqiinf_par(il)
-!         write(*,*) 'Eqi_prime,Eqi,Eqi_plus1,Eqi_par=',
+!         WRITE(*,*) 'Eqi_prime,Eqi,Eqi_plus1,Eqi_par=',
 !     ;         Eqi_prime(il),Eqi(il),Eqi_plus1(il),Eqi_par(il)
-!         write(*,*) 'evap(il,i:i+1)=',evap(il,i:i+1)
+!         WRITE(*,*) 'evap(il,i:i+1)=',evap(il,i:i+1)
 #endif      
 
       ! petite vérif sur les flux
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) 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
+               .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
@@ -9624,9 +9535,9 @@
             ! embétté car Eqi_prime indique qu'il y a évaporation... 
 #ifdef ISOVERIF  
-            write(*,*) 'appel_stewart_np 239: cas génant'  
+            WRITE(*,*) 'appel_stewart_np 239: cas génant'
 #endif                
 
             if (Eqi_prime(il)*fac_ftmr(il).lt. &
-                qp_avantevap(il)*1e-2) then
+                qp_avantevap(il)*1e-2) THEN
                 ! ouf: Eqi_prime a peut d'effet sur la vapeur du ddft.
                 ! on peut donc condenser tranquillement pour obtenir de
@@ -9635,22 +9546,20 @@
                 Eqi_prime(il)=Eqi_par(il)
 #ifdef ISOVERIF
-                write(*,*) 'appel_stewart 409: Eqi_prime=Eqi_par'
+                WRITE(*,*) 'appel_stewart 409: Eqi_prime=Eqi_par'
 #endif                
             else
-             write(*,*) 'appel_stewart_np 222: ce cas est très génant'
+             WRITE(*,*) 'appel_stewart_np 222: ce cas est très génant'
              stop
             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
@@ -9662,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
@@ -9668,20 +9577,20 @@
         endif
       enddo !do il=1,ncum
-!      if (ncum.ge.602) then
-!          write(*,*) 'appel_stewart_np tmp 379: avant parsage'
+!      if (ncum.ge.602) THEN
+!          WRITE(*,*) 'appel_stewart_np tmp 379: avant parsage'
 !          il=602
-!          write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
-!          write(*,*) 'ridicule,errmax=',ridicule,errmax
+!          WRITE(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
+!          WRITE(*,*) 'ridicule,errmax=',ridicule,errmax
 !      endif
 !#endif      
       do il=1,ncum 
-       if (i.le.inb(il) .and. lwork(il)) then 
+       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
+              (Eqi_prime(il)*fac_ftmr(il).lt.-ridicule*10)) THEN
             ! modif le 10 mai 2009: si Eqi_prime très petit, on le
             ! traite comme du 0
             ! 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
@@ -9691,5 +9600,5 @@
             trace_cas(il)=11
 !#endif            
-          else !if (fac_ftmr.gt.0.0) then
+          else !if (fac_ftmr.gt.0.0) THEN
             ! 1.2: si Mpi=0
             icas_condensation_nofacftmr=icas_condensation_nofacftmr+1  
@@ -9698,7 +9607,7 @@
             trace_cas(il)=12
 !#endif
-          endif !if (fac_ftmr.gt.0.0) then
+          endif !if (fac_ftmr.gt.0.0) THEN
         else if ((Eqi_prime(il).lt.ridicule*1e-3).and. &
-           (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) then
+           (Eqi_prime(il)*fac_ftmr(il).lt.ridicule*10)) THEN
             ! 2: Eqi_prime est compris entre 1e-14 et -1e-14: rien 
 !            ! 27 mai 2009: on remplace le seuil pour Eqi_prime(il)*fac_ftmr(il)
@@ -9718,29 +9627,29 @@
 #ifdef ISOVERIF
             if ((Pqisup(il).le.0.0).and. &
-                (water(il,i).gt.ridicule)) then
-              write(*,*) 'appel_stewart_np 420: water=',water(il,i)
-              write(*,*) 'Pqisup,Eqi_prime,fac_ftmr=',Pqisup(il), &
+                (water(il,i).gt.ridicule)) THEN
+              WRITE(*,*) 'appel_stewart_np 420: water=',water(il,i)
+              WRITE(*,*) 'Pqisup,Eqi_prime,fac_ftmr=',Pqisup(il), &
                  Eqi_prime(il),fac_ftmr(il)
               stop
             endif    
-            if (iso_eau.gt.0) then
+            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
-               write(*,*) 'Mp(il,i)=',Mp(il,i)
-               write(*,*) 'Mp(il,i+1)=',Mp(il,i+1)
-               write(*,*) 'qp(il,i)=',qp(il,i)
-               write(*,*) 'qp(il,i+1)=',qp(il,i+1)
-               write(*,*) 'q(il,i)=',q(il,i)
-               write(*,*) 'evap(il,i)=',evap(il,i)
-               write(*,*) 'evap(il,i+1)=',evap(il,i+1)
-               write(*,*) 'Eqi_prime(il)=',Eqi_prime(il)
-               write(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
+                errmax,errmaxrel).eq.1) THEN
+               WRITE(*,*) 'Mp(il,i)=',Mp(il,i)
+               WRITE(*,*) 'Mp(il,i+1)=',Mp(il,i+1)
+               WRITE(*,*) 'qp(il,i)=',qp(il,i)
+               WRITE(*,*) 'qp(il,i+1)=',qp(il,i+1)
+               WRITE(*,*) 'q(il,i)=',q(il,i)
+               WRITE(*,*) 'evap(il,i)=',evap(il,i)
+               WRITE(*,*) 'evap(il,i+1)=',evap(il,i+1)
+               WRITE(*,*) 'Eqi_prime(il)=',Eqi_prime(il)
+               WRITE(*,*) 'fac_ftmr(il)=',fac_ftmr(il)
                stop
              endif
-            endif !if (iso_eau.gt.0) then
-#endif
-        else    !if (Eqi_prime.lt.0.0) then
+            endif !if (iso_eau.gt.0) THEN
+#endif
+        else    !if (Eqi_prime.lt.0.0) THEN
         ! 3: Eqi_prime>0 
 #ifdef ISOVERIF  
@@ -9748,28 +9657,28 @@
 !             if (iso_verif_positif_nostop((
 !     :            Pqisup(il)-Eqi_prime(il)),
-!     :            'appel_stewart_np 388 nostop ').eq.1) then
-!               write(*,*) 'il,Pqisup=',il,Pqisup(il)
-!               write(*,*) 'Eqi_prime=',Eqi_prime(il)
-!               write(*,*) 'Pqiinf=',Pqiinf(il)
-!!               write(*,*) 'stop temporaire, à enlever'
+!     :            'appel_stewart_np 388 nostop ').eq.1) THEN
+!               WRITE(*,*) 'il,Pqisup=',il,Pqisup(il)
+!               WRITE(*,*) 'Eqi_prime=',Eqi_prime(il)
+!               WRITE(*,*) 'Pqiinf=',Pqiinf(il)
+!!               WRITE(*,*) 'stop temporaire, à enlever'
 !!               stop
 !              endif
               if (iso_verif_positif_choix_nostop(( &
                 Pqisup(il)-Pqiinf_par(il)),errmax, &
-                'appel_stewart_np 442').eq.1) then
-                write(*,*) 'appel_stewart_np 174'
-                write(*,*) 'Pqisup=',Pqisup(il), &
+                'appel_stewart_np 442').eq.1) THEN
+                WRITE(*,*) 'appel_stewart_np 174'
+                WRITE(*,*) 'Pqisup=',Pqisup(il), &
                 ' Pqiinf_par=',Pqiinf_par(il)
                 stop
               endif               
               if (iso_verif_positif_nostop((Eqi_par(il)), &
-                'appel_stewart_np 559b').eq.1) then
-                write(*,*) 'Eqi(il),Eqi_plus1(il),Eqi_prime(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)
-                write(*,*) 'Pqisup(il),Pqiinf(il),Eqi_par(il)=', &
+                WRITE(*,*) 'Pqisup(il),Pqiinf(il),Eqi_par(il)=', &
                         Pqisup(il),Pqiinf(il),Eqi_par(il)
               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  
@@ -9778,5 +9687,5 @@
                 trace_cas(il)=31
 !#endif
-              else !if (T(il,i).ge.ztglace_kelvin) then
+              else !if (T(il,i).ge.ztglace_kelvin) THEN
                 ! 3.2: evap de la glace
                 icas_evap_glace=icas_evap_glace+1  
@@ -9785,7 +9694,7 @@
                 trace_cas(il)=32
 !#endif  
-              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 (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
       enddo  !do il=1,ncum 
 
@@ -9797,27 +9706,27 @@
 
 #ifdef ISOVERIF
-!      write(*,*) 'appel_stewart_np vectoriel 355: parsage des cas:'
-!      if (ncum.ge.602) then
-!          write(*,*) 'trace_cas(602)=',trace_cas(602)
+!      WRITE(*,*) 'appel_stewart_np vectoriel 355: parsage des cas:'
+!      if (ncum.ge.602) THEN
+!          WRITE(*,*) 'trace_cas(602)=',trace_cas(602)
 !      endif  
       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
       enddo
-!      write(*,*) 'i,ncum,ncas_tot=',i,ncum,ncas_tot
-!      write(*,*) 'ncas_condensation_facftmr=',ncas_condensation_facftmr
-!      write(*,*) 'ncas_condensation_nofacftmr=',
+!      WRITE(*,*) 'i,ncum,ncas_tot=',i,ncum,ncas_tot
+!      WRITE(*,*) 'ncas_condensation_facftmr=',ncas_condensation_facftmr
+!      WRITE(*,*) 'ncas_condensation_nofacftmr=',
 !     &           ncas_condensation_nofacftmr
-!      write(*,*) 'ncas_noevap=',ncas_noevap
-!      write(*,*) 'ncas_evap_liq_=',ncas_evap_liq
-!      write(*,*) 'ncas_evap_glace=',ncas_evap_glace
+!      WRITE(*,*) 'ncas_noevap=',ncas_noevap
+!      WRITE(*,*) 'ncas_evap_liq_=',ncas_evap_liq
+!      WRITE(*,*) 'ncas_evap_glace=',ncas_evap_glace
       if (ncas_tot.ne.ncas_condensation_facftmr &
                +ncas_condensation_nofacftmr &
                +ncas_noevap &
                +ncas_evap_liq &
-               +ncas_evap_glace) then
-         write(*,*) 'mauvais parsage'
+               +ncas_evap_glace) THEN
+         WRITE(*,*) 'mauvais parsage'
          stop
        endif
@@ -9827,7 +9736,7 @@
       ! ****** 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)=', &
+!      WRITE(*,*) 'cas_condensation_facftmr(1)=', &
 !     &          cas_condensation_facftmr(1)
 !#endif
@@ -9852,9 +9761,9 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-!      write(*,*) 'appel_stewart_np tmp 506: ', &
+!      WRITE(*,*) 'appel_stewart_np tmp 506: ', &
 !     &          'après compress_condensation_facftmr'
-!      write(*,*) 'sigd_cas(1:3)=',sigd_cas(1:3)
-!      if (ncas_condensation_facftmr.ge.4) then
-!          write(*,*) 'cas_condensation_facftmr(4)=', &
+!      WRITE(*,*) 'sigd_cas(1:3)=',sigd_cas(1:3)
+!      if (ncas_condensation_facftmr.ge.4) THEN
+!          WRITE(*,*) 'cas_condensation_facftmr(4)=', &
 !     &          cas_condensation_facftmr(4)
 !      endif
@@ -9868,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)), &
@@ -9874,5 +9783,5 @@
               'appel_stewart_np 520: compress condensation_facftmr', &
               errmax,errmax)
-        endif ! if (iso_eau.gt.0) then
+        endif ! if (iso_eau.gt.0) THEN
       enddo
 #endif                  
@@ -9911,5 +9820,5 @@
 
 !#ifdef ISOVERIF     
-!       write(*,*) 'appel_stewart_np tmp 538: condensation_facftmr, izone=',
+!       WRITE(*,*) 'appel_stewart_np tmp 538: condensation_facftmr, izone=',
 !     :          izone
 !#endif      
@@ -9931,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( &
@@ -9938,5 +9847,5 @@
                 'appel_stewart_np 558',errmax,errmaxrel)
           enddo !do il=1,ncas_condensation_nofacftmr
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif
         CALL make_condensation_facftmr(ncas_condensation_facftmr, &
@@ -9970,17 +9879,17 @@
 
 #ifdef ISOVERIF
-!        write(*,*) 'appel_stewart_np tmp 574: ',
+!        WRITE(*,*) 'appel_stewart_np tmp 574: ',
 !     :           'fin cas condensation_facftmr'
             do il=1,ncas_condensation_facftmr
-!               write(*,*) 'il,cas_condensation_facftmr(il)=',
+!               WRITE(*,*) 'il,cas_condensation_facftmr(il)=',
 !     :           il,cas_condensation_facftmr(il)
-!               write(*,*) 'xtp(1:ntraciso:3)=',xtp(1:ntraciso:3,
+!               WRITE(*,*) 'xtp(1:ntraciso:3)=',xtp(1:ntraciso:3,
 !     :           cas_condensation_facftmr(il),i)
-!               write(*,*) 'xtp_avantevap(1:ntraciso:3)=',
+!               WRITE(*,*) 'xtp_avantevap(1:ntraciso:3)=',
 !     :           xtp_avantevap(1:ntraciso:3,
 !     :           cas_condensation_facftmr(il))
-!               if (il.eq.cas_condensation_facftmr(602)) then
-!                write(*,*) 'appel_stewart_np 638: il=602'
-!                write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
+!               if (il.eq.cas_condensation_facftmr(602)) THEN
+!                WRITE(*,*) 'appel_stewart_np 638: il=602'
+!                WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
 !     :           xtp(iso_eau:ntraciso:3,cas_condensation_facftmr(il),i)
 !               endif
@@ -10000,11 +9909,8 @@
         !#ifdef ISOTRAC    
 
-           endif !if (ncas_condensation_facftmr.gt.0) then
-
-
+           endif !if (ncas_condensation_facftmr.gt.0) THEN
         ! ****** 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, &
@@ -10027,7 +9933,7 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-!      write(*,*) 'appel_stewart_np tmp 616: ', &
+!      WRITE(*,*) 'appel_stewart_np tmp 616: ', &
 !     &          'apres compress condensation_nofacftmr'
-!      write(*,*) 'iso_routines 10153: sigd_cas(1:3)=', sigd_cas(1:3)
+!      WRITE(*,*) 'iso_routines 10153: sigd_cas(1:3)=', sigd_cas(1:3)
       do il=1,ncas_condensation_nofacftmr
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -10075,5 +9981,5 @@
 #ifdef ISOTRAC
        do izone=1,ntraceurs_zone
-!         write(*,*) 'appel_stewart_np 718: izone=',izone
+!         WRITE(*,*) 'appel_stewart_np 718: izone=',izone
 
          CALL compress_cond_nofftmr_zone( &
@@ -10115,5 +10021,5 @@
        enddo !do izone=1,ntraceurs_zone
 #ifdef ISOVERIF
-!       write(*,*) 'appel_stewart_np tmp 690: ', &
+!       WRITE(*,*) 'appel_stewart_np tmp 690: ', &
 !     &          'fin du cas condensation_nofacftmr'
             do il=1,ncas_condensation_nofacftmr
@@ -10132,11 +10038,8 @@
 #endif            
        
-        endif !if (ncas_condensation_nofacftmr.gt.0) then
-
-        
+        endif !if (ncas_condensation_nofacftmr.gt.0) THEN
         ! ****** traitement vectoriel du cas 2
 
-      if (ncas_noevap.gt.0) then
-
+      if (ncas_noevap.gt.0) THEN
       CALL compress_noevap(ncas_noevap, &
          cas_noevap, &
@@ -10154,5 +10057,5 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-!      write(*,*) 'appel_stewart_np 719: apres compression iso noevap'
+!      WRITE(*,*) 'appel_stewart_np 719: apres compression iso noevap'
       do il=1,ncas_noevap
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -10162,5 +10065,5 @@
                 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)), &
@@ -10170,6 +10073,6 @@
                 (xtp_avantevap(iso_eau,cas_noevap(il))), &
                 qp(cas_noevap(il),i), &
-                'appel_stewart_np 739',errmax,errmaxrel).eq.1) then
-           write(*,*) 'il,cas_noevap=',il,cas_noevap(il)
+                'appel_stewart_np 739',errmax,errmaxrel).eq.1) THEN
+           WRITE(*,*) 'il,cas_noevap=',il,cas_noevap(il)
            stop
         endif
@@ -10178,5 +10081,5 @@
                 qp_cas(il), &
                 'appel_stewart_np 735',errmax,errmaxrel)
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
       enddo !do il=1,ncas_noevap
 #endif      
@@ -10223,5 +10126,5 @@
 
 #ifdef ISOVERIF
-!        write(*,*) 'appel_stewart_np 765: après compression isotrac'
+!        WRITE(*,*) 'appel_stewart_np 765: après compression isotrac'
         do il=1,ncas_noevap
           CALL iso_verif_egalite_choix( &
@@ -10248,5 +10151,5 @@
 
 #ifdef ISOVERIF
-!        write(*,*) 'appel_stewart_np tmp 806: ',
+!        WRITE(*,*) 'appel_stewart_np tmp 806: ',
 !     &          'fin du cas noevap'
        do il=1,ncas_noevap
@@ -10262,12 +10165,8 @@
 #endif       
 
-        endif !if (ncas_noevap.gt.0) then
-
-
+        endif !if (ncas_noevap.gt.0) THEN
         ! ****** 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, &
@@ -10296,16 +10195,16 @@
 #ifdef ISOVERIF
       ! vérif de la compression
-!      write(*,*) 'appel_stewart_np tmp 899: ',
+!      WRITE(*,*) 'appel_stewart_np tmp 899: ',
 !     :           'apres compress_evap_liq'
-!      write(*,*) 'cas_evap_liq(1)=',cas_evap_liq(1)
-!      if (ncas_evap_liq.ge.85) then
-!      write(*,*) 'cas_evap_liq(85)=',cas_evap_liq(85)
+!      WRITE(*,*) 'cas_evap_liq(1)=',cas_evap_liq(1)
+!      if (ncas_evap_liq.ge.85) THEN
+!      WRITE(*,*) 'cas_evap_liq(85)=',cas_evap_liq(85)
 !      endif
-!      write(*,*) 'Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas',
+!      WRITE(*,*) 'Eqi_stewart,Pqiinf_stewart,Eqi_prime_cas,Eqi_cas',
 !     :    Eqi_stewart(1),Pqiinf_stewart(1),
 !     :    Eqi_prime_cas(1),Eqi_cas(1)
       do il=1,ncas_evap_liq
-!       write(*,*) 'il=',il
-!      write(*,*) 'qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il)=',
+!       WRITE(*,*) 'il=',il
+!      WRITE(*,*) 'qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il)=',
 !     :    qp_avantevap_cas(il),xtp_avantevap_cas(iso_eau,il) 
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -10322,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)), &
@@ -10328,5 +10227,5 @@
               'appel_stewart_np 789: compression evap_liq', &
                errmax,errmax)
-        endif ! if (iso_eau.gt.0) then  
+        endif ! if (iso_eau.gt.0) THEN
         CALL iso_verif_positif((Eqi_stewart(il)), &
                 'appel_stewart_np 1124: compression evap_liq')
@@ -10338,9 +10237,9 @@
       enddo   !do il=1,ncas_evap_liq
 
-!      write(*,*) 'appel tmp 802: xtp_avantevap_cas(iso_eau,2)=',
+!      WRITE(*,*) 'appel tmp 802: xtp_avantevap_cas(iso_eau,2)=',
 !     :           xtp_avantevap_cas(iso_eau,2)
-!      write(*,*) 'appel tmp 1490: qp_avantevap_cas(2)=',
+!      WRITE(*,*) 'appel tmp 1490: qp_avantevap_cas(2)=',
 !     :           qp_avantevap_cas(2)
-!       write(*,*) 'appel_stewart_np 933: make_cas_evap_liq_np pr eau normale'
+!       WRITE(*,*) 'appel_stewart_np 933: make_cas_evap_liq_np pr eau normale'
 
        ! ici, ptrac ne sera pas utilisé
@@ -10384,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
@@ -10399,8 +10298,8 @@
       do izone=1,ntraceurs_zone      
       
-!       write(*,*) 'appel_stewart_np 924 tmp: cas liq: izone=',izone 
-!       write(*,*) 'appel 924: xtp_avantevap(c,cas(2))=',
+!       WRITE(*,*) 'appel_stewart_np 924 tmp: cas liq: izone=',izone
+!       WRITE(*,*) 'appel 924: xtp_avantevap(c,cas(2))=',
 !     &          xtp_avantevap(1:ntraciso:3,cas_evap_liq(2))
-!       write(*,*) 'Pxtisup(1:ntraciso:3,cas(2))=',
+!       WRITE(*,*) 'Pxtisup(1:ntraciso:3,cas(2))=',
 !     &          Pxtisup(1:ntraciso:3,cas_evap_liq(2))
        CALL compress_evap_liq_zone(3,ncas_evap_liq, &
@@ -10421,23 +10320,23 @@
 
 #ifdef ISOVERIF
-!       write(*,*) 'appel_stewart_np tmp 941'
-!       if (ncas_evap_liq.ge.162) then
-!          write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(162)
-!           write(*,*) 'Pqisup=',Pqisup(cas_evap_liq(162))
-!           write(*,*) 'Eqi_prime=',Eqi_prime(cas_evap_liq(162))
-!           write(*,*) 'Pxtisup=',
+!       WRITE(*,*) 'appel_stewart_np tmp 941'
+!       if (ncas_evap_liq.ge.162) THEN
+!          WRITE(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(162)
+!           WRITE(*,*) 'Pqisup=',Pqisup(cas_evap_liq(162))
+!           WRITE(*,*) 'Eqi_prime=',Eqi_prime(cas_evap_liq(162))
+!           WRITE(*,*) 'Pxtisup=',
 !     :           Pxtisup(iso_eau:ntraciso:3,cas_evap_liq(162))
 !       endif
-!        write(*,*) 'qp_avantevap_cas(2)=',
+!        WRITE(*,*) 'qp_avantevap_cas(2)=',
 !     :           qp_avantevap_cas(2)
-!       write(*,*) 'xtp_avantevap(iso_eau,cas_evap_liq(1))=',
+!       WRITE(*,*) 'xtp_avantevap(iso_eau,cas_evap_liq(1))=',
 !     :           xtp_avantevap(iso_eau,cas_evap_liq(1))
-!       write(*,*) 'xtp_avantevap_cas(iso_eau,2)=',
+!       WRITE(*,*) 'xtp_avantevap_cas(iso_eau,2)=',
 !     :           xtp_avantevap_cas(iso_eau,2)
-!       write(*,*) 'xtp_avantevaptrac_cas(iso_eau,2)=',
+!       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
+!             WRITE(*,*) 'appel_stewart_np tmp 943: il=',il
              CALL iso_verif_egalite_choix( &
               (qp_avantevap(cas_evap_liq(il))), &
@@ -10461,18 +10360,18 @@
                 errmax,errmaxrel)
 !             if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) then
-!               if (izone.eq.izone_cond) then
+!     :           (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 (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
+       endif !if (iso_eau.gt.0) THEN
 #endif       
 
@@ -10521,25 +10420,25 @@
            
            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))=', &
+                '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
-                 write(*,*) 'cas evap_liq'
-                 write(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
+             if (trace_cas(cas_evap_liq(il)).eq.31) THEN
+                 WRITE(*,*) 'cas evap_liq'
+                 WRITE(*,*) 'xtp(:,cas_evap_liq(il),i)=', &
                    xtp(:,cas_evap_liq(il),i)
-                 write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-                 write(*,*) 'Eqi_stewart(il),Eqi_prime=', &
+                 WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+                 WRITE(*,*) 'Eqi_stewart(il),Eqi_prime=', &
                         Eqi_stewart(il),Eqi_prime(cas_evap_liq(il))
-                 write(*,*) 'Pxtisup(:,cas_evap_liq(il))=', &
+                 WRITE(*,*) 'Pxtisup(:,cas_evap_liq(il))=', &
                         Pxtisup(:,cas_evap_liq(il))
-                 write(*,*) 'xtp_avantevap(:,cas_evap_liq(il))=', &
+                 WRITE(*,*) 'xtp_avantevap(:,cas_evap_liq(il))=', &
                        xtp_avantevap(:,cas_evap_liq(il))
-                 write(*,*) 'Exi(:,cas_evap_liq(il))=', &
+                 WRITE(*,*) 'Exi(:,cas_evap_liq(il))=', &
                        Exi(:,cas_evap_liq(il))
-                 write(*,*) 'T_cas(il)=',T_cas(il)
-                 write(*,*) 'h(il)=',thumxt1+(1.0-thumxt1)* &
+                 WRITE(*,*) 'T_cas(il)=',T_cas(il)
+                 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
@@ -10557,5 +10456,5 @@
            CALL iso_verif_traceur_justmass(xtevap(1,cas_evap_liq(il),i), &
                 'appel_stewart_np 1258')
-!           write(*,*) 'appel_stewart_np tmp 1172: il,i=',il,i          
+!           WRITE(*,*) 'appel_stewart_np tmp 1172: il,i=',il,i
            CALL iso_verif_traceur(xtwater(1,cas_evap_liq(il),i), &
                 'appel_stewart_np 1260')
@@ -10565,14 +10464,8 @@
 #endif
 
-        endif !if (ncas_evap_liq.gt.0) then
-
-       
-        
-
+        endif !if (ncas_evap_liq.gt.0) THEN
                 ! ****** 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, &
@@ -10598,12 +10491,12 @@
 
 #ifdef ISOVERIF
-!      write(*,*) 'appel_stewart_np tmp 898 apres compress glace'
-!      write(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
+!      WRITE(*,*) 'appel_stewart_np tmp 898 apres compress glace'
+!      WRITE(*,*) 'qp_avantevap_cas(1),qp_avantevap(cas(1))=',
 !     &   qp_avantevap_cas(1),qp_avantevap(cas_evap_glace(1))   
-      !write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
+      !WRITE(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
       ! vérif de la compression
       do il=1,ncas_evap_glace
-!       write(*,*) 'il=',il
-!      write(*,*) 'qp_avantevap_cas(il),qp_avantevap(cas(il))=',
+!       WRITE(*,*) 'il=',il
+!      WRITE(*,*) 'qp_avantevap_cas(il),qp_avantevap(cas(il))=',
 !     :    qp_avantevap_cas(il),qp_avantevap(cas_evap_glace(il)) 
         CALL iso_verif_egalite_choix((Pqisup_cas(il)), &
@@ -10629,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)), &
@@ -10637,8 +10530,8 @@
         endif      
       enddo
-!       write(*,*) 'appel_stewart_np tmp 1054:',
+!       WRITE(*,*) 'appel_stewart_np tmp 1054:',
 !     :   ' appel make_cas_evap_glace_np'
-!       write(*,*) 'cas_evap_glace(1)=',cas_evap_glace(1)
-!       write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
+!       WRITE(*,*) 'cas_evap_glace(1)=',cas_evap_glace(1)
+!       WRITE(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
 #endif   
       
@@ -10659,5 +10552,5 @@
 
 !#ifdef ISOVERIF    
-!        write(*,*) 'appel_stewart_np tmp 1073 après make_cas_evap_glace_np'
+!        WRITE(*,*) 'appel_stewart_np tmp 1073 après make_cas_evap_glace_np'
 !#endif
 
@@ -10682,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
@@ -10694,5 +10587,5 @@
 
        do izone=1,ntraceurs_zone
-!       write(*,*) 'tmp appel_stewart_np 1284: izone=',izone
+!       WRITE(*,*) 'tmp appel_stewart_np 1284: izone=',izone
 
        CALL compress_evap_glace_zone(3, &
@@ -10713,5 +10606,5 @@
 
 !#ifdef ISOVERIF    
-!        write(*,*) 'appel_stewart_np tmp 1101 CALL make_cas_evap_glace_np'
+!        WRITE(*,*) 'appel_stewart_np tmp 1101 CALL make_cas_evap_glace_np'
 !#endif       
        CALL make_cas_evap_glace_np(ncas_evap_glace, &
@@ -10743,26 +10636,26 @@
 
 #ifdef ISOVERIF    
-!        write(*,*) 'appel_stewart_np tmp 1117: ',
+!        WRITE(*,*) 'appel_stewart_np tmp 1117: ',
 !     :           'fin du cas evap_glace'   
         do il=1,ncas_evap_glace
-!           write(*,*) 'appel_stewart_np tmp 1146: il=',il            
-!           write(*,*) 'xtp_avantevap=',xtp_avantevap
+!           WRITE(*,*) 'appel_stewart_np tmp 1146: il=',il
+!           WRITE(*,*) 'xtp_avantevap=',xtp_avantevap
 !     :           (1:ntraciso,cas_evap_glace(il))
-!           write(*,*) 'xtp=',xtp(1:ntraciso,cas_evap_glace(il),i)
+!           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
-             write(*,*) 'il,cas_evap_glace(il)=',il,cas_evap_glace(il)
-             write(*,*) 'trace_cas(cas_evap_glace(il))=', &
+                '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))=', &
                 trace_cas(cas_evap_glace(il))
-             write(*,*) 'cas evap_glace'
-             write(*,*) 'xtp(:,cas_evap_glace(il),i)=', &
+             WRITE(*,*) 'cas evap_glace'
+             WRITE(*,*) 'xtp(:,cas_evap_glace(il),i)=', &
                    xtp(:,cas_evap_glace(il),i)
-             write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-             write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
-             write(*,*) 'Pxtisup(:,cas_evap_glace(il))=', &
+             WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+             WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
+             WRITE(*,*) 'Pxtisup(:,cas_evap_glace(il))=', &
                         Pxtisup(:,cas_evap_glace(il))
-             write(*,*) 'xtp_avantevap(:,cas_evap_glace(il))=', &
+             WRITE(*,*) 'xtp_avantevap(:,cas_evap_glace(il))=', &
                        xtp_avantevap(:,cas_evap_glace(il))
-             write(*,*) 'Exi(:,cas_evap_glace(il))=', &
+             WRITE(*,*) 'Exi(:,cas_evap_glace(il))=', &
                        Exi(:,cas_evap_glace(il))
              ! on laisse quand même une chance
@@ -10779,7 +10672,5 @@
 #endif
 
-        endif !if (ncas_evap_glace.gt.0) then
-
-
+        endif !if (ncas_evap_glace.gt.0) THEN
        ! ****** dernières vérifs et bidouilles
 
@@ -10787,5 +10678,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
              do ixt=1,ntraciso
                if ((iso_verif_noNAN_nostop(xtevap(ixt,il,i), &
@@ -10794,26 +10685,26 @@
                   'appel_stewart_np 1382').eq.1).or. &
                   (iso_verif_noNAN_nostop(xtwater(ixt,il,i), &
-                  'appel_stewart_np 1381').eq.1)) then
-                 write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
+                  '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 (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
-               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
+              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( &
               xtp(iso_eau,il,i),qp(il,i),'appel_stewart_np 1278', &
-              errmax,errmaxrel*50).eq.1) then
-               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
+              errmax,errmaxrel*50).eq.1) THEN
+               WRITE(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
                stop 
               endif  !if (iso_verif_egalite_choix_nostop(
@@ -10821,19 +10712,19 @@
               xtevap(iso_eau,il,i),evap(il,i), &
               'appel_stewart_np 1279', &
-              errmax,errmaxrel).eq.1) then
-               write(*,*) 'il,i,trace_cas=',il,i,trace_cas(il)
+              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
+             endif !if (iso_eau.gt.0) THEN
              if ((iso_HDO.gt.0).and. &
-                (qp(il,i).gt.ridicule)) then
+                (qp(il,i).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
                 xtp(iso_HDO,il,i)/qp(il,i), &
                 'appel_stewart_np 1498')
-             endif  ! if (iso_HDO.gt.0) then
+             endif  ! if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
-!           if (il.eq.602) then
-!              write(*,*) 'appel_stewart_np 1334: il,i=',il,i
-!              write(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
+!           if (il.eq.602) THEN
+!              WRITE(*,*) 'appel_stewart_np 1334: il,i=',il,i
+!              WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=',
 !     :          xtp(iso_eau:ntraciso:3,il,i) 
 !           endif
@@ -10845,21 +10736,21 @@
                 'appel_stewart_np 1636')
 !           if ((option_traceurs.eq.17).or.
-!     :           (option_traceurs.eq.18)) then
+!     :           (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
-!             write(*,*) 'il,trace_cas=',il,trace_cas(il)
+!     :           '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  
-           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) 
@@ -10877,10 +10768,9 @@
 #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
-
+        endif !if (bidouille_anti_divergence) THEN
 !#ifdef ISOVERIF
-!        write(*,*) 'appel_stewart_np tmp 1197: sortie'
+!        WRITE(*,*) 'appel_stewart_np tmp 1197: sortie'
 !#endif
 
@@ -10924,7 +10814,7 @@
         !real 
 
-!        write(*,*) 'appel_stewart_np tmp 1530: Pxtisup_cas(iso_eau,2)=',
+!        WRITE(*,*) 'appel_stewart_np tmp 1530: Pxtisup_cas(iso_eau,2)=',
 !     &          Pxtisup_cas(iso_eau,2)
-!        write(*,*) 'Pqisup_cas(2)=',Pqisup_cas(2)
+!        WRITE(*,*) 'Pqisup_cas(2)=',Pqisup_cas(2)
         do il=1,ncas
          do ixt=1,niso
@@ -10936,13 +10826,13 @@
        do il=1,ncas
         if ((Pqisup_cas(il).le.0.0).and. &
-                (water_cas(il).gt.ridicule*10)) then
+                (water_cas(il).gt.ridicule*10)) THEN
             ! 27 mai 2009: on est plus laxiste dans le cas des traceurs
             ! d'eau: on met ridicule*10
-            write(*,*) 'appel_stewart_np 372: water(il,i)=', &
+            WRITE(*,*) 'appel_stewart_np 372: water(il,i)=', &
               water_cas(il)
-            write(*,*) 'appel_stewart_np 372: Pqisup=',Pqisup_cas(il)
+            WRITE(*,*) 'appel_stewart_np 372: Pqisup=',Pqisup_cas(il)
             stop
          endif
-         if (iso_eau.gt.0) then
+         if (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix( &
                 (Pxtisup_cas(iso_eau,il)), &
@@ -10956,14 +10846,14 @@
         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)
               xtwater_cas(ixt,il)=water_cas(il)*Risup(ixt,il)
             enddo !do ixt=1,niso
-         else !if (Pqisup.gt.0.0) then
+         else !if (Pqisup.gt.0.0) THEN
            do ixt=1,niso
             xtwater_cas(ixt,il)=water_cas(il)*Rdefault(ixt)
            enddo !do ixt=1,niso  
-         endif  !if (Pqisup.gt.0.0) then  
+         endif  !if (Pqisup.gt.0.0) THEN
         enddo !do il=1,ncas_noevap 
 
@@ -10976,8 +10866,8 @@
                   'appel_stewart_np 286')
               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)
-                 write(*,*) 'Pxtisup_cas(ixt,il),Pqisup_cas(il)=', &
+                  'appel_stewart_np 1594').eq.1) THEN
+                 WRITE(*,*) 'il,ixt=',il,ixt
+                 WRITE(*,*) 'water_cas(il)=',water_cas(il)
+                 WRITE(*,*) 'Pxtisup_cas(ixt,il),Pqisup_cas(il)=', &
                   Pxtisup_cas(ixt,il),Pqisup_cas(il)
                  stop
@@ -10987,5 +10877,5 @@
 #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), &
@@ -10993,12 +10883,12 @@
                 errmax,errmaxrel)
               if ((xtwater_cas(iso_eau,il).eq.0).and. &
-                (water_cas(il).gt.ridicule)) then
-               write(*,*) 'appel_stewart_np 263.2, cas 1.1'
-               write(*,*) 'xtwater(iso_eau,il)=',xtwater_cas(iso_eau,il)
-               write(*,*) 'water(il)=',water_cas(il)
+                (water_cas(il).gt.ridicule)) THEN
+               WRITE(*,*) 'appel_stewart_np 263.2, cas 1.1'
+               WRITE(*,*) 'xtwater(iso_eau,il)=',xtwater_cas(iso_eau,il)
+               WRITE(*,*) 'water(il)=',water_cas(il)
                stop
               endif
-              if (oktrac.eq.0) then
-!                  write(*,*) 'appel_stewart_np 1743 noevap tmp: il=',il
+              if (oktrac.eq.0) THEN
+!                  WRITE(*,*) 'appel_stewart_np 1743 noevap tmp: il=',il
              CALL iso_verif_egalite_choix(xtp_cas(iso_eau,il), &
                 qp_cas(il) &
@@ -11008,18 +10898,18 @@
                 '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
+            endif ! if (iso_eau.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_np 613')
-                endif !if (qp(cas_noevap(il),i).gt.ridicule) then   
+                endif !if (qp(cas_noevap(il),i).gt.ridicule) THEN
               enddo !do il=1,ncas 
-            endif  ! if (iso_HDO.gt.0) then
-            endif !if (oktrac.eq.0) then
+            endif  ! if (iso_HDO.gt.0) THEN
+            endif !if (oktrac.eq.0) THEN
 #endif           
 
@@ -11051,5 +10941,5 @@
 USE isotopes_verif_mod
 #ifdef ISOTRAC
-  USE isotrac_mod, only: ridicule_trac
+  USE isotrac_mod, ONLY: ridicule_trac
 #endif
 #endif
@@ -11105,13 +10995,13 @@
 
 #ifdef ISOVERIF
-!        if (ncas.ge.162) then
-!        write(*,*) 'appel tmp 1975: xtp_avantevap_cas(iso_eau,162)=',
+!        if (ncas.ge.162) THEN
+!        WRITE(*,*) 'appel tmp 1975: xtp_avantevap_cas(iso_eau,162)=',
 !     :           xtp_avantevap_cas(iso_eau,162)
-!        write(*,*) 'appel tmp 1975b: qp_avantevap_cas(162)=',
+!        WRITE(*,*) 'appel tmp 1975b: qp_avantevap_cas(162)=',
 !     :           qp_avantevap_cas(162)
-!        endif !if (ncas_evap_liq.ge.162) then
-      if (iso_eau.gt.0) then
+!        endif !if (ncas_evap_liq.ge.162) THEN
+      if (iso_eau.gt.0) THEN
           do il=1,ncas
-!            write(*,*) 'appel tmp 1492: il=',il
+!            WRITE(*,*) 'appel tmp 1492: il=',il
             CALL iso_verif_egalite_choix( &
              (xtp_avantevap_cas(iso_eau,il)), &
@@ -11130,5 +11020,5 @@
              (Eqi_stewart(il)),'appel_stewart_np 1908')
            enddo !do il=1,ncas
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
        do il=1,ncas
           CALL iso_verif_positif((Eqi_stewart(il)), &
@@ -11139,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)
@@ -11151,5 +11041,5 @@
                Pxtisup_cas(ixt,il)=Pxtisup_cas(ixt,il)/ptrac(il)
              enddo
-            else !if (ptrac(il).gt.0.0) then
+            else !if (ptrac(il).gt.0.0) THEN
 #ifdef ISOVERIF                
              CALL iso_verif_egalite((Pqisup_cas(il)), &
@@ -11166,11 +11056,11 @@
                Pxtisup_cas(ixt,il)=0.0
              enddo   
-            endif !if (ptrac(il).gt.0.0) then
+            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), &
@@ -11179,6 +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), &
@@ -11193,9 +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
@@ -11214,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( &
@@ -11230,11 +11118,11 @@
                 '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)), &
                    1.,'appel_setwart 575a', errmax*10, errmaxrel*10)
-                endif !if (Pqiinf_par.gt.ridicule) then
+                endif !if (Pqiinf_par.gt.ridicule) THEN
            enddo !do il=1,ncas     
-        endif !if (iso_eau.gt.0) then  
+        endif !if (iso_eau.gt.0) THEN
 #endif  
 #ifdef ISOVERIF
@@ -11257,15 +11145,15 @@
         ! 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) &
                    *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
                enddo
-             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
+             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) THEN
                  ! normalement, ce cas a déjà été interdit dans
                  ! compress_evp_glace
@@ -11274,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
         
@@ -11283,24 +11171,24 @@
                '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 (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
-!               write(*,*) 'i=',i
-               write(*,*) 'Tevap=',T_cas(il)
-               write(*,*) 'xtwater(iso_eau,il,i)=', &
+                'appel stewart 155',errmax*10,errmaxrel*10).eq.1) THEN
+!               WRITE(*,*) 'i=',i
+               WRITE(*,*) 'Tevap=',T_cas(il)
+               WRITE(*,*) 'xtwater(iso_eau,il,i)=', &
                         xtwater_cas(iso_eau,il)
-               write(*,*) 'water(il,i)=',water_cas(il)
-               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+               WRITE(*,*) 'water(il,i)=',water_cas(il)
+               WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                          Pxtiinf_stewart(iso_eau,il)
-!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
+!               WRITE(*,*) 'Pqiinf_par,Pqiinf_stewart=',
 !     :              Pqiinf_par(cas_evap_liq(il)),Pqiinf_stewart(il)
                stop
              endif  !if (iso_verif_egalite_nostop(
-         endif !if (water(il,i).gt.ridicule) then
-        endif !if (iso_eau.gt.0) then
+         endif !if (water(il,i).gt.ridicule) THEN
+        endif !if (iso_eau.gt.0) THEN
        enddo !do il=1,ncas
 #endif
@@ -11311,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          
@@ -11318,5 +11206,5 @@
                 /100/delP_cas(il)/sigd(il)*g
          enddo ! do ixt=1,niso
-        else !if (Eqi_stewart.gt.0.0) then
+        else !if (Eqi_stewart.gt.0.0) THEN
             ! il peut quand même y a voir de la diffusion
             do ixt=1,niso
@@ -11324,5 +11212,5 @@
                 /100.0/delP_cas(il)/sigd(il)*g
             enddo !do ixt=1,niso    
-        endif !if (Eqi_stewart.gt.0.0) then
+        endif !if (Eqi_stewart.gt.0.0) THEN
        enddo !do il=1,ncas
       
@@ -11333,10 +11221,10 @@
           'appel stewart 131').eq.1).or. &
            (iso_verif_noNAN_nostop(xtnew(ixt,il), &
-          'appel stewart 131b').eq.1)) then
-           write(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
-           write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)     
-           write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)    
-           write(*,*) 'Eqi_cas(il)=',Eqi_cas(il)     
-           write(*,*) 'xtevap_cas(ixt,il)=',xtevap_cas(ixt,il)
+          'appel stewart 131b').eq.1)) THEN
+           WRITE(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
+           WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
+           WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+           WRITE(*,*) 'Eqi_cas(il)=',Eqi_cas(il)
+           WRITE(*,*) 'xtevap_cas(ixt,il)=',xtevap_cas(ixt,il)
            stop
          endif
@@ -11346,28 +11234,28 @@
 #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_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
-              write(*,*) 'il=',il
-              write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-              write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
-              write(*,*) 'Exi_stewart(iso_eau,il)=', &
+                errmax,errmaxrel).eq.1) THEN
+              WRITE(*,*) 'il=',il
+              WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+              WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
+              WRITE(*,*) 'Exi_stewart(iso_eau,il)=', &
                 Exi_stewart(iso_eau,il)
-              write(*,*) '1/100/delP_cas(il)/sigd(il)*g*2=', &
+              WRITE(*,*) '1/100/delP_cas(il)/sigd(il)*g*2=', &
                  1.0/100.0/delP_cas(il)/sigd(il)*g*2.0
-              write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
+              WRITE(*,*) 'xtevapsup_cas(iso_eau,il)=', &
                 xtevapsup_cas(iso_eau,il)
               stop
             endif
-        endif !if (iso_eau.gt.0) then
-        endif !if (oktrac.eq.0) then 
+        endif !if (iso_eau.gt.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)), &
@@ -11375,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
@@ -11384,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)
@@ -11393,14 +11281,13 @@
                      *Exi_stewart(ixt,il)/Eqi_stewart(il),0.0)
                enddo !do ixt=1,niso
-             else ! if (Eqi_stewart.gt.ridicule) then
-                if (qp_cas(il).gt.0.0) then 
-
+             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) &
-                         then
+                         THEN
                         ! il va manquer quelque chose: il faut augmenter
                         ! xtp en lui ajoutant l'évap du niveau d'eau
                         ! dessus
                         ! pour l'instant, on bidouille:
-!                        write(*,*) 'appel_stewart_np 2041: il=',il
+!                        WRITE(*,*) 'appel_stewart_np 2041: il=',il
                         do ixt=1,niso               
                         xtnew(ixt,il)=xtnew(ixt,il) &
@@ -11419,34 +11306,33 @@
                       ! modif 1 mai 2009, pour le cas des traceurs
                     enddo !do ixt=1,niso
-!                    write(*,*) 'appel_stewart_np 1963 tmp: ',
+!                    WRITE(*,*) 'appel_stewart_np 1963 tmp: ',
 !     :                  'xtp_cas(iso_eau,il)=',xtp_cas(iso_eau,il)
-                else !if (qp(il,i).gt.0.0) then 
+                else !if (qp(il,i).gt.0.0) THEN
                   do ixt=1,niso               
                     xtp_cas(ixt,il)=0.0
                   enddo !do ixt=1,niso
-                endif  !if (qp(il,i).gt.0.0) then 
-            endif !if (Eqi_stewart.gt.ridicule) then 
-
+                endif  !if (qp(il,i).gt.0.0) THEN
+            endif !if (Eqi_stewart.gt.ridicule) THEN
 #ifdef ISOVERIF       
-!            if (il.eq.87) then
-!                write(*,*) 'appel_stewart_np 2244: tmp, après calcul xtp'
-!                write(*,*) 'xtnew(:,il)=',xtnew(:,il)
-!                write(*,*) 'Pxtiinf_stewart(:,il)=',
+!            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
-                write(*,*) 'i,INB_cas(il)=',i,INB_cas(il)
-                write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-                write(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
-                write(*,*) 'xtp_avantevaptrac_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)
+                WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+                WRITE(*,*) 'Eqi_stewart(il)=',Eqi_stewart(il)
+                WRITE(*,*) 'xtp_avantevaptrac_cas(ixt,il)=', &
                        xtp_avantevaptrac_cas(ixt,i)
-                write(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
-                write(*,*) 'xtnew(ixt,il)=',xtnew(ixt,il)
-                write(*,*) 'xtp_avantevap_cas(ixt,il)=', &
+                WRITE(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
+                WRITE(*,*) 'xtnew(ixt,il)=',xtnew(ixt,il)
+                WRITE(*,*) 'xtp_avantevap_cas(ixt,il)=', &
                        xtp_avantevap_cas(ixt,il)
-                write(*,*) 'qp_cas(il)=',qp_cas(il)
+                WRITE(*,*) 'qp_cas(il)=',qp_cas(il)
                 stop
               endif !if (iso_verif_noNAN(xtp_cas(ixt,il),
@@ -11455,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
@@ -11465,28 +11351,28 @@
                 xtp_cas(iso_HDO,il),xtp_cas(iso_eau,il), &
                 ridicule_trac,deltalimtrac, &
-                'appel_stewart_np 2090').eq.1) then
-                  write(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
+                'appel_stewart_np 2090').eq.1) THEN
+                  WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau),deltaD=', &
                    xtp_avantevaptrac_cas(iso_eau,il),deltaD &
                    ((xtp_avantevaptrac_cas(iso_HDO,il)) &
                    /(xtp_avantevaptrac_cas(iso_eau,il)))
-                  write(*,*) 'xtp_avantevap_cas(iso_eau),deltaD=', &
+                  WRITE(*,*) 'xtp_avantevap_cas(iso_eau),deltaD=', &
                    xtp_avantevap_cas(iso_eau,il),deltaD &
                    ((xtp_avantevap_cas(iso_HDO,il)) &
                    /(xtp_avantevap_cas(iso_eau,il)))
-                  write(*,*) 'xtnew(iso_eau),deltaD=', &
+                  WRITE(*,*) 'xtnew(iso_eau),deltaD=', &
                    xtnew(iso_eau,il),deltaD &
                    ((xtnew(iso_HDO,il)) &
                    /(xtnew(iso_eau,il)))
-                  write(*,*) 'xtp_cas(iso_eau),deltaD=', &
+                  WRITE(*,*) 'xtp_cas(iso_eau),deltaD=', &
                    xtp_cas(iso_eau,il),deltaD &
                    (xtp_cas(iso_HDO,il)/xtp_cas(iso_eau,il))
-                  write(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il)=', &
+                  WRITE(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il)=', &
                         Eqi_stewart(il),fac_ftmr_cas(il)
-                  write(*,*) 'Eqi_prime_cas(il)=', &
+                  WRITE(*,*) 'Eqi_prime_cas(il)=', &
                         Eqi_prime_cas(il)
-                  write(*,*) 'deltaD_Eqi_stewart=', &
+                  WRITE(*,*) 'deltaD_Eqi_stewart=', &
                         deltaD(( &
                         Exi_stewart(iso_HDO,il)/Eqi_stewart(il)))
-                  write(*,*) 'xtnew-xtp_avantevap_cas,deltaD=', &
+                  WRITE(*,*) 'xtnew-xtp_avantevap_cas,deltaD=', &
                       xtnew(iso_eau,il)-xtp_avantevap_cas(iso_eau,il), &
                       deltaD(((xtnew(iso_HDO,il) &
@@ -11494,58 +11380,57 @@
                       (xtnew(iso_eau,il) &
                       -xtp_avantevap_cas(iso_eau,il))))
-                  write(*,*) 'Pqisup,deltaD=', &
+                  WRITE(*,*) 'Pqisup,deltaD=', &
                         Pqisup_cas(il),deltaD(( &
                         Pxtisup_cas(iso_HDO,il)/Pqisup_cas(il)))
                   stop
                 endif
-        endif !if (iso_HDO.gt.0) then
-       endif !if (oktrac.eq.1) then
+        endif !if (iso_HDO.gt.0) 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
               if (iso_verif_egalite_choix_nostop(xtp_cas(iso_eau,il), &
               qp_cas(il),'appel stewart 688', &
-                errmax,errmaxrel*30).eq.1) then
-                  write(*,*) 'il=',il                   
-                  write(*,*) 'q,xtp_avantevap_cas(iso_eau)=', &
+                errmax,errmaxrel*30).eq.1) THEN
+                  WRITE(*,*) 'il=',il
+                  WRITE(*,*) 'q,xtp_avantevap_cas(iso_eau)=', &
                    qp_avantevap_cas(il), &
                    xtp_avantevap_cas(iso_eau,il)
-                  write(*,*) 'xtnew,qp,xtpcas=', &
+                  WRITE(*,*) 'xtnew,qp,xtpcas=', &
                    xtnew(iso_eau,il),qp_cas(il),xtp_cas(iso_eau,il)
-                  write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-                  write(*,*) 'Eqi_prime_cas(il)=', &
+                  WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+                  WRITE(*,*) 'Eqi_prime_cas(il)=', &
                         Eqi_prime_cas(il)
-                  write(*,*) 'Eqi_stewart, Exi_stewart=', &
+                  WRITE(*,*) 'Eqi_stewart, Exi_stewart=', &
                         Eqi_stewart(il), &
                         Exi_stewart(iso_eau,il)
-                  write(*,*) 'Pqisup=',Pqisup_cas(il)
+                  WRITE(*,*) 'Pqisup=',Pqisup_cas(il)
                  stop
               endif !if (iso_verif_egalite_choix_nostop(xtp_cas(iso_eau,il),
-           endif !if (iso_eau.gt.0) then
-
+           endif !if (iso_eau.gt.0) THEN
            if ((iso_HDO.gt.0).and. &
-                (qp_cas(il).gt.ridicule)) then
+                (qp_cas(il).gt.ridicule)) THEN
              if (iso_verif_aberrant_nostop(xtp_cas(iso_HDO,il)/ &
               qp_cas(il), &
-              'appel_stewart_np 1079').eq.1) then
-               write(*,*) 'i,qp(cas_evap_liq(il),i)=', &
+              'appel_stewart_np 1079').eq.1) THEN
+               WRITE(*,*) 'i,qp(cas_evap_liq(il),i)=', &
                         i,qp_cas(il)
-               write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-               write(*,*) 'deltaDxtnew=',deltaD(( &
+               WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+               WRITE(*,*) 'deltaDxtnew=',deltaD(( &
                 xtnew(iso_HDO,il))/qp_cas(il))
                stop
              endif
-           endif !if (iso_HDO.gt.0) then 
-        endif ! if (oktrac.eq.0) then
+           endif !if (iso_HDO.gt.0) THEN
+        endif ! if (oktrac.eq.0) THEN
 #endif              
 
-          else !if (fac_ftmr.gt.0.0) then
+          else !if (fac_ftmr.gt.0.0) THEN
               ! ca veut dire que Mp=0, xtp pas définit
              do ixt=1,niso
                xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
              enddo !do ixt=1,niso
-         endif !if (fac_ftmr.gt.0.0) then
-      else !if (i.lt.INB) then
+         endif !if (fac_ftmr.gt.0.0) THEN
+      else !if (i.lt.INB) THEN
           ! si i=inb, on ne change rien au calcul original, et on
           ! suppose que la composition du ddft est égale à celle de
@@ -11556,5 +11441,5 @@
                     !dans ce cas là
                   enddo
-      endif !if (i.lt.INB) then
+      endif !if (i.lt.INB) THEN
       enddo !do il=1,ncas
 
@@ -11571,16 +11456,16 @@
       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), &
                 ridicule_trac,deltalimtrac,'appel_stewart_np 2138')
           endif
-        endif !if (iso_HDO.gt.0) then
+        endif !if (iso_HDO.gt.0) THEN
 #endif
       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( &
@@ -11588,38 +11473,38 @@
                  qp_cas(il), &
                 'appel stewart 197', &
-                errmax,errmaxrel*50).eq.1) then
-          write(*,*) 'i=',i,' INB=',INB_cas(il)
-          write(*,*) 'Tevap=',T_cas(il)
-          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
-          write(*,*) 'qp(il,i)=',qp_cas(il)
-          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
-          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
-!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_liq(il),i)
-          write(*,*) 'xtp_avantevap(iso_eau)=', &
+                errmax,errmaxrel*50).eq.1) THEN
+          WRITE(*,*) 'i=',i,' INB=',INB_cas(il)
+          WRITE(*,*) 'Tevap=',T_cas(il)
+          WRITE(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
+          WRITE(*,*) 'qp(il,i)=',qp_cas(il)
+          WRITE(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
+          WRITE(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
+!          WRITE(*,*) 'Mp(il,i)=',Mp(cas_evap_liq(il),i)
+          WRITE(*,*) 'xtp_avantevap(iso_eau)=', &
                 xtp_avantevap_cas(iso_eau,il)
-          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
-!          write(*,*) 'Exi_prime(iso_eau)=',Exi_prime(iso_eau,il)
-!          write(*,*) 'Eqi_prime=',Eqi_prime(il)       
-          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+          WRITE(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
+!          WRITE(*,*) 'Exi_prime(iso_eau)=',Exi_prime(iso_eau,il)
+!          WRITE(*,*) 'Eqi_prime=',Eqi_prime(il)
+          WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                  Pxtiinf_stewart(iso_eau,il)
-!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_liq(il))
-          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
-          write(*,*) 'Pqisup=',Pqisup_cas(il)
+!          WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_liq(il))
+          WRITE(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
+          WRITE(*,*) 'Pqisup=',Pqisup_cas(il)
           stop
          endif !if iso_verif_egalite_choix_nostop
         enddo !do il=1,ncas
-      endif !if (iso_eau.gt.0) then
-      if (iso_HDO.gt.0) then            
+      endif !if (iso_eau.gt.0) THEN
+      if (iso_HDO.gt.0) THEN
        do il=1,ncas
-!        write(*,*) 'appel_stewart_np 2166: fin make_cas_evap_liq_np, ',
+!        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), &
                 'appel_stewart_np 1130')
-        endif !if (qp(cas_evap_liq(il),i).gt.ridicule) then
+        endif !if (qp(cas_evap_liq(il),i).gt.ridicule) THEN
        enddo !do il=1,ncas     
       endif 
-      endif ! if (oktrac.eq.0) then
+      endif ! if (oktrac.eq.0) THEN
 #endif
 
@@ -11688,6 +11573,6 @@
 
 #ifdef ISOVERIF  
-!      write(*,*) 'appel_stewart_np 2052: entrée dans make_cas_evap_glace'
-      if (iso_eau.gt.0) then
+!      WRITE(*,*) 'appel_stewart_np 2052: entrée dans make_cas_evap_glace'
+      if (iso_eau.gt.0) THEN
           do il=1,ncas
             CALL iso_verif_egalite_choix( &
@@ -11701,5 +11586,5 @@
              errmax,errmaxrel)
            enddo !do il=1,ncas 
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
 #endif    
      
@@ -11715,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), &
@@ -11722,12 +11607,12 @@
              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'
-!            write(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1) 
-!            write(*,*) 'Pqisup_cas(1)=',Pqisup_cas(1) 
-!            write(*,*) 'Eqi_cas(1)=',Eqi_cas(1) 
-!            write(*,*) 'Eqi_prime_cas(1)=',Eqi_prime_cas(1) 
-!            write(*,*) 'Eqi_stewart(1)=',Eqi_stewart(1)
+!            WRITE(*,*) 'appel_stewart_explicite_np 2269'
+!            WRITE(*,*) 'Pqiinf_stewart(1)=',Pqiinf_stewart(1)
+!            WRITE(*,*) 'Pqisup_cas(1)=',Pqisup_cas(1)
+!            WRITE(*,*) 'Eqi_cas(1)=',Eqi_cas(1)
+!            WRITE(*,*) 'Eqi_prime_cas(1)=',Eqi_prime_cas(1)
+!            WRITE(*,*) 'Eqi_stewart(1)=',Eqi_stewart(1)
 !#endif          
             CALL stewart_sublim_nofrac_vectall( &
@@ -11738,10 +11623,8 @@
               Pxtiinf_stewart(1,1),xtnew(1,1),Exi_stewart(1,1), &
               fac_ftmr_cas(1))
-      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
+      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
           do il=1,ncas       
              CALL iso_verif_egalite_choix( &
@@ -11754,18 +11637,18 @@
                 'appel_stewart_np 586', &
                errmax,errmaxrel)
-             if (Pqiinf_stewart(il).gt.ridicule) then
+             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
-                   write(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
-!                   write(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
-                   write(*,*) 'Pxtiinf_stewart(iso_eau,il)=', &
+                 .eq.1) THEN
+                   WRITE(*,*) 'Pqiinf_stewart(il)=',Pqiinf_stewart(il)
+!                   WRITE(*,*) 'Pqiinf_par(il)=',Pqiinf_par(il)
+                   WRITE(*,*) 'Pxtiinf_stewart(iso_eau,il)=', &
                         Pxtiinf_stewart(iso_eau,il)
                    stop
                 endif
-             endif !if (Pqiinf_par.gt.ridicule) then
+             endif !if (Pqiinf_par.gt.ridicule) THEN
            enddo !do il=1,ncas       
-        endif !if (iso_eau.gt.0) then
+        endif !if (iso_eau.gt.0) THEN
 #endif     
 
@@ -11774,15 +11657,15 @@
         ! 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) &
                    *Pxtiinf_stewart(ixt,il)/Pqiinf_stewart(il)
                enddo
-             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) then
+             else !if (Pxtiinf_stewart(iso_eau).gt.0.0) THEN
                  ! normalement, ce cas a déjà été interdit dans
                  ! compress_evp_glace
@@ -11791,9 +11674,9 @@
                 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
         
 #ifdef ISOVERIF
-!       write(*,*) 'appel_stewart_np 2563: dans make_cas_evap_glace'
+!       WRITE(*,*) 'appel_stewart_np 2563: dans make_cas_evap_glace'
        do il=1,ncas
         do ixt=1,niso
@@ -11801,24 +11684,24 @@
                 '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 (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
-               write(*,*) 'i=',i
-               write(*,*) 'Tevap=',T_cas(il)
-               write(*,*) 'xtwater(iso_eau,il,i)=', &
+                'appel stewart 155b',errmax*10,errmaxrel*10).eq.1) THEN
+               WRITE(*,*) 'i=',i
+               WRITE(*,*) 'Tevap=',T_cas(il)
+               WRITE(*,*) 'xtwater(iso_eau,il,i)=', &
                         xtwater_cas(iso_eau,il)
-               write(*,*) 'water(il,i)=',water_cas(il)
-               write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+               WRITE(*,*) 'water(il,i)=',water_cas(il)
+               WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                          Pxtiinf_stewart(iso_eau,il)
-!               write(*,*) 'Pqiinf_par,Pqiinf_stewart=',
+!               WRITE(*,*) 'Pqiinf_par,Pqiinf_stewart=',
 !     &                  Pqiinf_par(il),Pqiinf_stewart(il)
                stop
              endif  !if (iso_verif_egalite_nostop(
-         endif !if (water(il,i).gt.ridicule) then
-        endif !if (iso_eau.gt.0) then
+         endif !if (water(il,i).gt.ridicule) THEN
+        endif !if (iso_eau.gt.0) THEN
        enddo !do il=1,ncas
 #endif
@@ -11829,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) &
@@ -11835,5 +11718,5 @@
                 /100.0/delP_cas(il)/sigd(il)*g
          enddo ! do ixt=1,niso
-        else !if (Eqi_stewart.gt.0.0) then
+        else !if (Eqi_stewart.gt.0.0) THEN
             ! il peut quand même y a voir de la diffusion
             do ixt=1,niso
@@ -11841,5 +11724,5 @@
                 /100.0/delP_cas(il)/sigd(il)*g
             enddo !do ixt=1,niso    
-        endif !if (Eqi_stewart.gt.0.0) then
+        endif !if (Eqi_stewart.gt.0.0) THEN
        enddo !do il=1,ncas
       
@@ -11849,48 +11732,48 @@
           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_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
-                write(*,*) 'i,il=',i,il
-                write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
+              'appel stewart 142b',errmax,errmaxrel).eq.1) THEN
+                WRITE(*,*) 'i,il=',i,il
+                WRITE(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart(il)=', &
                         Exi_stewart(iso_eau,il),Eqi_stewart(il)
-                write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-                write(*,*) 'xtevapsup_cas(iso_eau,il)=', &
+                WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+                WRITE(*,*) 'xtevapsup_cas(iso_eau,il)=', &
                   xtevapsup_cas(iso_eau,il)
-!                write(*,*) 'evap,evapsup=',evap(cas_evap_glace(il),i),
+!                WRITE(*,*) 'evap,evapsup=',evap(cas_evap_glace(il),i),
 !     &            evap(cas_evap_glace(il),i+1)
               stop 
             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 (iso_eau.gt.0) THEN
+       endif ! if (oktrac.eq.0) THEN
       enddo !do il=1,ncas 
 #endif
 
-!      write(*,*) 'appel_stewart_np tmp 2243: Eqi_stewart(1)=',
+!      WRITE(*,*) 'appel_stewart_np tmp 2243: Eqi_stewart(1)=',
 !     :           Eqi_stewart(1)
-!      write(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(1)
+!      WRITE(*,*) 'Eqi_prime_cas=',Eqi_prime_cas(1)
       ! deduction de XTP partir de Exi
         ! temporaire:
 !        il=2
 !        ixt=iso_eau
-!        write(*,*) 'tmp 2619: Eqi_stewart(il)=',Eqi_stewart(il)
-!        write(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
-!        write(*,*) 'xtp_avantevaptrac_cas(ixt,il)=',
+!        WRITE(*,*) 'tmp 2619: Eqi_stewart(il)=',Eqi_stewart(il)
+!        WRITE(*,*) 'fac_ftmr_cas(il)=',fac_ftmr_cas(il)
+!        WRITE(*,*) 'xtp_avantevaptrac_cas(ixt,il)=',
 !     :                xtp_avantevaptrac_cas(ixt,il)
-!        write(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
-!        write(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
-!        write(*,*) 'tmp 2625: xtnew(ixt,il)=',xtnew(ixt,il)
+!        WRITE(*,*) 'Eqi_prime_cas(il)=',Eqi_prime_cas(il)
+!        WRITE(*,*) 'Exi_stewart(ixt,il)=',Exi_stewart(ixt,il)
+!        WRITE(*,*) 'tmp 2625: xtnew(ixt,il)=',xtnew(ixt,il)
 
       do il=1,ncas
-       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
-!               write(*,*) 'appel_stewart_v_np 2633 tmp: il=',il 
+       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
+!               WRITE(*,*) 'appel_stewart_v_np 2633 tmp: il=',il
                do ixt=1,niso     
                !   xtp(ixt,il,i)=xtnew(ixt)*qp(il,i)/xtnew(4)           
@@ -11901,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), &
@@ -11908,11 +11791,10 @@
 #endif
 
-             else ! if (Eqi_stewart.gt.ridicule) then
-                if (qp_cas(il).gt.0.0) then 
-
+             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)
-!     &                   then 
+!     &                   THEN
                         if ((Eqi_prime_cas(il)-Eqi_stewart(il)) &
-                       *fac_ftmr_cas(il).gt.ridicule) then
+                       *fac_ftmr_cas(il).gt.ridicule) THEN
                         ! il va manquer quelque chose: il faut augmenter
                         ! xtp en lui ajoutant l'évap du niveau d'eau
@@ -11921,6 +11803,6 @@
 
                         if (qp_avantevap_cas(il)+Eqi_stewart(il) &
-                         *fac_ftmr_cas(il).gt.ridicule) then
-                        !write(*,*) 'appel_stewart_np 2500: il=',il
+                         *fac_ftmr_cas(il).gt.ridicule) THEN
+                        !WRITE(*,*) 'appel_stewart_np 2500: il=',il
                         do ixt=1,niso               
                         xtnew(ixt,il)=xtnew(ixt,il) &
@@ -11932,5 +11814,5 @@
                         else
 #ifdef ISOVERIF
-                          write(*,*) 'appel_stewart_np 2672: on stoppe'
+                          WRITE(*,*) 'appel_stewart_np 2672: on stoppe'
                           stop
 #endif                            
@@ -11945,17 +11827,16 @@
                     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), &
                     'appel stewart 2643c',errmax,errmaxrel*30)
-                    endif !if (iso_eau.gt.0) then
+                    endif !if (iso_eau.gt.0) THEN
 #endif                       
-                else !if (qp(il,i).gt.0.0) then 
+                else !if (qp(il,i).gt.0.0) THEN
                   do ixt=1,niso               
                     xtp_cas(ixt,il)=0.0
                   enddo !do ixt=1,niso
-                endif  !if (qp(il,i).gt.0.0) then 
-             endif !if (Eqi_stewart.gt.ridicule) then 
-
+                endif  !if (qp(il,i).gt.0.0) THEN
+             endif !if (Eqi_stewart.gt.ridicule) THEN
 #ifdef ISOVERIF
              do ixt=1,niso
@@ -11965,38 +11846,38 @@
 #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
                   if (iso_verif_egalite_choix_nostop( &
                     xtp_cas(iso_eau,il),qp_cas(il), &
                     'appel stewart 688b',errmax,errmaxrel*30) &
-                    .eq.1) then
-                    write(*,*) 'il=',il
-                    write(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
+                    .eq.1) THEN
+                    WRITE(*,*) 'il=',il
+                    WRITE(*,*) 'xtp_avantevaptrac_cas(iso_eau,il)=', &
                         xtp_avantevaptrac_cas(iso_eau,il)
-                    write(*,*) 'qp_avantevap_cas(il)=', &
+                    WRITE(*,*) 'qp_avantevap_cas(il)=', &
                         qp_avantevap_cas(il)
-                    write(*,*) 'fac_ftmr_cas(il),Eqi_prime_cas(il)=', &
+                    WRITE(*,*) 'fac_ftmr_cas(il),Eqi_prime_cas(il)=', &
                         fac_ftmr_cas(il),Eqi_prime_cas(il)
-                    write(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart=', &
+                    WRITE(*,*) 'Exi_stewart(iso_eau,il),Eqi_stewart=', &
                         Exi_stewart(iso_eau,il),Eqi_stewart(il)
                     stop
                   endif
-               endif !if (iso_eau.gt.0) then 
+               endif !if (iso_eau.gt.0) THEN
               if ((iso_HDO.gt.0).and. &
-                (qp_cas(il).gt.ridicule)) then
+                (qp_cas(il).gt.ridicule)) THEN
                 CALL iso_verif_aberrant( &
                 xtp_cas(iso_HDO,il)/qp_cas(il), &
                 'appel_stewart_np 1384')
-              endif  ! if (iso_HDO.gt.0) then
-            endif ! if (oktrac.eq.0) then
+              endif  ! if (iso_HDO.gt.0) THEN
+            endif ! if (oktrac.eq.0) THEN
 #endif 
 
-          else !if (fac_ftmr.gt.0.0) then
+          else !if (fac_ftmr.gt.0.0) THEN
               ! ca veut dire que Mp=0, xtp pas définit
              do ixt=1,niso
                xtp_cas(ixt,il)=xtp_avantevaptrac_cas(ixt,il)
              enddo !do ixt=1,niso
-         endif !if (fac_ftmr.gt.0.0) then
-      else !if (i.lt.INB) then
+         endif !if (fac_ftmr.gt.0.0) THEN
+      else !if (i.lt.INB) THEN
           ! si i=inb, on ne change rien au calcul original, et on
           ! suppose que la composition du ddft est égale à celle de
@@ -12007,5 +11888,5 @@
                     !dans ce cas là
                   enddo
-      endif !if (i.lt.INB) then      
+      endif !if (i.lt.INB) THEN
       enddo !do il=1,ncas
 
@@ -12020,6 +11901,6 @@
 #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( &
@@ -12027,39 +11908,39 @@
                  qp_cas(il), &
                 'appel stewart 197b: cas_evap_glace', &
-                errmax,errmaxrel*50).eq.1) then
-          write(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
+                errmax,errmaxrel*50).eq.1) THEN
+          WRITE(*,*) 'i,il=',i,il,' INB(il)=',INB_cas(il)
 !     &          ,' cas(il)=',cas_evap_glace(il)
-          write(*,*) 'Tevap=',T_cas(il)
-          write(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
-          write(*,*) 'qp(il,i)=',qp_cas(il)
-          write(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
-          write(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
-!          write(*,*) 'Mp(il,i)=',Mp(cas_evap_glace(il),i)
-          write(*,*) 'xtp_avantevap(iso_eau)=', &
+          WRITE(*,*) 'Tevap=',T_cas(il)
+          WRITE(*,*) 'xtp(iso_eau,il,i)=',xtp_cas(iso_eau,il)
+          WRITE(*,*) 'qp(il,i)=',qp_cas(il)
+          WRITE(*,*) 'xtnew(iso_eau)=',xtnew(iso_eau,il)
+          WRITE(*,*) 'fac_ftmr=',fac_ftmr_cas(il)
+!          WRITE(*,*) 'Mp(il,i)=',Mp(cas_evap_glace(il),i)
+          WRITE(*,*) 'xtp_avantevap(iso_eau)=', &
                 xtp_avantevap_cas(iso_eau,il)
-          write(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
-          write(*,*) 'Exi_stewart(iso_eau)=',Exi_stewart(iso_eau,il)
-          write(*,*) 'Eqi_stewart=',Eqi_stewart(il)
-!          write(*,*) 'Eqi_prime=',Eqi_prime_cas(il)        
-          write(*,*) 'Pxtiinf_stewart(iso_eau)=', &
+          WRITE(*,*) 'qp_avantevap=',qp_avantevap_cas(il)
+          WRITE(*,*) 'Exi_stewart(iso_eau)=',Exi_stewart(iso_eau,il)
+          WRITE(*,*) 'Eqi_stewart=',Eqi_stewart(il)
+!          WRITE(*,*) 'Eqi_prime=',Eqi_prime_cas(il)
+          WRITE(*,*) 'Pxtiinf_stewart(iso_eau)=', &
                  Pxtiinf_stewart(iso_eau,il)
-!          write(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_glace(il))
-          write(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
-          write(*,*) 'Pqisup=',Pqisup_cas(il)
+!          WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas_evap_glace(il))
+          WRITE(*,*) 'Pxtisup(iso_eau)=',Pxtisup_cas(iso_eau,il)
+          WRITE(*,*) 'Pqisup=',Pqisup_cas(il)
           stop
          endif !if iso_verif_egalite_choix_nostop
          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), &
                 'appel_stewart_np 1449')
-            endif !if (qp_cas(il).gt.ridicule) then
+            endif !if (qp_cas(il).gt.ridicule) THEN
           enddo !do il=1,ncas
-        endif  ! if (iso_HDO.gt.0) then
-       endif ! if (oktrac.eq.0) then
-!       write(*,*) 'appel_stewart_np 2331: sortie de make_cas_evap_glace'
+        endif  ! if (iso_HDO.gt.0) THEN
+       endif ! if (oktrac.eq.0) THEN
+!       WRITE(*,*) 'appel_stewart_np 2331: sortie de make_cas_evap_glace'
 #endif
 
@@ -12105,35 +11986,34 @@
 
         ! traitement rapide du cas où cond=0
-        if (cond.eq.0) then
+        if (cond.eq.0) THEN
           do ixt=1,niso
             zxtliq(ixt)=0
             zxtice(ixt)=0
           enddo
-          return
+          RETURN
         endif
 
         ! 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
                 zxtice(ixt)=0
               enddo
-              return
-            else !if (cond.lt.ridicule) then
+              RETURN
+            else !if (cond.lt.ridicule) THEN
                 ! c'est impossible de condenser qi pas d'eau au départ
-                write(*,*) 'condiso_liq_ice_vectiso 35'
-                write(*,*) 'qt=',qt
-                write(*,*) 'cond=',cond
+                WRITE(*,*) 'condiso_liq_ice_vectiso 35'
+                WRITE(*,*) 'qt=',qt
+                WRITE(*,*) 'cond=',cond
                 stop
             endif
-        endif !if (cond.lt.ridicule) then
-
+        endif !if (cond.lt.ridicule) THEN
         ! 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')
@@ -12144,5 +12024,5 @@
 #endif
           zcond=max(0.0,min(cond,qt))
-          if (essai_convergence) then
+          if (essai_convergence) THEN
           else  
                 cond=min(cond,qt)
@@ -12161,22 +12041,22 @@
                 '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
+        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
-!                write(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
-!                write(*,*) 'tcond,fcond,zxtalphai=',
+                 'condiso_liq_ice_vectiso 64').eq.1) THEN
+!                WRITE(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
+!                WRITE(*,*) 'tcond,fcond,zxtalphai=',
 !     :                   tcond,cond/qt,zxtalphai
 !                stop
               endif !if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond,
-            endif !if (qt.gt.ridicule) then
-          endif !if (iso_HDO.gt.0) then
+            endif !if (qt.gt.ridicule) THEN
+          endif !if (iso_HDO.gt.0) THEN
 #endif
         
@@ -12185,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
@@ -12191,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
@@ -12203,56 +12083,54 @@
              zxtice(ixt)=xt(ixt)*(1.0-(1.0-(zcond/qt))**zxtalphai(ixt))
            enddo
-        endif !if (zcond/qt.lt.1e-5) then
-        
-
+        endif !if (zcond/qt.lt.1e-5) THEN
         ! verif
         ! 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 (zfice.lt.1) then
-          if (zfice.gt.0) then 
+                endif !if (cond.gt.ridicule) THEN
+            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+          endif !if (zfice.lt.1) 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
+            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
-                  write(*,*) 'xt(iso_HDO)/qt=',xt(iso_HDO)/qt
-                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
+                  /faccond,'condiso_liq_ice_vectiso 33').eq.1) THEN
+                  WRITE(*,*) 'debug condiso 88: zfice=',zfice
+                  WRITE(*,*) 'cond/qt=',cond/qt
+                  WRITE(*,*) 'xt(iso_HDO)/qt=',xt(iso_HDO)/qt
+                  WRITE(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
                                 deltaD(xt(iso_HDO)/qt)
-                  write(*,*) 'zxtalphai(iso_HDO)=',zxtalphai(iso_HDO)
-                  write(*,*) 'Rice/Rv0=',qt/cond* &
+                  WRITE(*,*) 'zxtalphai(iso_HDO)=',zxtalphai(iso_HDO)
+                  WRITE(*,*) 'Rice/Rv0=',qt/cond* &
                    (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
+                  WRITE(*,*) 'tcond=',tcond-t_coup,'°C'
+                  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
                      stop
-                  endif !if (tcond(i).gt.100.0) then
+                  endif !if (tcond(i).gt.100.0) THEN
                   endif
-                endif !if (cond.gt.ridicule) then 
-            endif !if (iso_HDO.gt.0) then
-          endif !if (zfice.gt.0) then       
+                endif !if (cond.gt.ridicule) THEN
+            endif !if (iso_HDO.gt.0) THEN
+          endif !if (zfice.gt.0) THEN
         ! verif que deltaD n'est pas abberant:
           
@@ -12273,18 +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))
@@ -12310,5 +12187,5 @@
 USE isotopes_verif_mod
 #ifdef ISOTRAC
-USE isotrac_mod, only: ridicule_trac
+USE isotrac_mod, ONLY: ridicule_trac
 #endif
 #endif
@@ -12353,6 +12230,6 @@
 #endif
 #ifdef ISOVERIF   
-!          write(*,*) 'condiso 253: entrée dans condiso'     
-          if (iso_eau.gt.0) then
+!          WRITE(*,*) 'condiso 253: entrée dans condiso'
+          if (iso_eau.gt.0) THEN
             do i=1,n
               CALL iso_verif_egalite_choix &
@@ -12360,8 +12237,8 @@
                '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
+!             if (qt(i).gt.ridicule) THEN
 #ifdef ISOTRAC            
               CALL iso_verif_aberrant_choix(xt(iso_hdo,i),qt(i), &
@@ -12377,5 +12254,5 @@
           
           do i=1,n
-!            write(*,*) 'condiso_liq_ice_vect 292: i,qt(i),cond(i)=',
+!            WRITE(*,*) 'condiso_liq_ice_vect 292: i,qt(i),cond(i)=',
 !     &          i,qt(i),cond(i)
 #ifdef VERIFNEGATIF
@@ -12389,11 +12266,11 @@
              (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
+             ((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'
-                write(*,*) 'i=',i
-                write(*,*) 'qt(i)=',qt(i)
-                write(*,*) 'cond(i)=',cond(i)
-                write(*,*) 'tcond=',tcond(i)
+                WRITE(*,*) 'condiso_liq_ice_vectall 315'
+                WRITE(*,*) 'i=',i
+                WRITE(*,*) 'qt(i)=',qt(i)
+                WRITE(*,*) 'cond(i)=',cond(i)
+                WRITE(*,*) 'tcond=',tcond(i)
                 stop
             endif
@@ -12404,5 +12281,5 @@
           enddo
           ! paragraphe enlevé le 29 avril 2012 car redondant.
-          !if (essai_convergence) then
+          !if (essai_convergence) THEN
           !else  
           !    do i=1,n
@@ -12423,24 +12300,24 @@
                 '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
+        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
-!                write(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
-!                write(*,*) 'tcond,fcond,zxtalphai=',
+                 'condiso_liq_ice_vectall 64').eq.1) THEN
+!                WRITE(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
+!                WRITE(*,*) 'tcond,fcond,zxtalphai=',
 !     :                   tcond,cond/qt,zxtalphai
 !                stop
               endif !if (iso_verif_aberrant_nostop(xt/qt*zxtalphai/faccond,
-            endif !if (qt.gt.ridicule) then
-          endif !if (iso_HDO.gt.0) then
+            endif !if (qt.gt.ridicule) THEN
+          endif !if (iso_HDO.gt.0) THEN
          enddo !do i=1,n  
-!         write(*,*) 'condiso 320: après calculs alpha' 
+!         WRITE(*,*) 'condiso 320: après calculs alpha'
 #endif
         
@@ -12450,5 +12327,5 @@
        ! on change les seuils
         if ((zcond(i).le.1e-15).or. &
-                ((qt(i).le.1e-15).and.(zcond(i).lt.ridicule))) then
+                ((qt(i).le.1e-15).and.(zcond(i).lt.ridicule))) THEN
           do ixt=1,niso
             zxtliq(ixt,i)=0.0
@@ -12463,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
@@ -12470,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
@@ -12478,5 +12355,5 @@
            enddo !do ixt=1,niso
 
-         else  !if (cond(i)/qt(i).lt.1e-5) then
+         else  !if (cond(i)/qt(i).lt.1e-5) THEN
            ! cas général
            do ixt=1,niso
@@ -12484,6 +12361,5 @@
                *(1.0-(1.0-zcond(i)/qt(i))**zxtalphai(ixt,i))
            enddo !do ixt=1,niso
-        endif !if (cond(i)/qt(i).lt.1e-5) then
-
+        endif !if (cond(i)/qt(i).lt.1e-5) THEN
         endif  !if ((cond(i).le.0.0).or.
        enddo !do i=1,n
@@ -12498,24 +12374,24 @@
                 'condiso_liq_ice_vectall 91').eq.1).or. &
                 (iso_verif_noNaN_nostop(zxtice(ixt,i), &
-                'condiso_liq_ice_vectall 92').eq.1)) then
-                 write(*,*) 'zxtalphal(ixt,i)=',zxtalphal(ixt,i)
-                 write(*,*) 'xt(ixt,i)=',xt(ixt,i)
-                 write(*,*) 'zcond(i)=',zcond(i)
-                 write(*,*) 'qt(i)=',qt(i)
+                'condiso_liq_ice_vectall 92').eq.1)) THEN
+                 WRITE(*,*) 'zxtalphal(ixt,i)=',zxtalphal(ixt,i)
+                 WRITE(*,*) 'xt(ixt,i)=',xt(ixt,i)
+                 WRITE(*,*) 'zcond(i)=',zcond(i)
+                 WRITE(*,*) 'qt(i)=',qt(i)
                  stop
               endif
             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( &
@@ -12527,72 +12403,70 @@
                      zxtliq(iso_HDO,i),cond(i), &
                      ridicule,deltalim_snow, &
-                     'condiso_liq_ice_vectall 32b').eq.1) then
-                    write(*,*) 'deltaDvap=',deltaD(xt(iso_hdo,i)/qt(i))
-                    write(*,*) 'T,alphal=', &
+                     'condiso_liq_ice_vectall 32b').eq.1) THEN
+                    WRITE(*,*) 'deltaDvap=',deltaD(xt(iso_hdo,i)/qt(i))
+                    WRITE(*,*) 'T,alphal=', &
                         tcond(i)-t_coup,zxtalphal(iso_hdo,i)
-                    write(*,*) 'qt(i)=',qt(i)
+                    WRITE(*,*) 'qt(i)=',qt(i)
                     stop
                   endif !if (iso_verif_aberrant_nostop(
                   
-                    if (iso_O18.gt.0) then
+                    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
-                        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)
-                        write(*,*) 'deltaD(xt(iso_HDO)/qt)=',deltaD(xt(iso_HDO,i)/qt(i))
-                        write(*,*) 'deltaD(zxtliq/cond)=',deltaD(zxtliq(iso_HDO,i)/cond(i))
-                        write(*,*) 'deltaO18(xt(iso_HDO)/qt)=',deltaO(xt(iso_O18,i)/qt(i))
-                        write(*,*) 'deltaO18(zxtliq/cond)=',deltaO(zxtliq(iso_O18,i)/cond(i))
-                        write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
+                    '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)
+                        WRITE(*,*) 'deltaD(xt(iso_HDO)/qt)=',deltaD(xt(iso_HDO,i)/qt(i))
+                        WRITE(*,*) 'deltaD(zxtliq/cond)=',deltaD(zxtliq(iso_HDO,i)/cond(i))
+                        WRITE(*,*) 'deltaO18(xt(iso_HDO)/qt)=',deltaO(xt(iso_O18,i)/qt(i))
+                        WRITE(*,*) 'deltaO18(zxtliq/cond)=',deltaO(zxtliq(iso_O18,i)/cond(i))
+                        WRITE(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
                         !stop ! Camille 9 mars 2023: trop strict
                     endif  !if (iso_verif_O18_aberrant_nostop(     
-                    endif ! if (iso_O18.gt.0) then      
+                    endif ! if (iso_O18.gt.0) THEN
 #endif                                     
 
-                endif !if (cond(i).gt.ridicule) 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 
+                endif !if (cond(i).gt.ridicule) 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
             do ixt=1,niso    
               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)
-                write(*,*) 'qt(i)=',qt(i)
-                write(*,*) 'zcond(i),zcond/qt=',zcond(i),zcond(i)/qt(i)
-                write(*,*) 'zxtalphai(ixt,i)=',zxtalphai(ixt,i)
+                'condiso_liq_ice_vectall 417').eq.1) THEN
+                WRITE(*,*) 'ixt,i=',ixt,i
+                WRITE(*,*) 'xt(ixt,i)=',xt(ixt,i)
+                WRITE(*,*) 'qt(i)=',qt(i)
+                WRITE(*,*) 'zcond(i),zcond/qt=',zcond(i),zcond(i)/qt(i)
+                WRITE(*,*) 'zxtalphai(ixt,i)=',zxtalphai(ixt,i)
                 stop
               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
+            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
-                  write(*,*) 'debug condiso_liq_ice_vect 13364: i,zfice=', &
+                    'condiso_liq_ice_vectall 414').eq.1) THEN
+                  WRITE(*,*) 'debug condiso_liq_ice_vect 13364: i,zfice=', &
                         i,zfice (i)
-                  write(*,*) 'cond,qt,cond/qt=',cond(i)/qt(i), &
+                  WRITE(*,*) 'cond,qt,cond/qt=',cond(i)/qt(i), &
                         cond(i),qt(i)
-                  write(*,*) 'xt(iso_HDO)/qt=', &
+                  WRITE(*,*) 'xt(iso_HDO)/qt=', &
                         xt(iso_HDO,i)/qt(i)
-                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
+                  WRITE(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
                     deltaD(xt(iso_HDO,i)/qt(i))
-                  write(*,*) 'zxtalphai(iso_HDO)=', &
+                  WRITE(*,*) 'zxtalphai(iso_HDO)=', &
                         zxtalphai(iso_HDO,i)
-                  write(*,*) 'Rice/Rv0=',qt(i)/cond(i)* &
+                  WRITE(*,*) 'Rice/Rv0=',qt(i)/cond(i)* &
                         (1.0-(1.0-cond(i)/qt(i))**zxtalphai(iso_HDO,i))
-                  write(*,*) 'deltaD(zxtice/cond)=', &
+                  WRITE(*,*) 'deltaD(zxtice/cond)=', &
                         deltaD(zxtice(iso_HDO,i)/cond(i))
-                  write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
-
-                  if (tcond(i)-t_coup.gt.-40.0) then 
+                  WRITE(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
+
+                  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. 
@@ -12606,30 +12480,29 @@
                     stop 
 #endif 
-                  endif !if (tcond(i)-t_coup.gt.-40.0) then
+                  endif !if (tcond(i)-t_coup.gt.-40.0) THEN
                   endif !if (iso_verif_aberrant_nostop
 
-                    if (iso_O18.gt.0) then
+                    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
-                        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)
-                        write(*,*) 'deltaD(xt(iso_HDO)/qt)=',deltaD(xt(iso_HDO,i)/qt(i))
-                        write(*,*) 'deltaD(zxtice/cond)=',deltaD(zxtice(iso_HDO,i)/cond(i))
-                        write(*,*) 'deltaO18(xt(iso_HDO)/qt)=',deltaO(xt(iso_O18,i)/qt(i))
-                        write(*,*) 'deltaO18(zxtice/cond)=',deltaO(zxtice(iso_O18,i)/cond(i))
-                        write(*,*) 'dexcess vap=',deltaD(xt(iso_HDO,i)/qt(i)) &
+                    '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)
+                        WRITE(*,*) 'deltaD(xt(iso_HDO)/qt)=',deltaD(xt(iso_HDO,i)/qt(i))
+                        WRITE(*,*) 'deltaD(zxtice/cond)=',deltaD(zxtice(iso_HDO,i)/cond(i))
+                        WRITE(*,*) 'deltaO18(xt(iso_HDO)/qt)=',deltaO(xt(iso_O18,i)/qt(i))
+                        WRITE(*,*) 'deltaO18(zxtice/cond)=',deltaO(zxtice(iso_O18,i)/cond(i))
+                        WRITE(*,*) 'dexcess vap=',deltaD(xt(iso_HDO,i)/qt(i)) &
 &                                -8*deltaO(xt(iso_O18,i)/qt(i))
-                        write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
-                        write(*,*) 'zxtalphai(iso_O18,i)=',zxtalphai(iso_O18,i)
-                        write(*,*) 'xt(1:niso,i)=',xt(1:niso,i)
+                        WRITE(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
+                        WRITE(*,*) 'zxtalphai(iso_O18,i)=',zxtalphai(iso_O18,i)
+                        WRITE(*,*) 'xt(1:niso,i)=',xt(1:niso,i)
                         !stop ! Camille 9 mars 2023: trop strict
                     endif  !if (iso_verif_O18_aberrant_nostop(     
-                    endif ! if (iso_O18.gt.0) then
-                endif !if (cond.gt.ridicule) then
-
+                    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
+                     (zfice(i).eq.1).and.(qt(i).gt.5e-4)) THEN
                    ! verif que la vapeur est très pauvre
                    do ixt=1,niso
@@ -12651,19 +12524,19 @@
 #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
-                        write(*,*) 'condiso 454: deltaDv trop fort'
-                        write(*,*) 'tcond(i)-t_coup=',tcond(i)-t_coup
-                        write(*,*) 'xt(:,i)=',xt(:,i)
-                        write(*,*) 'zxtice(:,i)=',zxtice(:,i)
-                        write(*,*) 'xtv(:,i)=',xtv(:,i)
-                        write(*,*) 'zxtalphai(:,i)=',zxtalphai(:,i)
-                        write(*,*) 'qt(i),zcond(i)=',qt(i),zcond(i)
+                   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
+                        WRITE(*,*) 'xt(:,i)=',xt(:,i)
+                        WRITE(*,*) 'zxtice(:,i)=',zxtice(:,i)
+                        WRITE(*,*) 'xtv(:,i)=',xtv(:,i)
+                        WRITE(*,*) 'zxtalphai(:,i)=',zxtalphai(:,i)
+                        WRITE(*,*) 'qt(i),zcond(i)=',qt(i),zcond(i)
                         stop
                    endif  !if (deltaD((xt(ixt,i)-zxtice(ixt,i))/
-                   endif !if (qv(i).gt.ridicule) then
-                endif !if (zcond(i)/qt(i).gt.0.95) then
-            endif !if (iso_HDO.gt.0) then
-          endif !if (zfice.gt.0) then             
+                   endif !if (qv(i).gt.ridicule) THEN
+                endif !if (zcond(i)/qt(i).gt.0.95) THEN
+            endif !if (iso_HDO.gt.0) THEN
+          endif !if (zfice.gt.0) THEN
           enddo ! do i=1,n    
         
@@ -12672,25 +12545,25 @@
 #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 (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
-                write(*,*) 'debug condiso_liq_ice_vect 449: i,zfice=', &
+                'condiso_liq_ice_vect 412').eq.1) THEN
+                WRITE(*,*) 'debug condiso_liq_ice_vect 449: i,zfice=', &
                         i,zfice (i)
-                  write(*,*) 'cond/qt=',cond(i)/qt(i)
-                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
+                  WRITE(*,*) 'cond/qt=',cond(i)/qt(i)
+                  WRITE(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
                     deltaD(xt(iso_HDO,i)/qt(i))
-                  write(*,*) 'zxtalphai(iso_HDO)=', &
+                  WRITE(*,*) 'zxtalphai(iso_HDO)=', &
                         zxtalphai(iso_HDO,i)
-                  write(*,*) 'Rice/Rv0=',qt(i)/cond(i)* &
+                  WRITE(*,*) 'Rice/Rv0=',qt(i)/cond(i)* &
                         (1.0-(1.0-cond(i)/qt(i))**zxtalphai(iso_HDO,i))
-                  write(*,*) 'deltaD(zxtice/cond)=', &
+                  WRITE(*,*) 'deltaD(zxtice/cond)=', &
                         deltaD(zxtice(iso_HDO,i)/cond(i))
-                  write(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
-                  if (tcond(i)-t_coup.gt.-40.0) then 
+                  WRITE(*,*) 'tcond(i)=',tcond(i)-t_coup,'°C'
+                  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. 
@@ -12708,5 +12581,5 @@
           endif
          enddo
-        endif !if (iso_HDO.gt.0) then 
+        endif !if (iso_HDO.gt.0) THEN
 #endif 
         ! end verif
@@ -12728,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) &
@@ -12734,17 +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
-!          write(*,*) 'condiso 477: fin de condiso' 
-#endif
-
-      if ((bidouille_anti_divergence).and.(iso_eau.gt.0)) 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
             ! 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        
@@ -12789,21 +12661,21 @@
 
         ! traitement rapide du cas où cond=0
-        if (cond.eq.0) then
+        if (cond.eq.0) THEN
             zxtliq=0
             zxtice=0
-            return
+            RETURN
         endif
 
         ! 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
-                return
+                RETURN
             else
                 ! c'est impossible de condenser qi pas d'eau au départ
-                write(*,*) 'condiso_liq_ice 35'
-                write(*,*) 'qt=',qt
-                write(*,*) 'cond=',cond
+                WRITE(*,*) 'condiso_liq_ice 35'
+                WRITE(*,*) 'qt=',qt
+                WRITE(*,*) 'cond=',cond
                 stop
             endif
@@ -12812,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
@@ -12826,31 +12698,31 @@
             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
+            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=',
+                'condiso_liq_ice 64').eq.1) THEN
+!                WRITE(*,*) 'deltaDt=',(xt/qt/tnat(iso_HDO)-1)*1000
+!                WRITE(*,*) 'tcond,fcond,zxtalphai=',
 !     :                   tcond,cond/qt,zxtalphai
 !                stop
               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 (qt.gt.ridicule) 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
@@ -12866,37 +12738,37 @@
         ! 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 (zfice.lt.1) then
-          if (zfice.gt.0) then  
+                endif !if (cond.gt.ridicule) THEN
+            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+          endif !if (zfice.lt.1) 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
+            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
-                  write(*,*) 'xt/qt=',xt/qt
-                  write(*,*) 'zxtalphai=',zxtalphai
-                  write(*,*) 'qt/cond*(1-(1-cond/qt)**zxtalphai)=', &
+                       'condiso_liq_ice 33').eq.1) THEN
+                  WRITE(*,*) 'debug condiso 88: zfice=',zfice
+                  WRITE(*,*) 'cond/qt=',cond/qt
+                  WRITE(*,*) 'xt/qt=',xt/qt
+                  WRITE(*,*) 'zxtalphai=',zxtalphai
+                  WRITE(*,*) 'qt/cond*(1-(1-cond/qt)**zxtalphai)=', &
                         (qt/cond)*1-(1-cond/qt)**zxtalphai
-                  write(*,*) 'zxtice/cond=',zxtice/cond 
+                  WRITE(*,*) 'zxtice/cond=',zxtice/cond
                   stop
                   endif
-                endif !if (cond.gt.ridicule) then 
-            endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
-          endif !if (zfice.gt.0) then       
+                endif !if (cond.gt.ridicule) 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:
           
@@ -12911,20 +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)
@@ -13034,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( &
@@ -13050,7 +12921,7 @@
 #ifdef ISOVERIF
          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)
+               '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)
             stop
          endif
@@ -13063,22 +12934,22 @@
 #ifdef ISOVERIF  
       do i=1,knon         
-        if (iso_eau.gt.0) then  
+        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
-              write(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
+                     errmax,errmaxrel).eq.1) THEN
+              WRITE(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
                  snow_prec(i),xtsnow_prec(iso_eau,i)
-              write(*,*) 'precip_snow(i),xtprecip_snow(iso_eau,i)=', &
+              WRITE(*,*) 'precip_snow(i),xtprecip_snow(iso_eau,i)=', &
                  precip_snow(i),xtprecip_snow(iso_eau,i)
               stop
             endif
-        endif !if (iso_eau.gt.0) then
-        if (iso_HDO.gt.0) then                   
+        endif !if (iso_eau.gt.0) THEN
+        if (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant_choix( &
                    xtsnow_apres_precip(iso_hdo,i), &
                    snow_apres_precip(i),ridicule_snow,deltalim_snow, &
                    'calcul_iso_surf_ter 1931')
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
        enddo
 #endif
@@ -13088,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, &
@@ -13096,27 +12967,27 @@
                  -xtsnow_evap(ixt,i)*dtime
             enddo !do ixt=1,niso
-          endif !if (snow_evap(i).lt.0.0) then
+          endif !if (snow_evap(i).lt.0.0) THEN
         enddo !do i=1,knon
              
 #ifdef ISOVERIF  
       do i=1,knon         
-        if (iso_eau.gt.0) then  
+        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
-              write(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
+                     errmax,errmaxrel).eq.1) THEN
+              WRITE(*,*) 'snow_prec(i),xtsnow_prec(iso_eau,i)=', &
                  snow_prec(i),xtsnow_prec(iso_eau,i)
-              write(*,*) 'precip_snow(i),xtprecip_snow(iso_eau,i)=', &
+              WRITE(*,*) 'precip_snow(i),xtprecip_snow(iso_eau,i)=', &
                  precip_snow(i),xtprecip_snow(iso_eau,i)
               stop
             endif
-        endif !if (iso_eau.gt.0) then
-        if (iso_HDO.gt.0) then                   
+        endif !if (iso_eau.gt.0) THEN
+        if (iso_HDO.gt.0) THEN
              CALL iso_verif_aberrant_choix( &
                    xtsnow_apres_precip(iso_hdo,i), &
                    snow_apres_precip(i),ridicule_snow,deltalim_snow, &
                    'calcul_iso_surf_ter 1931')
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
        enddo
 #endif
@@ -13124,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)/ &
@@ -13136,29 +13007,29 @@
                  '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
-                write(*,*) 'ixt,i=',ixt,i
-                write(*,*) 'xtsnow_apres_precip,snow_apres_precip=', &
+                 'calcul_iso_surf_ter 2294b').eq.1)) THEN
+                WRITE(*,*) 'ixt,i=',ixt,i
+                WRITE(*,*) 'xtsnow_apres_precip,snow_apres_precip=', &
                          xtsnow_apres_precip(ixt,i), &
                          snow_apres_precip(i)
-                write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+                WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
                 stop
               endif
 #endif
             enddo !do ixt=1,niso
-          else !if (snow_apres_precip(i).gt.0) then
+          else !if (snow_apres_precip(i).gt.0) THEN
                 ! fonte de quoi? pas de neige!!
-              write(*,*) 'calcul_iso_surf_ter 588: fq_fonte_neige(i)=', &
+              WRITE(*,*) 'calcul_iso_surf_ter 588: fq_fonte_neige(i)=', &
                  fq_fonte_neige(i)
-              write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
-              write(*,*) 'i=',i
-              write(*,*) 'snow_prec(i)=',snow_prec(i)
-              write(*,*) 'precip_snow(i)*dtime=',precip_snow(i)*dtime
+              WRITE(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
+              WRITE(*,*) 'i=',i
+              WRITE(*,*) 'snow_prec(i)=',snow_prec(i)
+              WRITE(*,*) 'precip_snow(i)*dtime=',precip_snow(i)*dtime
               stop
-          endif !if (snow_apres_precip(i).gt.0) then
-        else !endif !if (fq_fonte_neige(i).gt.0.0) then
+          endif !if (snow_apres_precip(i).gt.0) THEN
+        else !endif !if (fq_fonte_neige(i).gt.0.0) THEN
            do ixt=1,niso
               fxt_fonte_neige(ixt,i)=0.0
            enddo !do ixt=1,niso          
-        endif !if (fq_fonte_neige(i).gt.0.0) then
+        endif !if (fq_fonte_neige(i).gt.0.0) THEN
       enddo !do i=1,knon   
 #ifdef ISOVERIF
@@ -13180,8 +13051,8 @@
 #ifdef ISOVERIF
           if (iso_verif_noNaN_nostop(xtsnow_avant_evap(ixt,i), &
-                'calcul_iso_surf_ter 2363').eq.1) then
-                  write(*,*) 'xtsnow_apres_precip(ixt,i)=', &
+                'calcul_iso_surf_ter 2363').eq.1) THEN
+                  WRITE(*,*) 'xtsnow_apres_precip(ixt,i)=', &
                         xtsnow_apres_precip(ixt,i)
-                  write(*,*) 'fxt_fonte_neige(ixt,i)=', &
+                  WRITE(*,*) 'fxt_fonte_neige(ixt,i)=', &
                         fxt_fonte_neige(ixt,i)
                   stop
@@ -13200,26 +13071,26 @@
                  -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
-             write(*,*) 'snow(i)=',snow(i)
-             write(*,*) 'snow_prec(i)=',snow_prec(i)
-             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
-             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
-             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
-             write(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
-             write(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
-             write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
+                  errmaxrel).eq.1) THEN
+             WRITE(*,*) 'snow(i)=',snow(i)
+             WRITE(*,*) 'snow_prec(i)=',snow_prec(i)
+             WRITE(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
+             WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+             WRITE(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
+             WRITE(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
+             WRITE(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
+             WRITE(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
              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), &
                      snow_avant_evap(i),'calcul_iso_surf_ter 1082', &
                      errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
-           if (iso_HDO.gt.0) then                   
+          endif !if (iso_eau.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, &
                         'calcul_iso_surf_ter 1991')
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
        enddo !do i=1,knon  
 #endif            
@@ -13230,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
@@ -13249,12 +13120,12 @@
 !     &          'calcul_iso_surf_ter 2543')
                if (iso_verif_noNaN_nostop(xtsnow_evap(ixt,i), &
-                'calcul_iso_surf_ter 2543').eq.1) then
-                  write(*,*) 'xtsnow_avant_evap(ixt,i)=', &
+                'calcul_iso_surf_ter 2543').eq.1) THEN
+                  WRITE(*,*) 'xtsnow_avant_evap(ixt,i)=', &
                         xtsnow_avant_evap(ixt,i)
-                  write(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
-                  write(*,*) 'Rsnow_avant_evap(ixt,i)=', &
+                  WRITE(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
+                  WRITE(*,*) 'Rsnow_avant_evap(ixt,i)=', &
                         Rsnow_avant_evap(ixt,i)
-                  write(*,*) 'snow_evap(i)=',snow_evap(i)
-                  write(*,*) 'ixt,i=',ixt,i
+                  WRITE(*,*) 'snow_evap(i)=',snow_evap(i)
+                  WRITE(*,*) 'ixt,i=',ixt,i
                   stop
                endif !if (iso_verif_noNaN_nostop(xtsnow_evap(ixt,i),
@@ -13262,16 +13133,16 @@
 #endif
              
-            else !if (snow_avant_evap(i).gt.0.0) then  
+            else !if (snow_avant_evap(i).gt.0.0) THEN
 #ifdef ISOVERIF                
-                write(*,*) 'iso_surf_lic 952: quoi evaporer?'
-                write(*,*) 'snow_evap(i),snow_avant_evap(i)=', &
+                WRITE(*,*) 'iso_surf_lic 952: quoi evaporer?'
+                WRITE(*,*) 'snow_evap(i),snow_avant_evap(i)=', &
                          snow_evap(i),snow_avant_evap(i)
-                write(*,*) 'snow(i)=',snow(i)
-                write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
-                write(*,*) 'Rsnow_apres_precip(:,i)=',Rsnow_apres_precip(:,i)
-                write(*,*) 'i=',i
+                WRITE(*,*) 'snow(i)=',snow(i)
+                WRITE(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
+                WRITE(*,*) 'Rsnow_apres_precip(:,i)=',Rsnow_apres_precip(:,i)
+                WRITE(*,*) 'i=',i
 !                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
@@ -13284,9 +13155,9 @@
 #endif              
                   enddo
-                else  !if (snow_apres_precip(i).gt.0.0) then
+                else  !if (snow_apres_precip(i).gt.0.0) THEN
 #ifdef ISOVERIF                
-                  write(*,*) 'iso_surf_lic 967: quoi evaporer? '// &
+                  WRITE(*,*) 'iso_surf_lic 967: quoi evaporer? '// &
                          'sans espoir'
-                  write(*,*) 'snow_apres_precip(i)=', &
+                  WRITE(*,*) 'snow_apres_precip(i)=', &
                          snow_apres_precip(i)
                   stop                
@@ -13304,12 +13175,9 @@
 #endif              
                     enddo
-                endif !if (snow_apres_precip(i).gt.0.0) then
-              
-                
-            endif !if (snow_avant_evap(i).gt.0.0) then  
-
+                endif !if (snow_apres_precip(i).gt.0.0) THEN
+            endif !if (snow_avant_evap(i).gt.0.0) THEN
         ! 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, &
@@ -13320,5 +13188,5 @@
               xtsnow(ixt,i)=xtsnow_avant_evap(ixt,i)  
             enddo
-        else ! if (snow_evap(i).lt.-ridicule**2) then
+        else ! if (snow_evap(i).lt.-ridicule**2) THEN
             ! évaporation nulle 
             do ixt=1,ntraciso
@@ -13328,9 +13196,8 @@
               xtsnow(ixt,i)=xtsnow_avant_evap(ixt,i)            
             enddo
-        endif !if (snow_evap(i).gt.0.0) then
-
+        endif !if (snow_evap(i).gt.0.0) THEN
 #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
@@ -13355,17 +13222,17 @@
                  -fqcalving(i)*dtime,snow(i), &
                  'gestion_neige 1087',errmax_sol*max(snow(i),1.0), &
-                 errmaxrel).eq.1) then
-             write(*,*) 'snow(i)=',snow(i)
-             write(*,*) 'snow_prec(i)=',snow_prec(i)
-             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
-             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
-             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
-             write(*,*) 'fqcalving(i)*dt=',fqcalving(i)*dtime
-             write(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
-             write(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
-             write(*,*) 'snow_avant_calving(i)=',snow_avant_calving(i)
+                 errmaxrel).eq.1) THEN
+             WRITE(*,*) 'snow(i)=',snow(i)
+             WRITE(*,*) 'snow_prec(i)=',snow_prec(i)
+             WRITE(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
+             WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+             WRITE(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
+             WRITE(*,*) 'fqcalving(i)*dt=',fqcalving(i)*dtime
+             WRITE(*,*) 'snow_avant_evap(i)=',snow_avant_evap(i)
+             WRITE(*,*) 'snow_apres_precip(i)=',snow_apres_precip(i)
+             WRITE(*,*) 'snow_avant_calving(i)=',snow_avant_calving(i)
              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', &
@@ -13374,10 +13241,10 @@
                      snow_evap(i),'gestion_neige 1198', &
                      errmax,errmaxrel)
-          endif !if (iso_eau.gt.0) then
-          if (iso_HDO.gt.0) then                   
+          endif !if (iso_eau.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, &
                  'gestion_neige 2090')
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
 !          CALL iso_verif_traceur(xtsnow_evap(1,i), &
@@ -13390,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), &
@@ -13406,6 +13273,5 @@
               fxtcalving(ixt,i)=0.0
             enddo
-        endif !if (fqcalving(i).gt.0.0) then
-
+        endif !if (fqcalving(i).gt.0.0) THEN
       enddo ! do i=1,knon
 
@@ -13413,10 +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      
@@ -13427,15 +13292,15 @@
          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
-             write(*,*) 'calcul_iso_surf_ter 2086: bilan qsnow'
-             write(*,*) 'snow(i)=',snow(i)
-             write(*,*) 'snow_prec(i)=',snow_prec(i)
-             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
-             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
-             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
-             write(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
+                 errmax_sol*max(snow(i),1.0),errmaxrel).eq.1) THEN
+             WRITE(*,*) 'calcul_iso_surf_ter 2086: bilan qsnow'
+             WRITE(*,*) 'snow(i)=',snow(i)
+             WRITE(*,*) 'snow_prec(i)=',snow_prec(i)
+             WRITE(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
+             WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+             WRITE(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
+             WRITE(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
              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) &
@@ -13443,25 +13308,25 @@
             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
-             write(*,*) 'calcul_iso_surf_ter 2101: bilan xtsnow, ixt=', &
+                 errmax_sol*max(snow(i),1.0),errmaxrel).eq.1) THEN
+             WRITE(*,*) 'calcul_iso_surf_ter 2101: bilan xtsnow, ixt=', &
                  ixt
-             write(*,*) 'i=',i
-             write(*,*) 'snow(i)=',snow(i)
-             write(*,*) 'snow_prec(i)=',snow_prec(i)
-             write(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
-             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
-             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
-             write(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
-             write(*,*) 'xtsnow(ixt,i)=',xtsnow(ixt,i)
-             write(*,*) 'xtsnow_prec(i)=',xtsnow_prec(ixt,i)
-             write(*,*) 'xtprecip_snow(i)*dt=',xtprecip_snow(ixt,i) &
+             WRITE(*,*) 'i=',i
+             WRITE(*,*) 'snow(i)=',snow(i)
+             WRITE(*,*) 'snow_prec(i)=',snow_prec(i)
+             WRITE(*,*) 'precip_snow(i)*dt=',precip_snow(i)*dtime
+             WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+             WRITE(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
+             WRITE(*,*) 'fqcalving(i)=',fqcalving(i)*dtime
+             WRITE(*,*) 'xtsnow(ixt,i)=',xtsnow(ixt,i)
+             WRITE(*,*) 'xtsnow_prec(i)=',xtsnow_prec(ixt,i)
+             WRITE(*,*) 'xtprecip_snow(i)*dt=',xtprecip_snow(ixt,i) &
                          *dtime
-             write(*,*) 'fxt_fonte_neige(i)=',fxt_fonte_neige(ixt,i)
-             write(*,*) 'xtsnow_evap(i)*dt=',xtsnow_evap(ixt,i)*dtime
-             write(*,*) 'fxtcalving(i)=',fxtcalving(ixt,i)
+             WRITE(*,*) 'fxt_fonte_neige(i)=',fxt_fonte_neige(ixt,i)
+             WRITE(*,*) 'xtsnow_evap(i)*dt=',xtsnow_evap(ixt,i)*dtime
+             WRITE(*,*) 'fxtcalving(i)=',fxtcalving(ixt,i)
              stop
            endif    
            enddo ! do ixt=1,niso
-         endif ! if (snow(i).lt.snow_max) then
+         endif ! if (snow(i).lt.snow_max) THEN
       enddo !do i=1,knon      
 #endif
@@ -13473,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 &
@@ -13488,7 +13353,7 @@
                 else     
 #ifdef ISOVERIF
-                   write(*,*) 'iso_routines > gestion_neige 13480: nisurf=',nisurf
-                   write(*,*) 'i,dtime=',i,dtime
-                   write(*,*) 'fqfonte_neige(i),fq_fonte_neige(i)=',fqfonte_neige(i),fq_fonte_neige(i)
+                   WRITE(*,*) 'iso_routines > gestion_neige 13480: nisurf=',nisurf
+                   WRITE(*,*) 'i,dtime=',i,dtime
+                   WRITE(*,*) 'fqfonte_neige(i),fq_fonte_neige(i)=',fqfonte_neige(i),fq_fonte_neige(i)
                    stop
 #endif             
@@ -13498,5 +13363,5 @@
                   enddo
                 endif
-           else !if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) then
+           else !if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_egalite(fqfonte_neige(i),fq_fonte_neige(i)/dtime, &
@@ -13506,7 +13371,7 @@
                   fxtfonte_neige(ixt,i)=fxt_fonte_neige(ixt,i)/dtime
                 enddo
-           endif !if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) then
-#ifdef ISOVERIF
-           if (iso_eau.gt.0) then
+           endif !if (fqfonte_neige(i).gt.fq_fonte_neige(i)/dtime) THEN
+#ifdef ISOVERIF
+           if (iso_eau.gt.0) THEN
                 CALL iso_verif_egalite(fqfonte_neige(i),fxtfonte_neige(iso_eau,i), &
                         'iso_routines > gestion_neige 13479')
@@ -13589,8 +13454,8 @@
 
         ! vérif préliminaire
-        !write(*,*) 'calcul_iso_surf_oce 41'
+        !WRITE(*,*) 'calcul_iso_surf_oce 41'
 #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)
@@ -13598,10 +13463,9 @@
                         q1lay(i),'calcul_iso_surf_oce 69', &
                         errmax,errmaxrel)
-           endif !if (iso_eau.gt.0) then
-           if (iso_HDO.gt.0) then 
+           endif !if (iso_eau.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')
-            endif !if (iso_eau.gt.0) then      
-
+            endif !if (iso_eau.gt.0) THEN
             CALL iso_verif_noNaN(tsurf(i),'calcul_iso_surf_ice 62')
          enddo  
@@ -13613,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 
@@ -13619,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
@@ -13634,10 +13498,10 @@
          enddo !do i=1,knon
 
-        !write(*,*) 'calcul_iso_surf_oce 13703'
+        !WRITE(*,*) 'calcul_iso_surf_oce 13703'
          ! traitement vectoriel du cas d'évaporation
          do icas=1,ncas_evap
             i=cas_evap(icas)
-            !write(*,*) 'icas, i, ncas_evap=',icas, i, ncas_evap
-            if (tsurf(i).lt.t_coup) then
+            !WRITE(*,*) 'icas, i, ncas_evap=',icas, i, ncas_evap
+            if (tsurf(i).lt.t_coup) THEN
              zqs(i)=qsats(tsurf(i))/ps(i)
 #ifdef ISOVERIF             
@@ -13654,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
@@ -13662,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)
@@ -13674,5 +13538,5 @@
             else
 #ifdef ISOVERIF
-                write(*,*) 'calcul_iso_surf 124: q1lay=',q1lay(i)
+                WRITE(*,*) 'calcul_iso_surf 124: q1lay=',q1lay(i)
                 stop
 #endif
@@ -13683,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)* &
@@ -13690,10 +13554,10 @@
                  /(1.0-h1(i))*(1.0-kcin(ixt,i))
                enddo !do ixt=1,niso
-            else !if (h1(i).lt.0.98) then
+            else !if (h1(i).lt.0.98) THEN
               do ixt=1,niso
                 xtevap(ixt,i)=evap(i)*Roce(ixt,i)/zxtalphal(ixt,i)
               enddo
-            endif !if (h1(i).lt.0.98) then
-          else !if (cste_surf_cond.eq.0) then
+            endif !if (h1(i).lt.0.98) THEN
+          else !if (cste_surf_cond.eq.0) THEN
               do ixt=1,niso
                 xtevap(ixt,i)=evap(i)* &
@@ -13702,11 +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
-
-        !write(*,*) 'calcul_iso_surf_oce 13772'
-        !write(*,*) 'knindex(i),klon=',knindex(i),klon
+          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
+                 (option_traceurs.eq.20)) THEN
              izone_recoit=bassin_map(knindex(i))
          else
@@ -13714,7 +13577,7 @@
           endif     
 
-        !write(*,*) 'calcul_iso_surf_oce 13781, izone_recoit=',izone_recoit
+        !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
@@ -13723,5 +13586,5 @@
           enddo   !do ixt=niso+1,ntraciso        
 #endif      
-        !write(*,*) 'calcul_iso_surf_oce 13786'    
+        !WRITE(*,*) 'calcul_iso_surf_oce 13786'
 
 #ifdef ISOVERIF
@@ -13732,60 +13595,60 @@
 #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
+          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
-               write(*,*) 'h1(i),kcin(iso_HDO,i)=',h1(i),kcin(iso_HDO,i)
-               write(*,*) 'deltaD(R1)=',deltaD(R1(iso_HDO))
-               write(*,*) 'deltaD(Roce/alpha)=', &
+                 '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))
+               WRITE(*,*) 'deltaD(Roce/alpha)=', &
                      deltaD(Roce(iso_HDO,i)/zxtalphal(iso_HDO,i))
                ! 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. &
-                         (deltaD(R1(iso_HDO)).gt.deltaDfaible)) then
+                         (deltaD(R1(iso_HDO)).gt.deltaDfaible)) THEN
                  stop
                endif
              endif
-           endif !if (abs(evap(i)).gt.ridicule_evap) then
+           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
-               write(*,*) 'calcul_iso_surf_oce 106, i=',i
-               write(*,*) 'deltaDevap=', &
+                 .and.(evap(i).gt.ridicule_evap)) THEN
+               WRITE(*,*) 'calcul_iso_surf_oce 106, i=',i
+               WRITE(*,*) 'deltaDevap=', &
                  deltaD(xtevap(iso_HDO,i)/evap(i))
-               write(*,*) 'deltaDv1=',deltaD(R1(iso_HDO))
-               write(*,*) 'tsurf, kcin(iso_HDO,i)=',tsurf(i)-273.5,  &
+               WRITE(*,*) 'deltaDv1=',deltaD(R1(iso_HDO))
+               WRITE(*,*) 'tsurf, kcin(iso_HDO,i)=',tsurf(i)-273.5,  &
                          kcin(iso_HDO,i)
-               write(*,*) 'deltaD(Roce/alpha)=', &
+               WRITE(*,*) 'deltaD(Roce/alpha)=', &
                          deltaD(Roce(iso_HDO,i)/zxtalphal(iso_HDO,i))
-               write(*,*) 'h1(i),evap(i)=',h1(i),evap(i)
+               WRITE(*,*) 'h1(i),evap(i)=',h1(i),evap(i)
                stop
-           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
+           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) &
                  /evap(i),xtevap(iso_O18,i) &
-                 /evap(i),'calcul_iso_surf > oce 232').eq.1) then
-                  write(*,*) 'deltaO18,O17excess v1=',deltaO( &
+                 /evap(i),'calcul_iso_surf > oce 232').eq.1) THEN
+                  WRITE(*,*) 'deltaO18,O17excess v1=',deltaO( &
                          R1(iso_O18)),O17excess( &
                          R1(iso_O17),R1(iso_O18))
-                  write(*,*) 'tsurf, kcin(iso_O17,i)=', &
+                  WRITE(*,*) 'tsurf, kcin(iso_O17,i)=', &
                          tsurf(i)-273.5, kcin(iso_O17,i)
-                  write(*,*) 'deltaO18,O17excess(Roce/alpha)=', &
+                  WRITE(*,*) 'deltaO18,O17excess(Roce/alpha)=', &
                          deltaO(Roce(iso_O18,i)/zxtalphal(iso_O18,i)), &
                          O17excess(Roce(iso_O17,i)/zxtalphal(iso_O17,i), &
                                  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
+                  WRITE(*,*) 'h1(i),evap(i)=',h1(i),evap(i)
+                  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 (abs(evap(i)).gt.ridicule_evap) THEN
+          endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur_justmass(xtevap(1,i), &
@@ -13793,9 +13656,9 @@
 #endif          
 #endif
-        !write(*,*) 'calcul_iso_surf_oce 13858'
+        !WRITE(*,*) 'calcul_iso_surf_oce 13858'
 
          enddo !do icas_evap=1,ncas_evap
 
-        !write(*,*) 'calcul_iso_surf_oce 13859'
+        !WRITE(*,*) 'calcul_iso_surf_oce 13859'
         ! traitement vectoriel du cas pas d'évap
         do icas=1,ncas_noevap
@@ -13806,5 +13669,5 @@
         enddo !do icas_evap=1,ncas_evap
 
-        !write(*,*) 'calcul_iso_surf_oce 13868'
+        !WRITE(*,*) 'calcul_iso_surf_oce 13868'
         ! traitement vectoriel du cas rosée
         do icas=1,ncas_rosee
@@ -13816,21 +13679,21 @@
         
         
-        !write(*,*) 'calcul_iso_surf_oce tmp 13876'
+        !WRITE(*,*) 'calcul_iso_surf_oce tmp 13876'
 #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   
+           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
                 CALL iso_verif_aberrant(xtevap(iso_HDO,i)/evap(i), &
                         'calcul_iso_surf_oce 119')
                 endif
-              endif  !if (evap.gt.ridicule_evap) then   
-           endif !if (iso_eau.gt.0) then
+              endif  !if (evap.gt.ridicule_evap) THEN
+           endif !if (iso_eau.gt.0) THEN
         enddo !do i=1,knon
-!        write(*,*) 'calcul_iso_surf 274: stop temporaire'
+!        WRITE(*,*) 'calcul_iso_surf 274: stop temporaire'
 !        stop
 #endif
@@ -13932,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),  &
@@ -13955,6 +13818,6 @@
          ! modif 2 octobre 2008
          ! c'est sol_evap plutot que evap
-!          if (evap(i).gt.0.0) then
-         if (sol_evap(i).gt.0.0) then
+!          if (evap(i).gt.0.0) THEN
+         if (sol_evap(i).gt.0.0) THEN
            ncas_evap=ncas_evap+1
            cas_evap(ncas_evap)=i 
@@ -13962,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
@@ -13992,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
@@ -14001,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
@@ -14010,8 +13873,8 @@
 #endif            
 #ifdef ISOVERIF
-          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)=', &
+          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)=', &
                      sol_evap(i),xtsol_evap(iso_HDO,i)
                 stop  
@@ -14033,5 +13896,5 @@
         ! traitement vectoriel du cas pas d'évap
 !#ifdef ISOVERIF
-!        write(*,*) 'calcul_iso_surf_sic 455: pas d''evap'
+!        WRITE(*,*) 'calcul_iso_surf_sic 455: pas d''evap'
 !#endif
         do icas=1,ncas_noevap
@@ -14044,14 +13907,14 @@
         ! traitement vectoriel du cas rosée
 !#ifdef ISOVERIF
-!        write(*,*) 'calcul_iso_surf_sic 465: cas rosee'
+!        WRITE(*,*) 'calcul_iso_surf_sic 465: cas rosee'
 !#endif
         do icas=1,ncas_rosee
           i=cas_rosee(icas)         
         ! evap<0 -> on condense.
-        !write(*,*) 'calcul_iso_surf_oce 3176: on condense: evap(i)=',evap(i)
+        !WRITE(*,*) 'calcul_iso_surf_oce 3176: on condense: evap(i)=',evap(i)
           CALL iso_rosee_givre(xt1lay,q1lay,tsurf, &
                   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, &
@@ -14071,12 +13934,12 @@
 #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
+              endif !if (iso_eau.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')
-              endif !if (iso_eau.gt.0) then
+              endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_tracnps(xtevap(1,i), &
@@ -14084,5 +13947,5 @@
 #endif              
            enddo  
-!        write(*,*) 'calcul_iso_surf_sic 507: sortie'    
+!        WRITE(*,*) 'calcul_iso_surf_sic 507: sortie'
 #endif   
            ! end verif
@@ -14168,5 +14031,5 @@
 
 #ifdef ISOVERIF
-        write(*,*) 'calcul_iso_surf_lic 306'
+        WRITE(*,*) 'calcul_iso_surf_lic 306'
         do i=1,knon
          do ixt=1,ntraciso
@@ -14201,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) &
@@ -14213,33 +14076,32 @@
         ! 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 (precip_snow(i).gt.1e-5) THEN
            if (abs(deltaD(xtprecip_snow(iso_hdo,i)/precip_snow(i)) &
-                         +150).gt.5.0) then
+                         +150).gt.5.0) THEN
            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
-              write(*,*) 'calcul_iso_surf_lic 575 tmp: i=',i
-              write(*,*) 'h_land_ice,precip_snow(i)*dtime=' , &
+               -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=' , &
                    h_land_ice,precip_snow(i)*dtime
-              write(*,*) 'deltaDsnow=',deltaD(xtprecip_snow(iso_hdo,i) &
+              WRITE(*,*) 'deltaDsnow=',deltaD(xtprecip_snow(iso_hdo,i) &
                          /precip_snow(i))
-              write(*,*) 'deltaDland_ice=',deltaD(Rland_ice(iso_hdo,i))
-              write(*,*) 'deltaDland_ice_prec=',deltaD( &
+              WRITE(*,*) 'deltaDland_ice=',deltaD(Rland_ice(iso_hdo,i))
+              WRITE(*,*) 'deltaDland_ice_prec=',deltaD( &
                  Rland_ice_prec(iso_hdo,i))
 !             stop
            endif
            endif
-        endif !if (precip_snow(i).gt.0.0) then        
+        endif !if (precip_snow(i).gt.0.0) THEN
         enddo !do i=1,knon
-        endif !if (iso_HDO.gt.0) then
-            
+        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, &
@@ -14260,6 +14122,6 @@
          ncas_rosee=0
          do i=1,knon
-!          if (evap(i).gt.0.0) then
-           if (sol_evap(i).gt.0.0) then
+!          if (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
@@ -14269,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
@@ -14291,8 +14153,8 @@
               
 #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)
-              endif !if (iso_eau.gt.0) then  
+              endif !if (iso_eau.gt.0) THEN
 #endif
           do ixt=1,niso       
@@ -14301,5 +14163,5 @@
 
 #ifdef ISOTRAC
-        if (option_traceurs.eq.20) then
+        if (option_traceurs.eq.20) THEN
             izone_recoit=bassin_map(knindex(i))
         else
@@ -14308,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
@@ -14317,9 +14179,9 @@
 
 #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  
+              endif !if (iso_eau.gt.0) THEN
 #endif 
 
@@ -14340,6 +14202,6 @@
           i=cas_rosee(icas)        
         ! evap<0 -> on condense.
-        !write(*,*) 'calcul_iso_surf_oce 3176: on condense: evap(i)=',evap(i)
-!        write(*,*) 'calcul_iso_surf_lic 391: dtime=',dtime
+        !WRITE(*,*) 'calcul_iso_surf_oce 3176: on condense: evap(i)=',evap(i)
+!        WRITE(*,*) 'calcul_iso_surf_lic 391: dtime=',dtime
 !          Mair=100*100/9.8
           CALL iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,sol_evap,i, &
@@ -14347,14 +14209,14 @@
 
 #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 
+              endif !if (iso_eau.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, &
                     'calcul_iso_surf_lic 747')
-              endif !if (iso_eau.gt.0) then  
+              endif !if (iso_eau.gt.0) THEN
 #endif   
         enddo  !do icas=1,ncas_rosee
@@ -14373,8 +14235,8 @@
 !         enddo !do ixt=1,niso
 !#ifdef ISOVERIF
-!        if (iso_eau.gt.0) then  
+!        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
-!           write(*,*) 'calcul_iso_surf 776 tmp& i,j,klon,knon,', &
+!     &                 (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,       &
 !     &           run_off_lic_0(j),xtrun_off_lic_0(iso_eau,j)
@@ -14387,11 +14249,11 @@
 #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)
                  CALL iso_verif_egalite_choix(snow(i),xtsnow(iso_eau,i), &
                         'calcul_iso_surf_lic 363',errmax,errmaxrel)
-              endif !if (iso_eau.gt.0) then
-              if (iso_HDO.gt.0) then   
+              endif !if (iso_eau.gt.0) THEN
+              if (iso_HDO.gt.0) THEN
                 CALL iso_verif_aberrant_choix(xtsnow(iso_HDO,i), &
                      snow(i),ridicule_snow,deltalim_snow, &
@@ -14399,5 +14261,5 @@
                 CALL iso_verif_aberrant_choix(xtevap(iso_HDO,i),evap(i), &
                         ridicule_evap,deltalim_snow, 'calcul_iso_surf_lic 369')
-              endif !if (iso_eau.gt.0) then
+              endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
            CALL iso_verif_tracnps(xtevap(1,i), &
@@ -14405,14 +14267,14 @@
 #endif               
           enddo !do i=1,knon 
-!          if (iso_eau.gt.0) then  
+!          if (iso_eau.gt.0) THEN
 !            do i=1,klon 
 !             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
-!               write(*,*) 'i,knon,klon=',i,knon,klon
+!     &         errmax,errmaxrel).eq.1) THEN
+!               WRITE(*,*) 'i,knon,klon=',i,knon,klon
 !               stop
 !             endif
 !            enddo !do i=1,klon 
-!          endif ! if (iso_eau.gt.0) then 
+!          endif ! if (iso_eau.gt.0) THEN
 ! déjà vérifié dans gestion_neige
 #endif
@@ -14571,7 +14433,7 @@
 
 #ifdef ISOVERIF   
-!      write(*,*) 'calcul_iso_surf_ter 494'
+!      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), &
@@ -14582,5 +14444,5 @@
                      precip_snow(i),'calcul_iso_surf_ter 1023', &
                      errmax,errmaxrel)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
          do ixt=1,ntraciso
            CALL iso_verif_noNaN(xtprecip_snow(ixt,i), &
@@ -14619,7 +14481,7 @@
 #endif      
 #ifdef ISOVERIF
-!        write(*,*) 'calcul_iso_surf_ter 910'
+!        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', &
@@ -14630,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
+          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
               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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
        enddo !do i=1,knon
 #endif
@@ -14672,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')
@@ -14679,15 +14541,15 @@
       enddo !do i=1,knon    
               
-        !write(*,*) 'surf_ter 14041'
-        if (ruissellement_pluie.eq.1) then   
+        !WRITE(*,*) 'surf_ter 14041'
+        if (ruissellement_pluie.eq.1) THEN
           do i=1,knon
              ! c'est la pluie que l'on fait ruisseller
-!             write(*,*) ''
-!             write(*,*) 'calcul_iso_surf_ter 676, tmp:'
-!             write(*,*) 'qsol,qsol_prec',qsol(i),qsol_prec(i)
-!             write(*,*) 'precip_rain*dtime=',precip_rain(i)*dtime
-!             write(*,*) 'sol_evap*dtime=',sol_evap(i)*dtime
-!             write(*,*) 'fq_fonte_neige=',fq_fonte_neige(i)
-!             write(*,*) 'max_eau_sol=',max_eau_sol
+!             WRITE(*,*) ''
+!             WRITE(*,*) 'calcul_iso_surf_ter 676, tmp:'
+!             WRITE(*,*) 'qsol,qsol_prec',qsol(i),qsol_prec(i)
+!             WRITE(*,*) 'precip_rain*dtime=',precip_rain(i)*dtime
+!             WRITE(*,*) 'sol_evap*dtime=',sol_evap(i)*dtime
+!             WRITE(*,*) 'fq_fonte_neige=',fq_fonte_neige(i)
+!             WRITE(*,*) 'max_eau_sol=',max_eau_sol
              do ixt=1,niso
                xtrun_off(ixt,i)=0.0               
@@ -14696,5 +14558,5 @@
              if (qsol_prec(i) &
                  +(precip_rain(i)-sol_evap(i))*dtime &
-                 +fq_fonte_neige(i).gt.max_eau_sol) then
+                 +fq_fonte_neige(i).gt.max_eau_sol) THEN
                 ! ça déborde
                 ! on réduit l'infiltration de la pluie:
@@ -14702,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
@@ -14708,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
@@ -14717,19 +14579,19 @@
                       fq_fonte_neige_eff(i)=0.0
                       sol_evap_eff(i)=(qsol_prec(i)-max_eau_sol)/dtime
-                    endif !if (fq_fonte_neige_eff(i).lt.0.0) then   
-                  endif !if (precip_rain_eff(i).lt.0.0) then      
+                    endif !if (fq_fonte_neige_eff(i).lt.0.0) THEN
+                  endif !if (precip_rain_eff(i).lt.0.0) THEN
             endif !if (qsol_prec(i)
 
 #ifdef ISOVERIF    
-!            write(*,*) 'calcul_iso_surf_ter 706 tmp:'     
-!            write(*,*) 'precip_rain_eff(i)*dtime=',
+!            WRITE(*,*) 'calcul_iso_surf_ter 706 tmp:'
+!            WRITE(*,*) 'precip_rain_eff(i)*dtime=',
 !     :           precip_rain_eff(i)*dtime
-!            write(*,*) 'fq_fonte_neige_eff(i)*dtime=',
+!            WRITE(*,*) 'fq_fonte_neige_eff(i)*dtime=',
 !     :           fq_fonte_neige_eff(i)*dtime
-!            write(*,*) 'sol_evap(i)*dtime=',    
+!            WRITE(*,*) 'sol_evap(i)*dtime=',
 !     :           sol_evap(i)*dtime
-!            write(*,*) 'sol_evap_eff(i)*dtime=',    
+!            WRITE(*,*) 'sol_evap_eff(i)*dtime=',
 !     :           sol_evap_eff(i)*dtime
-!            write(*,*) 'max_eau_sol,qsol_prec(i)=',    
+!            WRITE(*,*) 'max_eau_sol,qsol_prec(i)=',
 !     :           max_eau_sol,qsol_prec(i)
             CALL iso_verif_positif_choix(max_eau_sol- &
@@ -14743,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), &
@@ -14752,25 +14614,25 @@
             ! pour les isostopes:
             if (abs(precip_rain(i)-precip_rain_eff(i)) &
-                 .gt.ridicule*1e-2) then
+                 .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) &
                          /precip_rain(i)*precip_rain_eff(i)
                 enddo 
-               else !if (precip_rain(i).gt.ridicule_rain) then 
-                  write(*,*) 'calcul_iso_surf_ter 723'
+               else !if (precip_rain(i).gt.ridicule_rain) THEN
+                  WRITE(*,*) 'calcul_iso_surf_ter 723'
                   stop
-               endif !if (precip_rain(i).gt.ridicule_rain) then 
-             else !if (precip_rain_eff(i).gt.ridicule_rain) then 
+               endif !if (precip_rain(i).gt.ridicule_rain) THEN
+             else !if (precip_rain_eff(i).gt.ridicule_rain) THEN
                 do ixt=1,niso
                   xtprecip_rain_eff(ixt,i)=0.0
                 enddo
                 if ((bidouille_anti_divergence).and. &
-                 (iso_eau.gt.0))  then
+                 (iso_eau.gt.0))  THEN
                   xtprecip_rain_eff(iso_eau,i)=precip_rain_eff(i)
                 endif
-             endif !if (precip_rain_eff(i).gt.ridicule_rain) then 
+             endif !if (precip_rain_eff(i).gt.ridicule_rain) THEN
              runoff_tmp(i)=runoff_tmp(i) &
                  +(precip_rain(i)-precip_rain_eff(i))*dtime
@@ -14779,33 +14641,32 @@
                   +(xtprecip_rain(ixt,i)-xtprecip_rain_eff(ixt,i))*dtime
              enddo
-            endif !if (abs(precip_rain(i)-precip_rain_eff(i)).gt.ridicule) then
-           
+            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), &
                  'calcul_iso_surf_ter 1142', &
                  errmax,errmaxrel)
-            endif !if (iso_eau.gt.0) then  
+            endif !if (iso_eau.gt.0) THEN
 #endif   
 
             if (abs(fq_fonte_neige_eff(i)-fq_fonte_neige(i)) &
-                 .gt.ridicule) then
+                 .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) &
                           /fq_fonte_neige(i)*fq_fonte_neige_eff(i)
                 enddo 
-               else !if (fq_fonte_neige(i).gt.ridicule_rain) then 
-                  write(*,*) 'calcul_iso_surf_ter 723'
+               else !if (fq_fonte_neige(i).gt.ridicule_rain) THEN
+                  WRITE(*,*) 'calcul_iso_surf_ter 723'
                   stop
-               endif !if (fq_fonte_neige(i).gt.ridicule_rain) then 
-             else !if (fq_fonte_neige_eff(i).gt.ridicule_rain) then 
+               endif !if (fq_fonte_neige(i).gt.ridicule_rain) THEN
+             else !if (fq_fonte_neige_eff(i).gt.ridicule_rain) THEN
                 do ixt=1,niso
                   fxt_fonte_neige_eff(ixt,i)=0.0
                 enddo
-             endif !if (fq_fonte_neige_eff(i).gt.ridicule_rain) then 
+             endif !if (fq_fonte_neige_eff(i).gt.ridicule_rain) THEN
              runoff_tmp(i)=runoff_tmp(i) &
                  +(fq_fonte_neige(i)-fq_fonte_neige_eff(i))
@@ -14817,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)), &
@@ -14835,6 +14696,5 @@
 #endif    
           enddo !do i=1,knon   
-        endif   !if (ruissellement_pluie) then
-
+        endif   !if (ruissellement_pluie) THEN
         ! on ajoute les flux entrants dans le sol
         ! attention, c'est facile si qsol>=0.
@@ -14848,12 +14708,12 @@
        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) &
               +xtprecip_rain_eff(ixt,i)*dtime+fxt_fonte_neige_eff(ixt,i)
           enddo !do ixt=1,niso
-        else !if (qsol_prec(i).ge.0.0) then  
+        else !if (qsol_prec(i).ge.0.0) THEN
             if (precip_rain_eff(i)*dtime+fq_fonte_neige_eff(i) &
-                 .gt.ridicule_qsol) then
+                 .gt.ridicule_qsol) THEN
               do ixt=1,niso
                xtsol_avant_evap(ixt,i)=qsol_avant_evap(i)* &
@@ -14868,5 +14728,5 @@
                 enddo !do ixt=1,niso
             endif
-        endif !if (qsol_prec(i).ge.0.0) then 
+        endif !if (qsol_prec(i).ge.0.0) THEN
        enddo !do i=1,knon  
 
@@ -14876,16 +14736,16 @@
       do ixt=1,niso
         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)
-          write(*,*) 'xtprecip_rain_eff(ixt,i)=', &
+          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)
+          WRITE(*,*) 'xtprecip_rain_eff(ixt,i)=', &
                 xtprecip_rain_eff(ixt,i)
-          write(*,*) 'fxt_fonte_neige_eff(ixt,i)=', &
+          WRITE(*,*) 'fxt_fonte_neige_eff(ixt,i)=', &
                 fxt_fonte_neige_eff(ixt,i)
-          write(*,*) 'precip_rain_eff(i)=',precip_rain_eff(i)
-          write(*,*) 'fq_fonte_neige_eff(i)=',fq_fonte_neige_eff(i)
-          write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
-          write(*,*) 'xtsol_avant_evap(ixt,i)=',xtsol_avant_evap(ixt,i)
-          write(*,*) 'dtime=',dtime
+          WRITE(*,*) 'precip_rain_eff(i)=',precip_rain_eff(i)
+          WRITE(*,*) 'fq_fonte_neige_eff(i)=',fq_fonte_neige_eff(i)
+          WRITE(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
+          WRITE(*,*) 'xtsol_avant_evap(ixt,i)=',xtsol_avant_evap(ixt,i)
+          WRITE(*,*) 'dtime=',dtime
           stop
         endif
@@ -14895,13 +14755,13 @@
 #ifdef ISOVERIF
         do i=1,knon
-          if (iso_eau.gt.0) then
-!            write(*,*) 'qsol_prec=',qsol_prec(i)
-!            write(*,*) 'xtsol_prec=',xtsol_prec(iso_eau,i)
-!            write(*,*) 'precip_rain_eff=',precip_rain_eff(i)
-!            write(*,*) 'fq_fonte_neige_eff=',fq_fonte_neige_eff(i)
-!            write(*,*) 'qsol_avant_evap=',qsol_avant_evap(i)
-!            write(*,*) 'xtsol_avant_evap=',xtsol_avant_evap(iso_eau,i) 
-!            write(*,*) 'xtprecip_rain_eff=',xtprecip_rain_eff(iso_eau,i)
-!            write(*,*) 'fxt_fonte_neige_eff=',
+          if (iso_eau.gt.0) THEN
+!            WRITE(*,*) 'qsol_prec=',qsol_prec(i)
+!            WRITE(*,*) 'xtsol_prec=',xtsol_prec(iso_eau,i)
+!            WRITE(*,*) 'precip_rain_eff=',precip_rain_eff(i)
+!            WRITE(*,*) 'fq_fonte_neige_eff=',fq_fonte_neige_eff(i)
+!            WRITE(*,*) 'qsol_avant_evap=',qsol_avant_evap(i)
+!            WRITE(*,*) 'xtsol_avant_evap=',xtsol_avant_evap(iso_eau,i)
+!            WRITE(*,*) 'xtprecip_rain_eff=',xtprecip_rain_eff(iso_eau,i)
+!            WRITE(*,*) 'fxt_fonte_neige_eff=',
 !     :                   fxt_fonte_neige_eff(iso_eau,i)
             CALL iso_verif_egalite_choix( &
@@ -14910,32 +14770,32 @@
                  '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_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
-               write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
-               write(*,*) 'ridicule_qsol=',ridicule_qsol
-               write(*,*) 'qsol_prec(i)=',qsol_prec(i)
-               write(*,*) 'precip_rain_eff(i)*dtime=', &
+                 /faccond,'calcul_iso_surf_ter 5032').eq.1) THEN
+               WRITE(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
+               WRITE(*,*) 'ridicule_qsol=',ridicule_qsol
+               WRITE(*,*) 'qsol_prec(i)=',qsol_prec(i)
+               WRITE(*,*) 'precip_rain_eff(i)*dtime=', &
                  precip_rain_eff(i)*dtime
-               write(*,*) 'fq_fonte_neige_eff(i)=',fq_fonte_neige_eff(i)
-               write(*,*) 'deltaD_sol_prec=', &
+               WRITE(*,*) 'fq_fonte_neige_eff(i)=',fq_fonte_neige_eff(i)
+               WRITE(*,*) 'deltaD_sol_prec=', &
                  deltaD(xtsol_prec(iso_HDO,i)/qsol_prec(i))
-               write(*,*) 'deltaDprecip_rain_eff=',& 
+               WRITE(*,*) 'deltaDprecip_rain_eff=',&
                  deltaD(( &
                  xtprecip_rain_eff(iso_HDO,i)/precip_rain_eff(i)))
-               write(*,*) 'deltaD_finte_neige_eff=', &
+               WRITE(*,*) 'deltaD_finte_neige_eff=', &
                  deltaD(( &
                  fxt_fonte_neige_eff(iso_HDO,i)/fq_fonte_neige_eff(i)))
-               write(*,*) 'precip_rain(i)*dtime=', &
+               WRITE(*,*) 'precip_rain(i)*dtime=', &
                  precip_rain(i)*dtime
-               write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+               WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
                stop
              endif !if (iso_verif_aberrant_nostop(
            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
+          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
               CALL iso_verif_aberrant_o17(( &
                  xtsol_avant_evap(iso_O17,i)/qsol_avant_evap(i)), &
@@ -14943,5 +14803,5 @@
                  /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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
         enddo !do i=1,knon   
 #endif
@@ -14955,5 +14815,5 @@
         ! verif du bilan du sol
 #ifdef ISOVERIF       
-!        write(*,*) 'calcul_iso_surf_ter 1200'
+!        WRITE(*,*) 'calcul_iso_surf_ter 1200'
         do i=1,knon      
             CALL iso_verif_egalite_choix(min(( &
@@ -14961,12 +14821,12 @@
                 qsol(i), &
                'calcul_iso_surf_ter 587',errmax,errmaxrel)
-           if (ruissellement_pluie.eq.1) then
+           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
-               write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
-               write(*,*) 'qsol_avant_deversement(i)=', &
+                 ridicule_qsol,'calcul_iso_surf_ter 843').eq.1) THEN
+               WRITE(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
+               WRITE(*,*) 'qsol_avant_deversement(i)=', &
                  qsol_avant_deversement(i)
-               write(*,*) 'sol_evap_eff(i)*dtime=',sol_evap_eff(i)*dtime
+               WRITE(*,*) 'sol_evap_eff(i)*dtime=',sol_evap_eff(i)*dtime
                stop
              endif
@@ -14982,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 
@@ -14988,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
@@ -14994,5 +14854,5 @@
            trace_cas(i)=3
 #endif           
-          else !if (sol_evap(i).gt.0.0) then
+          else !if (sol_evap(i).gt.0.0) THEN
            ncas_noevap=ncas_noevap+1
            cas_noevap(ncas_noevap)=i
@@ -15000,5 +14860,5 @@
            trace_cas(i)=2
 #endif
-          endif !if (sol_evap(i).gt.0.0) then       
+          endif !if (sol_evap(i).gt.0.0) THEN
          enddo !do i=1,knon
 
@@ -15018,20 +14878,20 @@
 #endif           
 #ifdef ISOVERIF
-!              write(*,*) 'calcul_iso_surf_ter 767: i,sol_evap=',
+!              WRITE(*,*) 'calcul_iso_surf_ter 767: i,sol_evap=',
 !     :           i,sol_evap(i)
-!              write(*,*) 'xtsol_avant_evap,qsol_avant_evap=',
+!              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), &
                (sol_evap_eff(i)), &
-                '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)
-            write(*,*) 'sol_evap(',i,')*dtime=',sol_evap(i)*dtime
-            write(*,*) 'qsol_prec(',i,')=',qsol_prec(i)
-            write(*,*) 'precip_rain(',i,')*dtime=',precip_rain(i)*dtime
-            write(*,*) 'fq_fonte_neige(',i,')=',fq_fonte_neige(i)
+                '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)
+            WRITE(*,*) 'sol_evap(',i,')*dtime=',sol_evap(i)*dtime
+            WRITE(*,*) 'qsol_prec(',i,')=',qsol_prec(i)
+            WRITE(*,*) 'precip_rain(',i,')*dtime=',precip_rain(i)*dtime
+            WRITE(*,*) 'fq_fonte_neige(',i,')=',fq_fonte_neige(i)
             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)) &
@@ -15039,38 +14899,38 @@
                  'calcul_iso_surf_ter 2952', &
                          errmax,errmaxrel)
-                if (qsol_avant_evap(i).gt.ridicule_qsol) then
+                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
-                      write(*,*) 'xtsol_avant_evap(iso_eau,i)=', &
+                    errmax,errmaxrel*10).eq.1) THEN
+                      WRITE(*,*) 'xtsol_avant_evap(iso_eau,i)=', &
                          xtsol_avant_evap(iso_eau,i)
-                      write(*,*) 'qsol_avant_evap(i)=', &
+                      WRITE(*,*) 'qsol_avant_evap(i)=', &
                          qsol_avant_evap(i)
-                      write(*,*) 'xtsol_prec(iso_eau,i)=', &
+                      WRITE(*,*) 'xtsol_prec(iso_eau,i)=', &
                          xtsol_prec(iso_eau,i)
-                      write(*,*) 'qsol_prec(i)=', &
+                      WRITE(*,*) 'qsol_prec(i)=', &
                          qsol_prec(i)
-                      write(*,*) 'xtprecip_rain_eff(iso_eau,i)=', &
+                      WRITE(*,*) 'xtprecip_rain_eff(iso_eau,i)=', &
                          xtprecip_rain_eff(iso_eau,i)
-                      write(*,*) 'precip_rain_eff(i)=',& 
+                      WRITE(*,*) 'precip_rain_eff(i)=',&
                          precip_rain_eff(i)
-                      write(*,*) 'fxt_fonte_neige_eff(iso_eau,i)=', &
+                      WRITE(*,*) 'fxt_fonte_neige_eff(iso_eau,i)=', &
                          fxt_fonte_neige_eff(iso_eau,i)
-                      write(*,*) 'fq_fonte_neige_eff(i)=', &
+                      WRITE(*,*) 'fq_fonte_neige_eff(i)=', &
                          fq_fonte_neige_eff(i)
                       stop                 
                   endif !if (iso_verif_egalite_choix(
-                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
+                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
                   CALL iso_verif_aberrant(( &
                  xtsol_avant_evap(iso_HDO,i)/qsol_avant_evap(i)) &
                         /faccond ,'calcul_iso_surf_ter 3181')
-                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
+                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
                    CALL iso_verif_aberrant_o17(( &
                     xtsol_avant_evap(iso_O17,i)/qsol_avant_evap(i)), &
@@ -15078,10 +14938,10 @@
                     /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 ((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            
@@ -15094,7 +14954,7 @@
            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
-                write(*,*) 'tsurf(i)=',tsurf(i)-t_coup,'°C'
-                if (tsurf(i)-t_coup.lt.50.0) then
+                  'calcul_iso_surf 1188').eq.1) THEN
+                WRITE(*,*) 'tsurf(i)=',tsurf(i)-t_coup,'°C'
+                if (tsurf(i)-t_coup.lt.50.0) THEN
                    stop
                 endif
@@ -15117,22 +14977,22 @@
 #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
+         endif !if (iso_eau.gt.0) THEN
          if ((iso_HDO.gt.0).and. &
-                 (qsol_avant_evap(i).gt.ridicule_qsol*1e2)) then
+                 (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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
         if ((bidouille_anti_divergence).and. &
-                 (iso_eau.gt.0))  then
+                 (iso_eau.gt.0))  THEN
             Rsol(iso_eau)=1.0
         endif
@@ -15149,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)
@@ -15155,5 +15015,5 @@
           else
 #ifdef ISOVERIF              
-              write(*,*) 'calcul_iso_surf 1415: q1lay=',q1lay(i)
+              WRITE(*,*) 'calcul_iso_surf 1415: q1lay=',q1lay(i)
               stop  
 #endif              
@@ -15180,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
@@ -15197,20 +15057,19 @@
          
          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
-         else !if (tsurf(i).gt.t_coup) then
+         else !if (tsurf(i).gt.t_coup) THEN
              ! à 0°C, on sublime, donc on révap tout sans fractionnement
              Pveg=1.0
-         endif !if (tsurf(i).gt.t_coup) then
-
+         endif !if (tsurf(i).gt.t_coup) THEN
          ! calcul de ce que donnerait l'évap du sol nu
          
 #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
@@ -15221,16 +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 (qevap(i).gt.ridicule_evap) THEN
+        endif !if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif                  
         endif     
@@ -15249,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
@@ -15272,5 +15130,5 @@
 
 #ifdef ISOTRAC
-        if (option_traceurs.eq.20) then
+        if (option_traceurs.eq.20) THEN
            izone_recoit=bassin_map(knindex(i))
         else
@@ -15279,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
@@ -15298,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), &
@@ -15306,14 +15164,14 @@
                  (qsol_avant_deversement(i)), &
                  '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
+           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( &
                  xtsol_evap(iso_HDO,i)/sol_evap(i), &
-                 'calcul_iso_surf_ter 3273: sur terre').eq.1) then
-!                   write(*,*) 'deltaDsol=',deltaD(Rsol(ixt))
+                 '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
                    ! aberrante de deltaD1
-                   write(*,*) 'deltaD1new=',deltaD( &
+                   WRITE(*,*) 'deltaD1new=',deltaD( &
                          (xtsol_evap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
                          /(sol_evap(i)*dtime+q10))
@@ -15323,8 +15181,8 @@
                         'calcul_iso_surf_ter 1390')
               endif  !if (iso_verif_aberrant  
-             endif !if (abs(evap(i)).gt.ridicule_rain*1e-2) then
+             endif !if (abs(evap(i)).gt.ridicule_rain*1e-2) THEN
              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)) &
@@ -15332,61 +15190,61 @@
                         'calcul_iso_surf_ter 1390')
               endif
-              if (qsol_avant_deversement(i).gt.ridicule_qsol*1e2) then
+              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
-                  write(*,*) 'i, qsol(i)=',i, qsol(i)
-                  write(*,*) 'qsol_avant_evap,qevap,L=', &
+                       /faccond, 'calcul_iso_surf_ter 1542').eq.1) THEN
+                  WRITE(*,*) 'i, qsol(i)=',i, qsol(i)
+                  WRITE(*,*) 'qsol_avant_evap,qevap,L=', &
                          qsol_avant_evap(i),qevap(i),L
-                  write(*,*) 'deltaDsol_avant_evap',deltaD( &
+                  WRITE(*,*) 'deltaDsol_avant_evap',deltaD( &
                        (xtsol_avant_evap(iso_HDO,i) &
                         /qsol_avant_evap(i)))
-                  write(*,*) 'deltaDRsol=',deltaD(Rsol(iso_HDO))
-                  write(*,*) 'deltaDsol_evap=',deltaD( &
+                  WRITE(*,*) 'deltaDRsol=',deltaD(Rsol(iso_HDO))
+                  WRITE(*,*) 'deltaDsol_evap=',deltaD( &
                        xtnu(iso_HDO,i)/qevap(i))
-                  write(*,*) 'h1(i),f=',h1(i),max((min(L, &
+                  WRITE(*,*) 'h1(i),f=',h1(i),max((min(L, &
                          (qsol_avant_evap(i)))-qevap(i)) &
                          /min(L,(qsol_avant_evap(i))),0.0)
                   stop
                 endif
-              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 
+              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
                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 (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
-                  write(*,*) 'i, qsol(i)=',i,qsol_avant_deversement(i)
-                  write(*,*) 'qsol_avant_evap,qevap,L=', &
+                 'iso_surf_ter 1623').eq.1) THEN
+                  WRITE(*,*) 'i, qsol(i)=',i,qsol_avant_deversement(i)
+                  WRITE(*,*) 'qsol_avant_evap,qevap,L=', &
                          qsol_avant_evap(i),qevap(i),L
-                  write(*,*) 'o17excess_sol_avant_evap',o17excess( &
+                  WRITE(*,*) 'o17excess_sol_avant_evap',o17excess( &
                        (xtsol_avant_evap(iso_o17,i) &
                         /qsol_avant_evap(i)),( &
                         xtsol_avant_evap(iso_o18,i)/qsol_avant_evap(i)))
-                  write(*,*) 'o17excess_sol_evap=',o17excess( &
+                  WRITE(*,*) 'o17excess_sol_evap=',o17excess( &
                      xtsol_evap(iso_o17,i)/sol_evap(i), &
                      xtsol_evap(iso_o18,i)/sol_evap(i))
-                  write(*,*) 'h1(i),f=',h1(i),max((min(L, &
+                  WRITE(*,*) 'h1(i),f=',h1(i),max((min(L, &
                          (qsol_avant_evap(i)))-qevap(i)) &
                          /min(L,(qsol_avant_evap(i))),0.0)
-                  write(*,*) 'qsol_avant_evap,sol_evap,qsol,dt=', &
+                  WRITE(*,*) 'qsol_avant_evap,sol_evap,qsol,dt=', &
                         qsol_avant_evap(i),sol_evap(i),&
                         qsol_avant_deversement(i),dtime
-                  write(*,*) 'qsol_avant_evap17,sol_evap17,qsol17=', &
+                  WRITE(*,*) 'qsol_avant_evap17,sol_evap17,qsol17=', &
                          xtsol_avant_evap(iso_o17,i), &
                          xtsol_evap(iso_o17,i),xtsol(iso_o17,i)
-                  write(*,*) 'qsol_avant_evap18,sol_evap17,qsol18=', &
+                  WRITE(*,*) 'qsol_avant_evap18,sol_evap17,qsol18=', &
                          xtsol_avant_evap(iso_o18,i), &
                          xtsol_evap(iso_o18,i),xtsol(iso_o18,i)
@@ -15394,5 +15252,5 @@
               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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur(xtsol_evap(1,i), &
@@ -15406,5 +15264,5 @@
         do icas=1,ncas_noevap
           i=cas_noevap(icas)
-!          write(*,*) 'calcul_iso_surf_oce 3175: pas d''évap'
+!          WRITE(*,*) 'calcul_iso_surf_oce 3175: pas d''évap'
           do ixt=1,ntraciso
             xtsol_evap(ixt,i)=0.0
@@ -15419,7 +15277,7 @@
           i=cas_rosee(icas)      
           ! evap<0 -> on condense.
-!          write(*,*) 'calcul_iso_surf_oce 3176: condense: sol_evap(i)=',
+!          WRITE(*,*) 'calcul_iso_surf_oce 3176: condense: sol_evap(i)=',
 !     :           sol_evap(i)          
-!          write(*,*) 'calcul_iso_surf_ter 716: dtime=',dtime
+!          WRITE(*,*) 'calcul_iso_surf_ter 716: dtime=',dtime
 !          Mair=100*100/9.8
           CALL iso_rosee_givre(xt1lay,q1lay,tsurf,t_coup,  &
@@ -15430,5 +15288,5 @@
           ! 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) &
@@ -15437,6 +15295,6 @@
              if (iso_verif_noNaN_nostop(( &
                  xtsol_evap_eff(ixt,i)),'iso_surf_ter 1790') &
-                 .eq.1) then
-               write(*,*) 'xtsol_evap,sol_evap,sol_evap_eff=', &
+                 .eq.1) THEN
+               WRITE(*,*) 'xtsol_evap,sol_evap,sol_evap_eff=', &
                  xtsol_evap(ixt,i),sol_evap(i),sol_evap_eff(i)
                stop
@@ -15444,5 +15302,5 @@
 #endif             
             enddo !do ixt=1,niso
-          else ! if (sol_evap.gt.0.0) then
+          else ! if (sol_evap.gt.0.0) THEN
 #ifdef ISOVERIF           
              CALL iso_verif_egalite(sol_evap_eff(i),0.0, &
@@ -15452,7 +15310,6 @@
              xtsol_evap_eff(ixt,i)=0.0
            enddo !do ixt=1,niso
-          endif !if (sol_evap.gt.0.0) then
-
-          if (ruissellement_pluie.eq.1) then
+          endif !if (sol_evap.gt.0.0) THEN
+          if (ruissellement_pluie.eq.1) THEN
             do ixt=1,niso
               xtrun_off(ixt,i)=xtrun_off(ixt,i)+(xtsol_evap_eff(ixt,i) &
@@ -15461,6 +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
@@ -15471,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)), &
@@ -15478,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
@@ -15505,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)), &
@@ -15514,12 +15370,12 @@
                     sol_evap(i), &
                     '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
+              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
                 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 (qsol(i).gt.ridicule) THEN
+             endif ! if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #endif
                     
@@ -15528,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) &
@@ -15537,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', &
@@ -15544,5 +15400,5 @@
 #endif                
               enddo  
-          else !if (qsol_avant_deversement(i).gt.max_eau_sol) then
+          else !if (qsol_avant_deversement(i).gt.max_eau_sol) THEN
 #ifdef ISOVERIF               
                CALL iso_verif_egalite(run_off(i),0.0, &
@@ -15552,7 +15408,7 @@
                xtrun_off(ixt,i)=0.0 
               enddo               
-          endif !if (qsol(i).gt.max_eau_sol) then
+          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  
@@ -15561,15 +15417,14 @@
                  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', &
                        errmax,errmaxrel)
-            endif !if (iso_eau.gt.0) then
-            
-!            write(*,*) 'tmp ter 1929: i,runoff_tmp,run_off=',
+            endif !if (iso_eau.gt.0) THEN
+!            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), &
                 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).
@@ -15577,21 +15432,21 @@
            ! la precision sur le résultat ne peut pas être meilleure que
            ! 1e-5.
-            write(*,*) 'i,max_eau_sol=',i,max_eau_sol            
-            write(*,*) 'qsol_prec=',qsol_prec(i) 
-            write(*,*) 'precip_rain*dt=',precip_rain(i)*dtime
-            write(*,*) 'fq_fonte_neige=',fq_fonte_neige(i)
-            write(*,*) 'sol_evap*dt=',sol_evap(i)*dtime
-            write(*,*) 'precip_rain_eff*dt=',precip_rain_eff(i)*dtime
-            write(*,*) 'fq_fonte_neige_eff=',fq_fonte_neige_eff(i)
-            write(*,*) 'sol_evap_eff*dt=',sol_evap_eff(i)*dtime
-            write(*,*) 'qsol_avant_evap=',qsol_avant_evap(i)
-            write(*,*) 'qsol_avant_deversement=',  &
+            WRITE(*,*) 'i,max_eau_sol=',i,max_eau_sol
+            WRITE(*,*) 'qsol_prec=',qsol_prec(i)
+            WRITE(*,*) 'precip_rain*dt=',precip_rain(i)*dtime
+            WRITE(*,*) 'fq_fonte_neige=',fq_fonte_neige(i)
+            WRITE(*,*) 'sol_evap*dt=',sol_evap(i)*dtime
+            WRITE(*,*) 'precip_rain_eff*dt=',precip_rain_eff(i)*dtime
+            WRITE(*,*) 'fq_fonte_neige_eff=',fq_fonte_neige_eff(i)
+            WRITE(*,*) 'sol_evap_eff*dt=',sol_evap_eff(i)*dtime
+            WRITE(*,*) 'qsol_avant_evap=',qsol_avant_evap(i)
+            WRITE(*,*) 'qsol_avant_deversement=',  &
                          qsol_avant_deversement(i)
-            write(*,*) 'run_off=',run_off(i)
-            write(*,*) 'runoff_tmp=',runoff_tmp(i)
-!            write(*,*) 'xtsol_prec=',xtsol_prec(iso_eau,i)
-!            write(*,*) 'xtsol_avant_evap=',xtsol_avant_evap(iso_eau,i) 
-!            write(*,*) 'xtprecip_rain_eff=',xtprecip_rain_eff(iso_eau,i)
-!            write(*,*) 'fxt_fonte_neige_eff=',
+            WRITE(*,*) 'run_off=',run_off(i)
+            WRITE(*,*) 'runoff_tmp=',runoff_tmp(i)
+!            WRITE(*,*) 'xtsol_prec=',xtsol_prec(iso_eau,i)
+!            WRITE(*,*) 'xtsol_avant_evap=',xtsol_avant_evap(iso_eau,i)
+!            WRITE(*,*) 'xtprecip_rain_eff=',xtprecip_rain_eff(iso_eau,i)
+!            WRITE(*,*) 'fxt_fonte_neige_eff=',
 !     :                   fxt_fonte_neige_eff(iso_eau,i)
               stop
@@ -15602,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)
@@ -15610,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', &
@@ -15618,9 +15473,8 @@
 #endif       
         else
-          write(*,*) 'calcul_iso_surf 1764: option non valide:'  
-          write(*,*) 'ruissellement_pluie=',ruissellement_pluie
+          WRITE(*,*) 'calcul_iso_surf 1764: option non valide:'
+          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
@@ -15649,17 +15503,17 @@
 #ifdef ISOVERIF
         do i=1,knon
-              if (iso_eau.gt.0) then  
+              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
-                   write(*,*) 'xtevap(iso_eau,i)=',xtevap(iso_eau,i)
-                   write(*,*) 'evap(i)=',evap(i)
-                   write(*,*) 'xtsol_evap(iso_eau,i)=', &
+                     .eq.1) THEN
+                   WRITE(*,*) 'xtevap(iso_eau,i)=',xtevap(iso_eau,i)
+                   WRITE(*,*) 'evap(i)=',evap(i)
+                   WRITE(*,*) 'xtsol_evap(iso_eau,i)=', &
                          xtsol_evap(iso_eau,i)
-                   write(*,*) 'sol_evap(i)=',sol_evap(i)
-                   write(*,*) 'xtsnow_evap(iso_eau,i)=', &
+                   WRITE(*,*) 'sol_evap(i)=',sol_evap(i)
+                   WRITE(*,*) 'xtsnow_evap(iso_eau,i)=', &
                          xtsnow_evap(iso_eau,i)
-                   write(*,*) 'snow_evap(i)=',snow_evap(i)
+                   WRITE(*,*) 'snow_evap(i)=',snow_evap(i)
                    stop                   
                  endif
@@ -15672,28 +15526,28 @@
                  if (iso_verif_positif_nostop( &
                          max_eau_sol-xtsol(iso_eau,i), &
-                         'calcul_iso_surf_ter 746b').eq.1) then
-                   write(*,*) 'i=',i
-                   write(*,*) 'max_eau_sol=',max_eau_sol
-                   write(*,*) 'qsol(i)=',qsol(i)
-                   write(*,*) 'xtsol(iso_eau,i)=',xtsol(iso_eau,i)
-                   write(*,*) 'qsol_avant_deversement(i)=', &
+                         'calcul_iso_surf_ter 746b').eq.1) THEN
+                   WRITE(*,*) 'i=',i
+                   WRITE(*,*) 'max_eau_sol=',max_eau_sol
+                   WRITE(*,*) 'qsol(i)=',qsol(i)
+                   WRITE(*,*) 'xtsol(iso_eau,i)=',xtsol(iso_eau,i)
+                   WRITE(*,*) 'qsol_avant_deversement(i)=', &
                          qsol_avant_deversement(i)
-                   write(*,*) 'precip_rain(i)=',precip_rain(i)
-                   write(*,*) 'precip_rain_eff(i)=',precip_rain_eff(i)
-                   write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
-                   write(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
-                   write(*,*) 'qsol_prec(i)=',qsol_prec(i)
-                   write(*,*) 'sol_evap(i)=',sol_evap(i)
-                   write(*,*) 'xtprecip_rain(iso_eau,i)=', &
+                   WRITE(*,*) 'precip_rain(i)=',precip_rain(i)
+                   WRITE(*,*) 'precip_rain_eff(i)=',precip_rain_eff(i)
+                   WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+                   WRITE(*,*) 'qsol_avant_evap(i)=',qsol_avant_evap(i)
+                   WRITE(*,*) 'qsol_prec(i)=',qsol_prec(i)
+                   WRITE(*,*) 'sol_evap(i)=',sol_evap(i)
+                   WRITE(*,*) 'xtprecip_rain(iso_eau,i)=', &
                          xtprecip_rain(iso_eau,i)
-                   write(*,*) 'xtprecip_rain_eff(iso_eau,i)=', &
+                   WRITE(*,*) 'xtprecip_rain_eff(iso_eau,i)=', &
                          xtprecip_rain_eff(iso_eau,i)
-                   write(*,*) 'xtsol_avant_evap(iso_eau,i)=', &
+                   WRITE(*,*) 'xtsol_avant_evap(iso_eau,i)=', &
                          xtsol_avant_evap(iso_eau,i)
-                   write(*,*) 'xtsol_prec(iso_eau,i)=', &
+                   WRITE(*,*) 'xtsol_prec(iso_eau,i)=', &
                          xtsol_prec(iso_eau,i)
-                   write(*,*) 'xtsol_evap(iso_eau,i)=', &
+                   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
@@ -15702,6 +15556,6 @@
                    endif
                  endif
-              endif !if (iso_eau.gt.0) then
-              if (iso_HDO.gt.0) then  
+              endif !if (iso_eau.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')
@@ -15709,19 +15563,19 @@
                      snow(i),ridicule,deltalim_snow, &
                      'calcul_iso_surf_lic 1955')
-                 if (evap(i).gt.ridicule_evap) then
+                 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
-                     write(*,*) 'i=',i
-                     write(*,*) 'sol_evap,snow_evap=', &
+                        '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( &
+                     WRITE(*,*) 'deltaD1new=',deltaD( &
                          (xtevap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
                          /(evap(i)*dtime+q10))
-                     write(*,*) 'deltaD1=',   deltaD(R1(iso_hdo))
+                     WRITE(*,*) 'deltaD1=',   deltaD(R1(iso_hdo))
                      CALL iso_verif_aberrant( &
                          (xtevap(iso_hdo,i)*dtime+q10*R1(iso_hdo)) &
@@ -15729,14 +15583,14 @@
                         'calcul_iso_surf_ter 1571')
                    endif
-                 endif !if (evap(i).gt.ridicule_evap) then
+                 endif !if (evap(i).gt.ridicule_evap) THEN
                  if (iso_verif_aberrant_choix_nostop(xtevap(iso_HDO,i), &
                    evap(i),ridicule,1e5,'calcul_iso_surf_ter 1578') &
-                         .eq.1) then
-                     write(*,*) 'i=',i
-                     write(*,*) 'sol_evap,snow_evap=', &
+                         .eq.1) THEN
+                     WRITE(*,*) 'i=',i
+                     WRITE(*,*) 'sol_evap,snow_evap=', &
                          sol_evap(i),snow_evap(i)
-                     write(*,*) 'deltaDsol_evap=', &
+                     WRITE(*,*) 'deltaDsol_evap=', &
                          deltaD(xtsol_evap(iso_hdo,i)/sol_evap(i))
-                     write(*,*) 'deltaDsnow_evap=', &
+                     WRITE(*,*) 'deltaDsnow_evap=', &
                          deltaD(xtsnow_evap(iso_hdo,i)/snow_evap(i))
                      CALL iso_verif_aberrant( &
@@ -15745,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
+                 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
                  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 ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC
            CALL iso_verif_tracnps(xtevap(1,i), &
@@ -15764,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) 
@@ -15778,17 +15632,17 @@
          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
-             write(*,*) 'calcul_iso_surf_ter 2050: bilan qsol,i=',i
-             write(*,*) 'qsol(i)=',qsol(i)
-             write(*,*) 'qsol_prec(i)=',qsol_prec(i)
-             write(*,*) 'precip_rain(i)*dt=',precip_rain(i)*dtime
-             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
-             write(*,*) 'evap(i)*dt=',evap(i)*dtime
-             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
-             write(*,*) 'run_off(i) (diag)=',run_off(i)
-             write(*,*) 'runoff_tmp(i)=',runoff_tmp(i)
+                 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)
+             WRITE(*,*) 'qsol_prec(i)=',qsol_prec(i)
+             WRITE(*,*) 'precip_rain(i)*dt=',precip_rain(i)*dtime
+             WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+             WRITE(*,*) 'evap(i)*dt=',evap(i)*dtime
+             WRITE(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
+             WRITE(*,*) 'run_off(i) (diag)=',run_off(i)
+             WRITE(*,*) 'runoff_tmp(i)=',runoff_tmp(i)
              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
@@ -15799,25 +15653,25 @@
             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
-             write(*,*) 'calcul_iso_surf_ter 2066: bilan xtsol, ixt=', &
+                 errmax_sol*max(qsol(i),1.0),errmaxrel).eq.1) THEN
+             WRITE(*,*) 'calcul_iso_surf_ter 2066: bilan xtsol, ixt=', &
                  ixt
-             write(*,*) 'xtsol(ixt,i)=',xtsol(ixt,i)
-             write(*,*) 'xtsol_prec(i)=',xtsol_prec(ixt,i)
-             write(*,*) 'xtprecip_rain(i)*dt=',xtprecip_rain(ixt,i) &
+             WRITE(*,*) 'xtsol(ixt,i)=',xtsol(ixt,i)
+             WRITE(*,*) 'xtsol_prec(i)=',xtsol_prec(ixt,i)
+             WRITE(*,*) 'xtprecip_rain(i)*dt=',xtprecip_rain(ixt,i) &
                  *dtime
-             write(*,*) 'fxt_fonte_neige(i)=',fxt_fonte_neige(ixt,i)
-             write(*,*) 'xtevap(i)*dt=',xtevap(ixt,i)*dtime
-             write(*,*) 'xtsnow_evap(i)*dt=',xtsnow_evap(ixt,i)*dtime
-             write(*,*) 'xtrun_off(i)=',xtrun_off(ixt,i)
-             write(*,*) 'i=',i
-             write(*,*) 'qsol(i)=',qsol(i)
-             write(*,*) 'qsol_prec(i)=',qsol_prec(i)
-             write(*,*) 'precip_rain(i)*dt=',precip_rain(i)*dtime
-             write(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
-             write(*,*) 'evap(i)*dt=',evap(i)*dtime
-             write(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
-             write(*,*) 'run_off(i) (diag)=',run_off(i)
-             write(*,*) 'runoff_tmp(i)=',runoff_tmp(i)
-             if (qsol_prec(i).gt.-ridicule) then
+             WRITE(*,*) 'fxt_fonte_neige(i)=',fxt_fonte_neige(ixt,i)
+             WRITE(*,*) 'xtevap(i)*dt=',xtevap(ixt,i)*dtime
+             WRITE(*,*) 'xtsnow_evap(i)*dt=',xtsnow_evap(ixt,i)*dtime
+             WRITE(*,*) 'xtrun_off(i)=',xtrun_off(ixt,i)
+             WRITE(*,*) 'i=',i
+             WRITE(*,*) 'qsol(i)=',qsol(i)
+             WRITE(*,*) 'qsol_prec(i)=',qsol_prec(i)
+             WRITE(*,*) 'precip_rain(i)*dt=',precip_rain(i)*dtime
+             WRITE(*,*) 'fq_fonte_neige(i)=',fq_fonte_neige(i)
+             WRITE(*,*) 'evap(i)*dt=',evap(i)*dtime
+             WRITE(*,*) 'snow_evap(i)*dt=',snow_evap(i)*dtime
+             WRITE(*,*) 'run_off(i) (diag)=',run_off(i)
+             WRITE(*,*) 'runoff_tmp(i)=',runoff_tmp(i)
+             if (qsol_prec(i).gt.-ridicule) THEN
                  stop
                  ! sinon, si qsolprec<0, on fait compo du sol=compo des
@@ -15828,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
 
@@ -15851,5 +15705,5 @@
                  xtsnow,xtrun_off_lic_0, &
                  Rland_ice)
-      USE dimphy, only: klon,klev
+      USE dimphy, ONLY: klon,klev
       !USE lmdz_grid_phy
       !USE lmdz_phys_para
@@ -15860,5 +15714,5 @@
       !USE iostart, ONLY: close_startphy, get_field, get_var, open_startphy
       !USE lmdz_write_field_phy
-      USE indice_sol_mod, only: nbsrf  
+      USE indice_sol_mod, ONLY: nbsrf
   USE isotopes_mod, ONLY: initialisation_iso, iso_eau,iso_HDO, &
         ridicule_qsol,tnat, P_veg,iso_O18,ridicule, ridicule_snow,iso_O17, &
@@ -15895,8 +15749,8 @@
 !      character*50 text
 
-!      write(*,*) 'phyisoetat0 20: fichnom=',fichnom
-      write(*,*) 'initialisation_iso=',initialisation_iso
-
-      if (initialisation_iso.eq.0) then
+!      WRITE(*,*) 'phyisoetat0 20: fichnom=',fichnom
+      WRITE(*,*) 'initialisation_iso=',initialisation_iso
+
+      if (initialisation_iso.eq.0) THEN
           CALL phyiso_etat0_fichier( &
                  snow,run_off_lic_0, &
@@ -15904,6 +15758,6 @@
                  Rland_ice)
       else
-        write(*,*) 'phyisoetat0 57:'
-        write(*,*) 'initialisation_iso=',initialisation_iso
+        WRITE(*,*) 'phyisoetat0 57:'
+        WRITE(*,*) 'initialisation_iso=',initialisation_iso
 !          stop
           CALL phyiso_etat0_dur( &
@@ -15925,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')
@@ -15934,5 +15788,5 @@
          CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,i), &
                  run_off_lic_0(i), 'phyisoetat0 762')
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
          do k=1,klev
            do ixt=1,niso
@@ -15944,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')
@@ -15951,20 +15805,20 @@
              CALL iso_verif_egalite(xts_ancien(iso_eau,i,k), &
                  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
-!                write(*,*) 'i,k=',i,k
+           endif !if (iso_eau.gt.0) 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
+             endif !if (q_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
+             endif !if (q_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')
-             endif !if (q_ancien(i,k).gt.2e-3) then
-           endif !if (iso_HDO.gt.0) then
+             endif !if (q_ancien(i,k).gt.2e-3) THEN
+           endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC      
            CALL iso_verif_traceur(xt_ancien(1,i,k), &
@@ -15987,20 +15841,20 @@
                  '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')
             CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf), &
                          'phyisoetat0 75')
-          endif !if (iso_eau.gt.0) then
-          if (iso_HDO.gt.0) then
+          endif !if (iso_eau.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')
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
         enddo !do nsrf=1,nbsrf
       enddo !do i=1,klon
       do i=1,klon
-        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
+        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
+                 .gt.ridicule_qsol*tnat(iso_o18))) THEN
                 CALL iso_verif_aberrant_o17(xtsol(iso_O17,i) &
                  /qsol(i),xtsol(iso_O18,i) &
@@ -16013,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
@@ -16026,5 +15880,5 @@
                snow,run_off_lic_0)
 
-      USE dimphy, only: klon,klev
+      USE dimphy, ONLY: klon,klev
       !USE lmdz_grid_phy
       !USE lmdz_phys_para
@@ -16035,5 +15889,5 @@
       !USE iostart
       !USE lmdz_write_field_phy
-      USE indice_sol_mod, only: nbsrf
+      USE indice_sol_mod, ONLY: nbsrf
   USE isotopes_mod, ONLY: tnat,iso_HDO,iso_O18,iso_HTO, iso_eau,toce, &
 &       Rdefault,iso_O17,ridicule,ridicule_qsol
@@ -16084,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 &
@@ -16100,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.
@@ -16131,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)) &
@@ -16167,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')
@@ -16184,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)) &
@@ -16211,13 +16065,13 @@
                 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)
            xts_ancien(ixt,i,k)=qs_ancien(i,k)*alpha(ixt) &
                  *xt_ancien(ixt,i,k)/q_ancien(i,k)
-           else !if (q_ancien(i,k).gt.ridicule) then
+           else !if (q_ancien(i,k).gt.ridicule) THEN
              xtl_ancien(ixt,i,k)=ql_ancien(i,k)*Rdefault(ixt)
              xts_ancien(ixt,i,k)=qs_ancien(i,k)*Rdefault(ixt)
-           endif !if (q_ancien(i,k).gt.ridicule) then
+           endif !if (q_ancien(i,k).gt.ridicule) THEN
           enddo !do ixt=1,niso
 
@@ -16233,22 +16087,21 @@
 
         ! Camille 7 mars 2023: ajout d'un check
-        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 ((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( &
                     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
-                  write(*,*) 'phyisoetat0 16367: i,k,q_ancien(i,k)=',i,k,q_ancien(i,k) 
-                  write(*,*) 'xt_ancien(:,i,k)=',xt_ancien(:,i,k)
+                    '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)
                   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 (q_seri(i,k).gt.errmax) THEN
+        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
 #endif 
 
@@ -16256,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)
@@ -16273,17 +16126,17 @@
        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) &
                  *wake_deltaq(i,k)
           enddo !do ixt=1,niso
-        else !if (q_ancien(i,k).gt.ridicule) then
+        else !if (q_ancien(i,k).gt.ridicule) THEN
           do ixt=1,niso
            wake_deltaxt(ixt,i,k)=Rdefault(ixt)*wake_deltaq(i,k)
           enddo !do ixt=1,niso
-        endif !if (q_ancien(i,k).gt.ridicule) then
+        endif !if (q_ancien(i,k).gt.ridicule) THEN
 #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
@@ -16310,5 +16163,5 @@
 
 #ifdef ISOVERIF
-      write(*,*) 'phyisoetat0 16468: verif init dure'
+      WRITE(*,*) 'phyisoetat0 16468: verif init dure'
       do i=1,klon
          do ixt=1,niso
@@ -16320,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')
@@ -16331,8 +16184,8 @@
          CALL iso_verif_egalite(Rland_ice(iso_eau,i), &
                  1.0, 'phyiso_etat0_dur 763')
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
          do k=1,klev
            do ixt=1,niso
-!              write(*,*) 'ixt,i,k=',ixt,i,k
+!              WRITE(*,*) 'ixt,i,k=',ixt,i,k
               CALL iso_verif_noNAN(xt_ancien(ixt,i,k), &
                  'phyiso_etat0_dur 771')
@@ -16340,23 +16193,23 @@
                  '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
+           endif !if (iso_eau.gt.0) 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), &
                 'phyiso_etat0_dur 775b')
-             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
+             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
                 CALL iso_verif_O18_aberrant( &
                     xt_ancien(iso_hdo,i,k)/q_ancien(i,k), &
                     xt_ancien(iso_O18,i,k)/q_ancien(i,k), &
                     '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 (q_ancien(i,k).gt.ridicule) THEN
+           endif ! if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
          enddo !do k=1,klev
          do nsrf=1,nbsrf
@@ -16367,14 +16220,14 @@
                  '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')
              CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf), &
                        'phyiso_etat0_dur 789')
-             endif !if (iso_eau.gt.0) then 
+             endif !if (iso_eau.gt.0) THEN
          enddo !do nsrf=1,nbsrf
-         if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
+         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
+                 .gt.ridicule_qsol*tnat(iso_o18))) THEN
                 CALL iso_verif_aberrant_o17(xtsol(iso_O17,i) &
                  /qsol(i),xtsol(iso_O18,i) &
@@ -16453,8 +16306,8 @@
       i = INDEX(outiso, '_', .TRUE.)
       oldIso2 = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso)) ! CR 2023: on ajoute cette possibilité aussi, elle correspond au cas le plus récent.
-!      write(*,*) 'tmp 16541:'
-!      write(*,*) 'outiso=',outiso
-!      write(*,*) 'oldIso=',oldIso
-!      write(*,*) 'oldIso2=',oldIso2
+!      WRITE(*,*) 'tmp 16541:'
+!      WRITE(*,*) 'outiso=',outiso
+!      WRITE(*,*) 'oldIso=',oldIso
+!      WRITE(*,*) 'oldIso2=',oldIso2
 
       ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après fichier:
@@ -16625,7 +16478,7 @@
                  d_xt_decroiss, &
                  xt_seri)
-        USE isotopes_mod, only: iso_HTO,ok_prod_nucl_tritium
-        USE dimphy, only: klon,klev
-        USE lmdz_geometry, only: latitude_deg,longitude_deg, & ! en degré, remplace rlat et rlon
+        USE isotopes_mod, ONLY: iso_HTO,ok_prod_nucl_tritium
+        USE dimphy, ONLY: klon,klev
+        USE lmdz_geometry, ONLY: latitude_deg,longitude_deg, & ! en degré, remplace rlat et rlon
                    latitude,longitude ! en radian, remplace rlatd et rlond
         USE lmdz_yomcst
@@ -16707,6 +16560,6 @@
 !#ifdef ISOVERIF
 !      do kb=1,nlev_prod
-!      write(*,*) 'iso_tritium 103'
-!      write(*,*) 'kb, p_ref', kb, p_ref(kb)
+!      WRITE(*,*) 'iso_tritium 103'
+!      WRITE(*,*) 'kb, p_ref', kb, p_ref(kb)
 !      enddo
 !#endif
@@ -16749,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
                    
@@ -16778,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
                    
@@ -16804,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
            
@@ -16830,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
            
@@ -16856,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
            
@@ -16885,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
            
@@ -16914,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
            
@@ -16943,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
            
@@ -16972,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
            
@@ -17001,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
            
@@ -17027,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
            
@@ -17053,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
            
@@ -17079,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
            
@@ -17108,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
            
@@ -17137,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
            
@@ -17166,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
            
@@ -17195,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
            
@@ -17224,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
            
@@ -17253,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
            
@@ -17282,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
            
@@ -17308,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
            
@@ -17337,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
            
@@ -17366,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
            
@@ -17395,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
            
@@ -17424,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
            
@@ -17453,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
            
@@ -17482,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
            
@@ -17511,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
            
@@ -17540,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
            
@@ -17569,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
            
@@ -17598,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
            
@@ -17627,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
            
@@ -17656,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
            
@@ -17685,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
            
@@ -17714,13 +17567,13 @@
        
 !#ifdef ISOVERIF
-!          if (k.eq.klev) then
-!          write(*,*) 'iso_tritium 1096'
-!          write(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
-!          write(*,*) 'rlat,rlatd=',rlat(i),rlatd(i)
-!          write(*,*) 'rlon,rlond=',rlon(i),rlond(i)
-!          write(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
-!          write(*,*) 'pplay(i,k)=',pplay(i,k)
-!          write(*,*) 'k_ref=',k_ref
-!          write(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
+!          if (k.eq.klev) THEN
+!          WRITE(*,*) 'iso_tritium 1096'
+!          WRITE(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
+!          WRITE(*,*) 'rlat,rlatd=',rlat(i),rlatd(i)
+!          WRITE(*,*) 'rlon,rlond=',rlon(i),rlond(i)
+!          WRITE(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
+!          WRITE(*,*) 'pplay(i,k)=',pplay(i,k)
+!          WRITE(*,*) 'k_ref=',k_ref
+!          WRITE(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
 !          endif
 !#endif
@@ -17729,11 +17582,11 @@
 #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
-          write(*,*) 'i,k,klev=',i,k,klev
-          write(*,*) 'latitude_deg,latitude=',latitude_deg(i),latitude(i)
-          write(*,*) 'longitude_deg,longitude=',longitude_deg(i),longitude(i)
-          write(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
-          write(*,*) 'pplay(i,k)=',pplay(i,k)
-          write(*,*) 'kb,k_ref, p_ref=',kb,k_ref,p_ref(kb)
+            '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)
+          WRITE(*,*) 'longitude_deg,longitude=',longitude_deg(i),longitude(i)
+          WRITE(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
+          WRITE(*,*) 'pplay(i,k)=',pplay(i,k)
+          WRITE(*,*) 'kb,k_ref, p_ref=',kb,k_ref,p_ref(kb)
           stop
           endif
@@ -17751,17 +17604,17 @@
          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
-               write(*,*) 'prod cosmo nulle iso_tritium 1134'
-               write(*,*) 'ixt,i,k',ixt,i,k
-               write(*,*) 'masse_tritium', masse_tritium
+         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
+               WRITE(*,*) 'masse_tritium', masse_tritium
                stop
             endif
-!            if ((k.eq.klev).and.(ixt.eq.iso_HTO)) then
-!               write(*,*) 'iso_tritium 1140'
-!               write(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
-!               write(*,*) 'pplay(i,k)=',pplay(i,k)
-!               write(*,*) 'masse_tritium', masse_tritium
-!               write(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
+!            if ((k.eq.klev).and.(ixt.eq.iso_HTO)) THEN
+!               WRITE(*,*) 'iso_tritium 1140'
+!               WRITE(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
+!               WRITE(*,*) 'pplay(i,k)=',pplay(i,k)
+!               WRITE(*,*) 'masse_tritium', masse_tritium
+!               WRITE(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
 !            endif
          endif
@@ -17777,12 +17630,12 @@
           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
-          write(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
-          write(*,*) 'latitude_deg,latitude=',latitude_deg(i),latitude(i)
-          write(*,*) 'longitude_deg,longitude=',longitude_deg(i),longitude(i)
-          write(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
-          write(*,*) 'pplay(i,k)=',pplay(i,k)
-          write(*,*) 'kb,k_ref, p_ref=',kb,k_ref,p_ref(kb)
-          write(*,*) 'masse tritium=', masse_tritium
+               '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)
+          WRITE(*,*) 'longitude_deg,longitude=',longitude_deg(i),longitude(i)
+          WRITE(*,*) 'rlat_geo(i), lat_geo=',rlat_geo(i),lat_geo
+          WRITE(*,*) 'pplay(i,k)=',pplay(i,k)
+          WRITE(*,*) 'kb,k_ref, p_ref=',kb,k_ref,p_ref(kb)
+          WRITE(*,*) 'masse tritium=', masse_tritium
           stop
             endif
@@ -17809,6 +17662,6 @@
              ! on verifie si la date dans la simulation est un jour d'essai nucleaire 
              CALL date_prod_nucl_HTO(j_1ere_bombe, nbombe)
-           write(*,*) 'iso_tritium 1183, apres CALL date_prod_nucl_HTO'
-           write(*,*) 'j_1ere_bombe, nbombe', j_1ere_bombe, nbombe
+           WRITE(*,*) 'iso_tritium 1183, apres CALL date_prod_nucl_HTO'
+           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
@@ -17829,10 +17682,10 @@
          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'
-            write(*,*) 'ixt, i, k', ixt, i, k
-            write(*,*) 'd_xt_prod_nucl', d_xt_prod_nucl(ixt,i,k)
+            (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'
+            WRITE(*,*) 'ixt, i, k', ixt, i, k
+            WRITE(*,*) 'd_xt_prod_nucl', d_xt_prod_nucl(ixt,i,k)
             stop
             endif
@@ -17848,6 +17701,6 @@
           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
-          write(*,*) 'ixt,i,k,latitude_deg(i)',ixt,i,k,latitude_deg(i)
+               'iso_tritium prod nucl 1225').eq.1) THEN
+          WRITE(*,*) 'ixt,i,k,latitude_deg(i)',ixt,i,k,latitude_deg(i)
           stop
             endif
@@ -17867,6 +17720,6 @@
 ! ------------------------------------------------------------------------
 #ifdef ISOTRAC
-        if (iso_HTO.gt.0) then
-        write(*,*) 'cas pas prevu, a coder'
+        if (iso_HTO.gt.0) THEN
+        WRITE(*,*) 'cas pas prevu, a coder'
         ! utiliser index_iso au lieu de ixt dans la condition ci dessous
         ! et vérifier ailleurs
@@ -17906,10 +17759,10 @@
 !#ifdef ISOVERIF
 !      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
-!         write(*,*) 'rlat,rlon=',rlat(i),rlon(i)
-!         write(*,*) 'dtime=', dtime
-!         write(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
-!         write(*,*) 'd_xt_prod_nucl(ixt,i,k)=',d_xt_prod_nucl(ixt,i,k)
+!         WRITE(*,*) 'iso_tritium 1284 - test concentration totale'
+!         WRITE(*,*) 'ixt,i,k,klev=',ixt,i,k,klev
+!         WRITE(*,*) 'rlat,rlon=',rlat(i),rlon(i)
+!         WRITE(*,*) 'dtime=', dtime
+!         WRITE(*,*) 'd_xt_cosmo(ixt,i,k)=',d_xt_cosmo(ixt,i,k)
+!         WRITE(*,*) 'd_xt_prod_nucl(ixt,i,k)=',d_xt_prod_nucl(ixt,i,k)
 !      endif
 !#endif
@@ -17965,6 +17818,5 @@
 
 
-      if (ok_prod_nucl_tritium) then
-
+      if (ok_prod_nucl_tritium) THEN
       ! tableau pour day_nucl
       open(30, file='day_nucl.txt')
@@ -18079,5 +17931,5 @@
 
       use phys_cal_mod ! pour le calendrier
-      use isotopes_mod, only: nessai, day_nucl, month_nucl, year_nucl
+      use isotopes_mod, ONLY: nessai, day_nucl, month_nucl, year_nucl
       IMPLICIT NONE
 
@@ -18092,12 +17944,12 @@
       nbombe=0
       j_1ere_bombe=0
-      write(*,*) 'iso_tritium 1456, SUBROUTINE date_prod_nucl_HTO'
-      write(*,*) 'Date dans la simulation:',day_cur,mth_cur,year_cur
+      WRITE(*,*) 'iso_tritium 1456, SUBROUTINE date_prod_nucl_HTO'
+      WRITE(*,*) 'Date dans la simulation:',day_cur,mth_cur,year_cur
 
       do j=1,nessai ! il faut que le tableau d'entree soit dans l'ordre chronologique
-         if (nbombe.eq.0) 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
+                (year_cur.eq.year_nucl(j))) THEN
             nbombe=1
             j_1ere_bombe=j
@@ -18106,5 +17958,5 @@
             if ((day_cur.eq.day_nucl(j)).and. &
                (mth_cur.eq.month_nucl(j)).and. &
-               (year_cur.eq.year_nucl(j))) then
+               (year_cur.eq.year_nucl(j))) THEN
                nbombe=nbombe+1
             else
@@ -18113,9 +17965,9 @@
          endif
 !#ifdef ISOVERIF
-!      write(*,*) 'controle SUBROUTINE date_prod_nucl_HTO' !ok
-!      write(*,*) 'day_cur, mth_cur, year_cur',day_cur,mth_cur,year_cur
-!      write(*,*) 'j, nessai', j, nessai
-!      write(*,*) 'nbombe,  j_1ere_bombe', nbombe, j_1ere_bombe
-!      write(*,*) 'day_nucl(j), month_nucl(j), year_nucl(j)',
+!      WRITE(*,*) 'controle SUBROUTINE date_prod_nucl_HTO' !ok
+!      WRITE(*,*) 'day_cur, mth_cur, year_cur',day_cur,mth_cur,year_cur
+!      WRITE(*,*) 'j, nessai', j, nessai
+!      WRITE(*,*) 'nbombe,  j_1ere_bombe', nbombe, j_1ere_bombe
+!      WRITE(*,*) 'day_nucl(j), month_nucl(j), year_nucl(j)',
 !     :            day_nucl(j), month_nucl(j), year_nucl(j)
 !#endif
@@ -18145,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 dimphy, ONLY: klon,klev
+        use lmdz_geometry, ONLY: latitude_deg,longitude_deg
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -18183,10 +18035,10 @@
          P_HTO = HTO_nucl(jessai)
 !#ifdef ISOVERIF !ok
-!      write(*,*) 'controle SUBROUTINE lancer_bombes'
-!      write(*,*) 'ibombe, nbombe', ibombe, nbombe
-!      write(*,*) 'jessai, j_1ere_bombe', jessai, j_1ere_bombe
-!      write(*,*) 'lat_HTO, lon_HTO', lat_HTO, lon_HTO
-!      write(*,*) 'zmin_HTO, zmax_HTO', zmin_HTO, zmax_HTO
-!      write(*,*) 'P_HTO', P_HTO 
+!      WRITE(*,*) 'controle SUBROUTINE lancer_bombes'
+!      WRITE(*,*) 'ibombe, nbombe', ibombe, nbombe
+!      WRITE(*,*) 'jessai, j_1ere_bombe', jessai, j_1ere_bombe
+!      WRITE(*,*) 'lat_HTO, lon_HTO', lat_HTO, lon_HTO
+!      WRITE(*,*) 'zmin_HTO, zmax_HTO', zmin_HTO, zmax_HTO
+!      WRITE(*,*) 'P_HTO', P_HTO
 !#endif
          
@@ -18198,11 +18050,11 @@
             
          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'
-       write(*,*) 'ibombe, nbombe', ibombe, nbombe
-       write(*,*) 'coord_HTO',coord_HTO
-       write(*,*) 'latitude_deg(coord_HTO), longitude_deg(coord_HTO)', & 
+       WRITE(*,*) 'iso_tritium 1552 dans SUBROUTINE lancer_bombes'
+       WRITE(*,*) 'Apres CALL coord_prod_nucl_HTO pour coord_HTO>0'
+       WRITE(*,*) 'ibombe, nbombe', ibombe, nbombe
+       WRITE(*,*) 'coord_HTO',coord_HTO
+       WRITE(*,*) 'latitude_deg(coord_HTO), longitude_deg(coord_HTO)', &
                    latitude_deg(coord_HTO), longitude_deg(coord_HTO)
-       write(*,*) 'kmin_HTO, kmax_HTO', kmin_HTO, kmax_HTO
+       WRITE(*,*) 'kmin_HTO, kmax_HTO', kmin_HTO, kmax_HTO
 
          CALL calcul_prod_nucl_HTO(P_HTO,coord_HTO, &
@@ -18224,6 +18076,6 @@
                                      coord_jessai,&
                                      kmin_jessai,kmax_jessai)
-        USE dimphy, only: klon,klev
-        use lmdz_geometry, only: latitude_deg,longitude_deg
+        USE dimphy, ONLY: klon,klev
+        use lmdz_geometry, ONLY: latitude_deg,longitude_deg
         USE lmdz_yomcst
 #ifdef ISOVERIF
@@ -18265,7 +18117,7 @@
 !       do i=1,klon
 !       do k=1,klev
-!          write(*,*) 'i,k,RG',i,k,RG
-!          write(*,*) 'zphi', zphi(i,k)
-!          write(*,*) 'alt', alt(i,k)
+!          WRITE(*,*) 'i,k,RG',i,k,RG
+!          WRITE(*,*) 'zphi', zphi(i,k)
+!          WRITE(*,*) 'alt', alt(i,k)
 !       enddo
 !       enddo
@@ -18275,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
@@ -18294,5 +18146,5 @@
              ((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
+             ((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
@@ -18302,10 +18154,10 @@
                 do k=1,klev-1
                     if ((alt(i,k).lt.zmin_jessai).and. &
-                        (alt(i,k+1).ge.zmin_jessai)) then
+                        (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. &
-                        (alt(i,k+1).ge.zmax_jessai)) then
+                        (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
                     endif
@@ -18317,18 +18169,18 @@
 #ifdef ISOVERIF
       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
-         write(*,*) 'lon_nucl, lat_nucl', lon_jessai, lat_jessai
-         write(*,*) 'zmin_nucl, zmax_nucl', zmin_jessai, zmax_jessai
-         write(*,*) 'kmin,kmax',kmin_jessai,kmax_jessai
+         WRITE(*,*) 'Pb SUBROUTINE coord_prod_nucl_HTO(kmin>kmax)'
+         WRITE(*,*) 'coord_jessai', coord_jessai
+         WRITE(*,*) 'lon_nucl, lat_nucl', lon_jessai, lat_jessai
+         WRITE(*,*) 'zmin_nucl, zmax_nucl', zmin_jessai, zmax_jessai
+         WRITE(*,*) 'kmin,kmax',kmin_jessai,kmax_jessai
          stop
        endif
 
       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
-         write(*,*) 'lon_nucl, lat_nucl', lon_jessai, lat_jessai
-         write(*,*) 'zmin_nucl, zmax_nucl', zmin_jessai, zmax_jessai
-         write(*,*) 'kmin,kmax',kmin_jessai,kmax_jessai
+         WRITE(*,*) 'Pb SUBROUTINE coord_prod_nucl_HTO(kmin=klev)'
+         WRITE(*,*) 'coord_jessai', coord_jessai
+         WRITE(*,*) 'lon_nucl, lat_nucl', lon_jessai, lat_jessai
+         WRITE(*,*) 'zmin_nucl, zmax_nucl', zmin_jessai, zmax_jessai
+         WRITE(*,*) 'kmin,kmax',kmin_jessai,kmax_jessai
          stop
       endif
@@ -18336,15 +18188,15 @@
 
 !#ifdef ISOVERIF 
-!      write(*,*) 'controle SUBROUTINE coord_prod_nucl_HTO' !ok
-!      write(*,*) 'iim,jjm,dlat,dlon',iim,jjm,dlat,dlon
-!      write(*,*) 'indice coord_HTO', coord_jessai
-!      write(*,*) 'latitude_deg, lat_HTO',latitude_deg(coord_jessai),lat_jessai
-!      write(*,*) 'longitude_deg, lon_HTO',longitude_deg(coord_jessai),lon_jessai
-!      write(*,*) 'kmin_HTO, kmax_HTO', kmin_jessai, kmax_jessai
-!      write(*,*) 'alt_min(k), alt_min(k+1), zmin_HTO', 
+!      WRITE(*,*) 'controle SUBROUTINE coord_prod_nucl_HTO' !ok
+!      WRITE(*,*) 'iim,jjm,dlat,dlon',iim,jjm,dlat,dlon
+!      WRITE(*,*) 'indice coord_HTO', coord_jessai
+!      WRITE(*,*) 'latitude_deg, lat_HTO',latitude_deg(coord_jessai),lat_jessai
+!      WRITE(*,*) 'longitude_deg, lon_HTO',longitude_deg(coord_jessai),lon_jessai
+!      WRITE(*,*) 'kmin_HTO, kmax_HTO', kmin_jessai, kmax_jessai
+!      WRITE(*,*) 'alt_min(k), alt_min(k+1), zmin_HTO',
 !     :            alt(coord_jessai,kmin_jessai),
 !     :            alt(coord_jessai,kmin_jessai+1),
 !     :            zmin_jessai
-!      write(*,*) 'alt_max(k), alt_max(k+1), zmax_HTO',
+!      WRITE(*,*) 'alt_max(k), alt_max(k+1), zmax_HTO',
 !     :            alt(coord_jessai,kmax_jessai),
 !     :            alt(coord_jessai,kmax_jessai+1),
@@ -18366,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
@@ -18397,7 +18249,7 @@
       enddo
 !#ifdef ISOVERIF
-!      write(*,*) 'ixt,j,coord_HTO',ixt,j,coord_jessai !ok
-!      write(*,*) 'kmin_HTO, kmax_HTO', kmin_jessai, kmax_jessai
-!      write(*,*) 'day_sec, P_HTO', day_sec, P_jessai
+!      WRITE(*,*) 'ixt,j,coord_HTO',ixt,j,coord_jessai !ok
+!      WRITE(*,*) 'kmin_HTO, kmax_HTO', kmin_jessai, kmax_jessai
+!      WRITE(*,*) 'day_sec, P_HTO', day_sec, P_jessai
 !#endif
 
@@ -18410,26 +18262,26 @@
               prod_nucl(ixt,j,k)=prod_nucl(ixt,j,k)+prod_nucl_tmp(j,k)
 #ifdef ISOVERIF
-       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'
-       write(*,*) 'kmin_HTO,kmax_HTO',kmin_jessai,kmax_jessai
-       write(*,*) 'ixt,i,k',ixt,j,k
-       write(*,*) 'coord_HTO', coord_jessai
+       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'
+       WRITE(*,*) 'kmin_HTO,kmax_HTO',kmin_jessai,kmax_jessai
+       WRITE(*,*) 'ixt,i,k',ixt,j,k
+       WRITE(*,*) 'coord_HTO', coord_jessai
        stop
        endif
 
        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)'
-       write(*,*) 'prod_nucl_tmp(i,k) ou d_xt_prod_nucl devraient etre positifs'
-       write(*,*) 'ixt,i,k',ixt,j,k
-       write(*,*) 'RG, cell_area=', RG, cell_area(j)
-       write(*,*) 'coord_HTO,kmin_HTO,kmax_HTO', &
+            (prod_nucl(ixt,j,k).le.0.)) THEN
+       WRITE(*,*) 'Pb SUBROUTINE calcul_prod_nucl_HTO(k<klev)'
+       WRITE(*,*) 'prod_nucl_tmp(i,k) ou d_xt_prod_nucl devraient etre positifs'
+       WRITE(*,*) 'ixt,i,k',ixt,j,k
+       WRITE(*,*) 'RG, cell_area=', RG, cell_area(j)
+       WRITE(*,*) 'coord_HTO,kmin_HTO,kmax_HTO', &
                      coord_jessai,kmin_jessai,kmax_jessai
-       write(*,*) 'P_HTO, day_sec', P_jessai, day_sec
-       write(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax)', &
+       WRITE(*,*) 'P_HTO, day_sec', P_jessai, day_sec
+       WRITE(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax)', &
                      paprs(j,kmin_jessai), paprs(j,kmax_jessai)
-       write(*,*) 'prod_nucl_tmp(i,k)', prod_nucl_tmp(j,k)
-       write(*,*) 'd_xt_prod_nucl(ixt,i,k)',prod_nucl(ixt,j,k)
+       WRITE(*,*) 'prod_nucl_tmp(i,k)', prod_nucl_tmp(j,k)
+       WRITE(*,*) 'd_xt_prod_nucl(ixt,i,k)',prod_nucl(ixt,j,k)
        stop
        endif
@@ -18445,26 +18297,26 @@
 #ifdef ISOVERIF
        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'
-       write(*,*) 'kmin_HTO,kmax_HTO',kmin_jessai,kmax_jessai
-       write(*,*) 'ixt,i,k',ixt,j,k
-       write(*,*) 'coord_HTO', coord_jessai
+           (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'
+       WRITE(*,*) 'kmin_HTO,kmax_HTO',kmin_jessai,kmax_jessai
+       WRITE(*,*) 'ixt,i,k',ixt,j,k
+       WRITE(*,*) 'coord_HTO', coord_jessai
        stop
        endif
 
        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)'
-       write(*,*) 'prod_nucl_tmp(i,k) ou d_xt_prod_nucl devraient etre positifs'
-       write(*,*) 'ixt,i,k',ixt,j,k
-       write(*,*) 'RG, cell_area(i)', RG, cell_area(j)
-       write(*,*) 'coord_HTO,kmin_HTO,kmax_HTO', &
+           (prod_nucl(ixt,j,k).le.0.)) THEN
+       WRITE(*,*) 'Pb SUBROUTINE calcul_prod_nucl_HTO(k=klev)'
+       WRITE(*,*) 'prod_nucl_tmp(i,k) ou d_xt_prod_nucl devraient etre positifs'
+       WRITE(*,*) 'ixt,i,k',ixt,j,k
+       WRITE(*,*) 'RG, cell_area(i)', RG, cell_area(j)
+       WRITE(*,*) 'coord_HTO,kmin_HTO,kmax_HTO', &
                      coord_jessai,kmin_jessai,kmax_jessai
-       write(*,*) 'P_HTO, day_sec', P_jessai, day_sec
-       write(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax+1)', &
+       WRITE(*,*) 'P_HTO, day_sec', P_jessai, day_sec
+       WRITE(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax+1)', &
                      paprs(j,kmin_jessai), paprs(j,kmax_jessai+1)
-       write(*,*) 'prod_nucl_tmp(i,k)', prod_nucl_tmp(j,k)
-       write(*,*) 'd_xt_prod_nucl(ixt,i,k)',prod_nucl(ixt,j,k)
+       WRITE(*,*) 'prod_nucl_tmp(i,k)', prod_nucl_tmp(j,k)
+       WRITE(*,*) 'd_xt_prod_nucl(ixt,i,k)',prod_nucl(ixt,j,k)
        stop
        endif
@@ -18476,16 +18328,16 @@
 !      do i=1,klon
 !      do k=1,klev
-!         write(*,*) 'controle calcul_prod_nucl_HTO' !ok
-!         write(*,*) 'CALL if ok_prod_nucl_tritium, iso_HTO, nbombe>=1'
-!         write(*,*) 'klon, klev', klon, klev
-!         write(*,*) 'ixt, i, k', ixt, i, k
-!         write(*,*) 'RG, cell_area(i)', RG, cell_area(i)
-!         write(*,*) 'coord_HTO,kmin_HTO,kmax_HTO',
+!         WRITE(*,*) 'controle calcul_prod_nucl_HTO' !ok
+!         WRITE(*,*) 'CALL if ok_prod_nucl_tritium, iso_HTO, nbombe>=1'
+!         WRITE(*,*) 'klon, klev', klon, klev
+!         WRITE(*,*) 'ixt, i, k', ixt, i, k
+!         WRITE(*,*) 'RG, cell_area(i)', RG, cell_area(i)
+!         WRITE(*,*) 'coord_HTO,kmin_HTO,kmax_HTO',
 !     :               coord_jessai,kmin_jessai,kmax_jessai
-!         write(*,*) 'P_HTO, day_sec', P_jessai, day_sec
-!         write(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax)',
+!         WRITE(*,*) 'P_HTO, day_sec', P_jessai, day_sec
+!         WRITE(*,*) 'paprs(coord_HTO,kmin),paprs(coord_HTO,kmax)',
 !     :               paprs(coord_jessai,kmin_jessai), 
 !     :               paprs(coord_jessai,kmax_jessai)
-!         write(*,*) 'd_xt_prod_nucl(ixt,i,k)', prod_nucl(ixt,i,k)
+!         WRITE(*,*) 'd_xt_prod_nucl(ixt,i,k)', prod_nucl(ixt,i,k)
 !      enddo
 !      enddo
@@ -18512,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
@@ -18539,19 +18391,19 @@
 
         ! 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
                 zxtice(ixt)=0
               enddo
-              return
+              RETURN
             else
                 ! c'est impossible de condenser qi pas d'eau au départ
-                write(*,*) 'condiso_liq_ice_vectiso_trac 35'
-                write(*,*) 'qt=',qt
-                write(*,*) 'cond=',cond
+                WRITE(*,*) 'condiso_liq_ice_vectiso_trac 35'
+                WRITE(*,*) 'qt=',qt
+                WRITE(*,*) 'cond=',cond
                 stop
             endif
-        endif !if (qt.eq.0) then
+        endif !if (qt.eq.0) THEN
         zcond=max(0.0,min(cond,qt))
 
@@ -18574,5 +18426,5 @@
           CALL condiso_liq_ice_vectiso(xttrac,qttrac,zcondtrac, &
                  tcond,zfice,zxticetrac,zxtliqtrac)
-!          write(*,*) 'zxticetrac=',zxticetrac
+!          WRITE(*,*) 'zxticetrac=',zxticetrac
           do iiso=1,niso          
             zxtice(index_trac(izone,iiso))=zxticetrac(iiso)
@@ -18580,29 +18432,29 @@
           enddo
 #ifdef ISOVERIF  
-        if (iso_HDO.gt.0) then 
-              if (zcondtrac.gt.ridicule) 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
-                  write(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
+                   /faccond,'condiso_trac 79').eq.1) THEN
+                  WRITE(*,*) 'izone=',izone
+                  WRITE(*,*) 'zcondtrac/qttrac=',cond/qt
+                  WRITE(*,*) 'deltaD(xt(iso_HDO)/qt)=', &
                                  deltaD(xttrac(iso_HDO)/qttrac)
-                  write(*,*) 'tcond=',tcond-273,'°C' 
-                  if (tcond-273.gt.-40.0) then
+                  WRITE(*,*) 'tcond=',tcond-273,'°C'
+                  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
                      stop
-                  endif !if (tcond(i).gt.100.0) then
+                  endif !if (tcond(i).gt.100.0) THEN
                   endif
-                endif !if (cond.gt.ridicule) then 
-            endif !if (iso_HDO.gt.0) then
+                endif !if (cond.gt.ridicule) THEN
+            endif !if (iso_HDO.gt.0) THEN
 #endif          
         enddo ! do izone=1,ntraceurs_zone 
 
 #ifdef ISOVERIF      
-!        write(*,*) 'zxtice=',zxtice  
-!        write(*,*) 'zcond=',zcond
-!        write(*,*) 'xt=',xt
-!        write(*,*) 'qt=',qt
+!        WRITE(*,*) 'zxtice=',zxtice
+!        WRITE(*,*) 'zcond=',zcond
+!        WRITE(*,*) 'xt=',xt
+!        WRITE(*,*) 'qt=',qt
         CALL iso_verif_traceur(zxtliq(1), &
                 'condiso_liq_ice_vectiso_trac 194')
@@ -18612,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), &
@@ -18640,6 +18492,6 @@
     USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,bidouille_anti_divergence, &
 &       ridicule
-!    USE isotopes_routines_mod, only: condiso_liq_ice_vectall
-    use isotrac_mod, only: index_iso, index_zone,option_traceurs,izone_cond, &
+!    USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall
+    use isotrac_mod, ONLY: index_iso, index_zone,option_traceurs,izone_cond, &
 &        ridicule_trac
 #ifdef ISOVERIF
@@ -18674,24 +18526,24 @@
 
 !#ifdef ISOVERIF
-!        write(*,*) 'condisotrac 112: entrée, n=',n
+!        WRITE(*,*) 'condisotrac 112: entrée, n=',n
 !#endif
 
 !        ! verif qt pas nul
 !        do i=1,n
-!          if (qt(i).eq.0) then
-!            if (cond(i).lt.ridicule) then
+!          if (qt(i).eq.0) THEN
+!            if (cond(i).lt.ridicule) THEN
 !              do ixt=1,ntraciso  
 !                zxtliq(ixt,i)=0
 !                zxtice(ixt,i)=0
 !              enddo
-!              return
+!              RETURN
 !            else
 !                ! c'est impossible de condenser qi pas d'eau au départ
-!                write(*,*) 'condiso_liq_ice_vectall_trac 119'
-!                write(*,*) 'qt=',qt(i)
-!                write(*,*) 'cond=',cond(i)
+!                WRITE(*,*) 'condiso_liq_ice_vectall_trac 119'
+!                WRITE(*,*) 'qt=',qt(i)
+!                WRITE(*,*) 'cond=',cond(i)
 !                stop
 !            endif
-!          endif !if (qt(i).eq.0) then
+!          endif !if (qt(i).eq.0) THEN
 !        enddo !do i=1,n
 
@@ -18714,12 +18566,12 @@
             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).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          
@@ -18727,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, &
@@ -18744,5 +18596,5 @@
           enddo !do i=1,n
 #ifdef ISOVERIF          
-!          write(*,*) 'condisotrac 164: avant condiso, izone=',izone
+!          WRITE(*,*) 'condisotrac 164: avant condiso, izone=',izone
 #endif           
           CALL condiso_liq_ice_vectall(xttrac,qttrac,zcondtrac, &
@@ -18756,7 +18608,7 @@
           enddo !do i=1,n
         enddo !do izone=1,ntraceurs_zone
-!        write(*,*) 'zxtice(1:ntraciso,2)=',
+!        WRITE(*,*) 'zxtice(1:ntraciso,2)=',
 !     :           zxtice(1:ntraciso,2)
-!        write(*,*) 'zxtliq(1:ntraciso,2)=',
+!        WRITE(*,*) 'zxtliq(1:ntraciso,2)=',
 !     :           zxtliq(1:ntraciso,2)
 
@@ -18798,5 +18650,5 @@
 
         ! 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
@@ -18810,14 +18662,14 @@
 #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
-                    write(*,*) 'xt,q=',xt,q
-                    write(*,*) 'alpha=',alpha
-                    write(*,*) 'toce,kcin,h0=',toce,kcin,h0
-                    write(*,*) 'RMerlivat=',RMerlivat
+        if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) THEN
+            if (q.gt.ridicule) THEN
+                    WRITE(*,*) 'xt,q=',xt,q
+                    WRITE(*,*) 'alpha=',alpha
+                    WRITE(*,*) 'toce,kcin,h0=',toce,kcin,h0
+                    WRITE(*,*) 'RMerlivat=',RMerlivat
                 CALL iso_verif_aberrant_encadre( xt/q, 'isotopes_routines_mod 18930b: iso_init_ideal')
             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
@@ -18835,5 +18687,5 @@
 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
@@ -18858,11 +18710,11 @@
 
      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)
              xtevap(ixt,il,i)= xtwdtrain(ixt,il)/wdtrain(il)*evap(il,i)
             enddo
-          else !if (wdtrain(il).gt.0.) then
+          else !if (wdtrain(il).gt.0.) THEN
             do ixt=1,niso
              xtwater(ixt,il,i)= Rdefault(ixt)*water(il,i)
@@ -18871,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)
@@ -18880,5 +18732,5 @@
             enddo ! do ixt=1+niso,ntraciso
 #endif 
-         endif !if (wdtrain(il).gt.0.) then
+         endif !if (wdtrain(il).gt.0.) THEN
          do ixt=1,ntraciso
              xtp(ixt,il,i)= xt(ixt,il,i)/rr(il,i)*rpprec(il,i)
@@ -18903,5 +18755,5 @@
 
 ! locals
-integer :: i,k,ixt
+INTEGER :: i,k,ixt
 
 DO k=1,klev
@@ -18917,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
@@ -18943,5 +18795,5 @@
 
 ! locals
-integer :: i,k,ixt
+INTEGER :: i,k,ixt
 
 DO k=1,klev
@@ -18955,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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_verif_mod.F90	(revision 5116)
@@ -97,5 +97,5 @@
         IMPLICIT NONE
 
-        write(*,*) 'iso_verif_init 99: entree'
+        WRITE(*,*) 'iso_verif_init 99: entree'
         deltalim=300.0
         deltalim_snow=500.0
@@ -113,6 +113,6 @@
 CALL getin_p('deltalimtrac',deltalimtrac)
 
-write(*,*) 'iso_O17,iso_O18,iso_HDO=',iso_O17,iso_O18,iso_HDO
-IF ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
+WRITE(*,*) 'iso_O17,iso_O18,iso_HDO=',iso_O17,iso_O18,iso_HDO
+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,17 +120,17 @@
   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)
 END IF
 
-write(*,*) 'deltalim=',deltalim
-write(*,*) 'deltaDmin=',deltaDmin      
-write(*,*) 'deltalimtrac=',deltalimtrac  
-write(*,*) 'O17_verif=',O17_verif
-write(*,*) 'o17excess_bas=',o17excess_bas
-write(*,*) 'o17excess_haut=',o17excess_haut  
-write(*,*) 'dexcess_min=',dexcess_min
-write(*,*) 'dexcess_max=',dexcess_max
+WRITE(*,*) 'deltalim=',deltalim
+WRITE(*,*) 'deltaDmin=',deltaDmin
+WRITE(*,*) 'deltalimtrac=',deltalimtrac
+WRITE(*,*) 'O17_verif=',O17_verif
+WRITE(*,*) 'o17excess_bas=',o17excess_bas
+WRITE(*,*) 'o17excess_haut=',o17excess_haut
+WRITE(*,*) 'dexcess_min=',dexcess_min
+WRITE(*,*) 'dexcess_max=',dexcess_max
 
         END SUBROUTINE  iso_verif_init
@@ -150,5 +150,5 @@
 
         if (iso_verif_egalite_choix_nostop(a,b,err_msg, &
-                 errmax,errmaxrel).eq.1) then
+                 errmax,errmaxrel).eq.1) THEN
                 stop
         endif
@@ -156,5 +156,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif           
@@ -184,10 +184,10 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                  
 
 
-        end function iso_verif_egalite_nostop
+        END FUNCTION iso_verif_egalite_nostop
 
 
@@ -209,15 +209,15 @@
 
         if (iso_verif_aberrant_choix_nostop(R,1.0,ridicule, &
-                 deltalim,err_msg).eq.1) then
+                 deltalim,err_msg).eq.1) THEN
              stop
         endif 
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) then    
-         write(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
+        if (.not.(iso_HDO.gt.0)) THEN
+         WRITE(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
           stop
         endif
 #else        
-        write(*,*) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
@@ -240,6 +240,6 @@
 
         if (iso_verif_aberrant_enc_choix_nostop(R,1.0,ridicule, &
-                 deltalim,err_msg).eq.1) then
-             write(*,*) 'deltaD=',deltaD(R)
+                 deltalim,err_msg).eq.1) THEN
+             WRITE(*,*) 'deltaD=',deltaD(R)
              CALL abort_physic('isotopes_verif_mod > iso_verif_aberrant_encadre',err_msg,1)
              !stop             
@@ -247,10 +247,10 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) then    
-         write(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
+        if (.not.(iso_HDO.gt.0)) THEN
+         WRITE(*,*) 'iso86: err_msg=',err_msg,': pourquoi verif?'
           stop
         endif
 #else        
-        write(*,*) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
@@ -276,15 +276,15 @@
 
         if (iso_verif_aberrant_choix_nostop(xt,q,qmin, &
-                 deltaDmax,err_msg).eq.1) then
+                 deltaDmax,err_msg).eq.1) THEN
              stop
         endif
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) then    
-         write(*,*) 'iso122: err_msg=',err_msg,': pourquoi verif?'
+        if (.not.(iso_HDO.gt.0)) THEN
+         WRITE(*,*) 'iso122: err_msg=',err_msg,': pourquoi verif?'
           stop
         endif
 #else
-        write(*,*) 'iso126: err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'iso126: err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
@@ -313,15 +313,15 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) then    
-         write(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
+        if (.not.(iso_HDO.gt.0)) THEN
+         WRITE(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
           stop
         endif
 #else
-        write(*,*) 'iso160: err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'iso160: err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif           
         
 
-        end function iso_verif_aberrant_nostop
+        END FUNCTION iso_verif_aberrant_nostop
 
         function iso_verif_aberrant_enc_nostop(R,err_msg)
@@ -345,14 +345,14 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) then    
-         write(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
+        if (.not.(iso_HDO.gt.0)) THEN
+         WRITE(*,*) 'iso156: err_msg=',err_msg,': pourquoi verif?'
           stop
         endif
 #else
-        write(*,*) 'iso160: err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'iso160: err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
 
-        end function iso_verif_aberrant_enc_nostop
+        END FUNCTION iso_verif_aberrant_enc_nostop
 
         !************************************
@@ -379,27 +379,27 @@
 
 #ifdef ISOVERIF        
-        if (iso_verif_noNaN_nostop(q,err_msg).eq.1) then
-            write(*,*) 'q=',q
+        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
-            write(*,*) 'xt=',xt
+        if (iso_verif_noNaN_nostop(xt,err_msg).eq.1) THEN
+            WRITE(*,*) 'xt=',xt
             iso_verif_aberrant_choix_nostop=1
         endif
 #endif
 
-        if (q.gt.qmin) then
+        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 '// &
+                (xt.gt.borne)) THEN
+            WRITE(*,*) 'erreur detectee par '// &
                    'iso_verif_aberrant_choix_nostop:'
-            write(*,*) err_msg
-            write(*,*) 'q,deltaD=',q,deltaD(xt/q)
-            write(*,*) 'deltaDmax=',deltaDmax
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'q,deltaD=',q,deltaD(xt/q)
+            WRITE(*,*) 'deltaDmax=',deltaDmax
             iso_verif_aberrant_choix_nostop=1
-            if (abs(xt-q)/q.lt.errmax) then
-                write(*,*) 'attention, n''a-t-on pas confondu'// &
+            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?'
             endif
@@ -408,15 +408,15 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) then    
-         write(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
+        if (.not.(iso_HDO.gt.0)) THEN
+         WRITE(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
           stop
         endif
 #else
-        write(*,*) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
         
 
-        end function iso_verif_aberrant_choix_nostop
+        END FUNCTION iso_verif_aberrant_choix_nostop
 
         function iso_verif_aberrant_enc_choix_nostop(xt,q,   &
@@ -436,14 +436,14 @@
 
         iso_verif_aberrant_enc_choix_nostop=0
-        if (q.gt.qmin) then
+        if (q.gt.qmin) THEN
         if ((deltaD(xt/q).gt.deltaDmax).or. &
-                (deltaD(xt/q).lt.deltaDmin)) then
-            write(*,*) 'erreur detectee par '// &
+                (deltaD(xt/q).lt.deltaDmin)) THEN
+            WRITE(*,*) 'erreur detectee par '// &
                    'iso_verif_aberrant_choix_nostop:'
-            write(*,*) err_msg
-            write(*,*) 'q,deltaD=',q,deltaD(xt/q)
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'q,deltaD=',q,deltaD(xt/q)
             iso_verif_aberrant_enc_choix_nostop=1
-            if (abs(xt-q)/q.lt.errmax) then
-                write(*,*) 'attention, n''a-t-on pas confondu'// &
+            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?'
             endif
@@ -452,15 +452,15 @@
 
 #ifdef ISOVERIF
-        if (.not.(iso_HDO.gt.0)) then    
-         write(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
+        if (.not.(iso_HDO.gt.0)) THEN
+         WRITE(*,*) 'iso205: err_msg=',err_msg,': pourquoi verif?'
           stop
         endif
 #else
-        write(*,*) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
         
 
-        end function iso_verif_aberrant_enc_choix_nostop
+        END FUNCTION iso_verif_aberrant_enc_choix_nostop
 
         !*******************
@@ -479,15 +479,14 @@
         !integer iso_verif_aberrant_o17_nostop
 
-!        write(*,*) 'O17_verif=',O17_verif
-        if (O17_verif) then
+!        WRITE(*,*) 'O17_verif=',O17_verif
+        if (O17_verif) THEN
             if (iso_verif_aberrant_o17_nostop(R17,R18,err_msg) &
-                 .eq.1) then
+                 .eq.1) THEN
                 stop
             endif
-        endif !if (O17_verif) then
-
+        endif !if (O17_verif) THEN
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
@@ -512,28 +511,26 @@
         integer iso_verif_aberrant_o17_nostop
 
-        if (O17_verif) then
-
+        if (O17_verif) THEN
         iso_verif_aberrant_o17_nostop=0
         if ((o17excess(R17,R18).gt.o17excess_haut).or. &
-                  (o17excess(R17,R18).lt.o17excess_bas)) then
-            write(*,*) 'erreur detectee par iso_verif_aberrant_O17:'
-            write(*,*) err_msg
-            write(*,*) 'o17excess=',o17excess(R17,R18)
-            write(*,*) 'deltaO17=',(R17/tnat(iso_o17)-1.0)*1000.0
-            write(*,*) 'deltaO18=',(R18/tnat(iso_O18)-1.0)*1000.0
+                  (o17excess(R17,R18).lt.o17excess_bas)) THEN
+            WRITE(*,*) 'erreur detectee par iso_verif_aberrant_O17:'
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'o17excess=',o17excess(R17,R18)
+            WRITE(*,*) 'deltaO17=',(R17/tnat(iso_o17)-1.0)*1000.0
+            WRITE(*,*) 'deltaO18=',(R18/tnat(iso_O18)-1.0)*1000.0
             ! attention, vérifier que la ligne suivante est bien activée
             iso_verif_aberrant_o17_nostop=1
         endif
 
-        endif  !if (O17_verif) then
-
+        endif  !if (O17_verif) THEN
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
         
 
-        end function iso_verif_aberrant_o17_nostop
+        END FUNCTION iso_verif_aberrant_o17_nostop
 
 
@@ -552,10 +549,10 @@
         !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
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg iso443=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg iso443=',err_msg,': pourquoi verif?'
         stop
 #endif           
@@ -577,10 +574,10 @@
         integer iso_verif_noNAN_nostop
 
-        if ((x.gt.-borne).and.(x.lt.borne)) then
+        if ((x.gt.-borne).and.(x.lt.borne)) THEN
                 iso_verif_noNAN_nostop=0
         else
-            write(*,*) 'erreur detectee par iso_verif_nonNAN:'
-            write(*,*) err_msg
-            write(*,*) 'x=',x
+            WRITE(*,*) 'erreur detectee par iso_verif_nonNAN:'
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'x=',x
             iso_verif_noNAN_nostop=1
         endif      
@@ -588,10 +585,10 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg iso 482=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg iso 482=',err_msg,': pourquoi verif?'
         stop
 #endif           
 
 
-        end function iso_verif_noNaN_nostop
+        END FUNCTION iso_verif_noNaN_nostop
 
         SUBROUTINE iso_verif_noNaN_vect2D(x,err_msg,ni,n,m)
@@ -614,9 +611,9 @@
         do ixt=1,ni
          if ((x(ixt,i,j).gt.-borne).and. &
-                  (x(ixt,i,j).lt.borne)) then
+                  (x(ixt,i,j).lt.borne)) THEN
          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
+            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.
@@ -627,5 +624,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg iso525=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg iso525=',err_msg,': pourquoi verif?'
         stop
 #endif           
@@ -652,9 +649,9 @@
         do ixt=1,ni
          if ((x(ixt,i).gt.-borne).and. &
-                  (x(ixt,i).lt.borne)) then
+                  (x(ixt,i).lt.borne)) THEN
          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
+            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.
@@ -664,5 +661,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg iso525=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg iso525=',err_msg,': pourquoi verif?'
         stop
 #endif           
@@ -688,5 +685,5 @@
 
         if (iso_verif_egalite_choix_nostop( &
-                  a,b,err_msg,erabs,errel).eq.1) then
+                  a,b,err_msg,erabs,errel).eq.1) THEN
            stop
         endif
@@ -694,5 +691,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif           
@@ -721,22 +718,22 @@
 
 #ifdef ISOVERIF
-        if (iso_verif_noNaN_nostop(a,err_msg).eq.1) then
-            write(*,*) 'a=',a
+        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
-            write(*,*) 'b=',b
+        if (iso_verif_noNaN_nostop(b,err_msg).eq.1) THEN
+            WRITE(*,*) 'b=',b
             iso_verif_egalite_choix_nostop=1
         endif      
 #endif
 
-        if (abs(a-b).gt.erabs) then
+        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:'
-            write(*,*) err_msg
-            write(*,*) 'a=',a
-            write(*,*) 'b=',b
-            write(*,*) 'erabs,errel=',erabs,errel
+                  .gt.errel) THEN
+            WRITE(*,*) 'erreur detectee par iso_verif_egalite:'
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'a=',a
+            WRITE(*,*) 'b=',b
+            WRITE(*,*) 'erabs,errel=',erabs,errel
             iso_verif_egalite_choix_nostop=1
 !            stop
@@ -746,10 +743,10 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif           
         
 
-        end function iso_verif_egalite_choix_nostop       
+        END FUNCTION iso_verif_egalite_choix_nostop
 
 
@@ -770,5 +767,5 @@
 
         if (iso_verif_positif_choix_nostop(x,ridicule,err_msg) &
-                 .eq.1) then
+                 .eq.1) THEN
            stop
         endif
@@ -776,5 +773,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'iso_verif 637: err_msg=',err_msg, &
+        WRITE(*,*) 'iso_verif 637: err_msg=',err_msg, &
                  ': pourquoi verif?'
         stop
@@ -801,13 +798,13 @@
         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
-          write(*,*) 'erreur detectee par iso_verif_positif_vect:'
-          write(*,*) err_msg
-          write(*,*) 'i,x=',ifaux,x(ifaux)
+        if (iso_verif_positif_nostop.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_positif_vect:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,x=',ifaux,x(ifaux)
           stop
         endif   
@@ -831,13 +828,13 @@
         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                        
-         write(*,*) 'erreur detectee par iso_verif_positif_choix_vect:'
-         write(*,*) err_msg
-         write(*,*) 'i,x=',ifaux,x(ifaux)
+        if (iso_verif_positif_nostop.eq.1) THEN
+         WRITE(*,*) 'erreur detectee par iso_verif_positif_choix_vect:'
+         WRITE(*,*) err_msg
+         WRITE(*,*) 'i,x=',ifaux,x(ifaux)
          stop
         endif   
@@ -860,5 +857,5 @@
 
         if (iso_verif_positif_strict_nostop(x,err_msg) &
-                 .eq.1) then
+                 .eq.1) THEN
            stop
         endif            
@@ -880,10 +877,10 @@
         integer iso_verif_positif_strict_nostop
 
-        if (x.gt.0.0) then
+        if (x.gt.0.0) THEN
             iso_verif_positif_strict_nostop=0
         else     
-            write(*,*) 'erreur detectee par iso_verif_positif_strict:'
-            write(*,*) err_msg
-            write(*,*) 'x=',x  
+            WRITE(*,*) 'erreur detectee par iso_verif_positif_strict:'
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'x=',x
             iso_verif_positif_strict_nostop=1    
 !            stop  
@@ -891,5 +888,5 @@
         
 
-        end function iso_verif_positif_strict_nostop
+        END FUNCTION iso_verif_positif_strict_nostop
 
 !******************
@@ -909,5 +906,5 @@
 
         if (iso_verif_positif_choix_nostop(x,ridic,err_msg) &
-                 .eq.1) then
+                 .eq.1) THEN
            stop
         endif
@@ -915,5 +912,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'iso_verif 801: err_msg=',err_msg, &
+        WRITE(*,*) 'iso_verif 801: err_msg=',err_msg, &
                  ': pourquoi verif?'
         stop
@@ -944,5 +941,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'iso_verif 837: err_msg=',err_msg, &
+        WRITE(*,*) 'iso_verif 837: err_msg=',err_msg, &
                  ': pourquoi verif?'
         stop
@@ -951,5 +948,5 @@
         
 
-        end function iso_verif_positif_nostop
+        END FUNCTION iso_verif_positif_nostop
 
         !******************
@@ -967,8 +964,8 @@
         integer iso_verif_positif_choix_nostop
 
-        if (x.lt.-ridic) then
-            write(*,*) 'erreur detectee par iso_verif_positif_nostop:'
-            write(*,*) err_msg
-            write(*,*) 'x=',x
+        if (x.lt.-ridic) THEN
+            WRITE(*,*) 'erreur detectee par iso_verif_positif_nostop:'
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'x=',x
             iso_verif_positif_choix_nostop=1
         else
@@ -979,5 +976,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'iso_verif 877: err_msg=',err_msg, &
+        WRITE(*,*) 'iso_verif 877: err_msg=',err_msg, &
                  ': pourquoi verif?'
         stop
@@ -985,5 +982,5 @@
         
 
-        end function iso_verif_positif_choix_nostop
+        END FUNCTION iso_verif_positif_choix_nostop
 
 
@@ -1004,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
@@ -1036,11 +1033,11 @@
               (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
-            write(*,*) 'delta180=',deltao
-            write(*,*) 'deltaD=',deltaD
-            write(*,*) 'Dexcess=',dexcess
-            write(*,*) 'tnat=',tnat
+              .or.(dexcess.gt.dexcess_max)))) THEN
+            WRITE(*,*) 'erreur detectee par iso_verif_O18_aberrant:'
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'delta180=',deltao
+            WRITE(*,*) 'deltaD=',deltaD
+            WRITE(*,*) 'Dexcess=',dexcess
+            WRITE(*,*) 'tnat=',tnat
 !            stop
             iso_verif_O18_aberrant_nostop=1
@@ -1049,10 +1046,10 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg=',err_msg,': pourquoi verif?'
         stop
 #endif                   
 
 
-        end function iso_verif_O18_aberrant_nostop
+        END FUNCTION iso_verif_O18_aberrant_nostop
 
 
@@ -1064,12 +1061,12 @@
 
         
-        if (iso_HDO.gt.0) then
+        if (iso_HDO.gt.0) THEN
            deltaD=(R/tnat(iso_HDO)-1)*1000.0
         else
-            write(*,*) 'iso_verif_egalite>deltaD 260: iso_HDO.gt.0=', &
+            WRITE(*,*) 'iso_verif_egalite>deltaD 260: iso_HDO.gt.0=', &
                  iso_HDO.gt.0
         endif
 
-        end function deltaD
+        END FUNCTION deltaD
 
         ! **********
@@ -1079,12 +1076,12 @@
         real R,deltaO
         
-        if (iso_O18.gt.0) then
+        if (iso_O18.gt.0) THEN
            deltaO=(R/tnat(iso_O18)-1)*1000.0
         else
-            write(*,*) 'iso_verif_egalite>deltaO18 260: iso_O18.gt.0=', &
+            WRITE(*,*) 'iso_verif_egalite>deltaO18 260: iso_O18.gt.0=', &
                  iso_O18.gt.0
         endif
 
-        end function deltaO
+        END FUNCTION deltaO
 
         ! **********
@@ -1094,13 +1091,13 @@
         real RD,RO,deltaD,deltaO,dexcess
         
-        if ((iso_O18.gt.0).and.(iso_HDO.gt.0)) then
+        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
            dexcess=deltaD-8*deltaO
         else
-            write(*,*) 'iso_verif_egalite 1109: iso_O18,iso_HDO=',iso_O18,iso_HDO
-        endif
-
-        end function dexcess
+            WRITE(*,*) 'iso_verif_egalite 1109: iso_O18,iso_HDO=',iso_O18,iso_HDO
+        endif
+
+        END FUNCTION dexcess
 
 
@@ -1114,5 +1111,5 @@
         delta_all=(R/tnat(ixt)-1)*1000.0
 
-        end function delta_all
+        END FUNCTION delta_all
 
         ! **********
@@ -1125,5 +1122,5 @@
         delta_to_R=(delta/1000.0+1.0)*tnat(ixt)
 
-        end function delta_to_R
+        END FUNCTION delta_to_R
 
          ! **********
@@ -1133,15 +1130,14 @@
         real R17,R18,o17excess
         
-        if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
-            
+        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)))
-!           write(*,*) 'o17excess=',o17excess
+!           WRITE(*,*) 'o17excess=',o17excess
         else
-            write(*,*) 'iso_verif_egalite>deltaD 260: iso_O17.gt.0,18=', &
+            WRITE(*,*) 'iso_verif_egalite>deltaD 260: iso_O17.gt.0,18=', &
                  iso_O17.gt.0,iso_O18.gt.0
         endif
 
-        end function o17excess
+        END FUNCTION o17excess
 
         !       ****************
@@ -1164,14 +1160,14 @@
         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
+        !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
         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)).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
+                 .gt.errmaxrel) THEN
               iso_verif_egalite_nostop_loc=1
               ifaux=i
@@ -1182,9 +1178,9 @@
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
+        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
           stop
         endif 
@@ -1215,26 +1211,25 @@
         integer ifaux
 
-        if (iso_eau.gt.0) then
+        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)).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
+                 .gt.errmaxrel) THEN
               iso_verif_egalite_nostop_loc=1
               ifaux=i
            endif !if (abs((q(i)-xt(iso_eau,i))/
-          endif !if (abs(q(i)-xt(iso_eau,i)).gt.errmax) then
+          endif !if (abs(q(i)-xt(iso_eau,i)).gt.errmax) THEN
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i=',ifaux
-          write(*,*) 'xt,q=',xt(iso_eau,ifaux),q(ifaux)
+        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i=',ifaux
+          WRITE(*,*) 'xt,q=',xt(iso_eau,ifaux),q(ifaux)
           stop
-        endif  !if (iso_verif_egalite_nostop.eq.1) then
-        endif !if (iso_eau.gt.0) then
-
+        endif  !if (iso_verif_egalite_nostop.eq.1) THEN
+        endif !if (iso_eau.gt.0) THEN
         END SUBROUTINE  iso_verif_egalite_vect1D
 
@@ -1259,8 +1254,8 @@
         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)).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
+                 .gt.errmaxrel) THEN
               iso_verif_egalite_nostop_loc=1
               ifaux=i
@@ -1271,9 +1266,9 @@
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'a,b=',a(ifaux,jfaux),b(ifaux,jfaux)
+        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'a,b=',a(ifaux,jfaux),b(ifaux,jfaux)
           stop
         endif 
@@ -1299,13 +1294,13 @@
         !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 (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
+                         .lt.-borne)) THEN
               iso_verif_aberrant_nostop_loc=1
               ifaux=i
@@ -1316,15 +1311,14 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
+        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
                  /q(ifaux,jfaux))
-          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
+          WRITE(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
           stop
         endif  
-        endif !if (iso_HDO.gt.0) then
-
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_aberrant_vect2D
 
@@ -1347,9 +1341,9 @@
         !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 (q(i,j).gt.ridicule) THEN
             if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
                          .gt.deltalim).or. &
@@ -1357,5 +1351,5 @@
                          .lt.deltaDmin).or. &
                  (xt(iso_HDO,i,j).lt.-borne).or. &
-                 (xt(iso_HDO,i,j).gt.borne)) then
+                 (xt(iso_HDO,i,j).gt.borne)) THEN
               iso_verif_aberrant_nostop_loc=1
               ifaux=i
@@ -1366,17 +1360,16 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par ', &
+        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par ', &
                  'iso_verif_aberrant_enc_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
                  /q(ifaux,jfaux))
-          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
-          write(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
+          WRITE(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
+          WRITE(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
           CALL abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
         endif  
-        endif !if (iso_HDO.gt.0) then
-
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_aberrant_enc_vect2D
 
@@ -1400,13 +1393,13 @@
         !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 (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
+                         .lt.deltaDmin)) THEN
               iso_verif_aberrant_nostop_loc=1
               ifaux=i
@@ -1417,16 +1410,15 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par ', &
+        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par ', &
                  'iso_verif_aberrant_vect2D_ns:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
                  /q(ifaux,jfaux))
-          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
+          WRITE(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
 !          stop
         endif  
-        endif !if (iso_HDO.gt.0) then
-
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_aberrant_enc_vect2D_ns
 
@@ -1452,13 +1444,13 @@
         !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 (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
+                         .lt.-borne)) THEN
               iso_verif_aberrant_nostop_loc=1
               ifaux=i
@@ -1469,15 +1461,14 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
+        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_aberrant_vect2D:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
                  /q(ifaux,jfaux))
-          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
+          WRITE(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
           stop
         endif  
-        endif !if (iso_HDO.gt.0) then
-
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_aberrant_vect2Dch
 
@@ -1500,10 +1491,9 @@
         real deltaDloc,deltaoloc,dexcessloc
 
-        if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
+        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
@@ -1512,9 +1502,9 @@
               (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
+              .or.(dexcessloc.gt.dexcess_max)))) THEN
               iso_verif_aberrant_nostop_loc=1
               ifaux=i
               jfaux=j
-              write(*,*) 'deltaD,deltao,dexcess=',deltaDloc,deltaoloc,dexcessloc
+              WRITE(*,*) 'deltaD,deltao,dexcess=',deltaDloc,deltaoloc,dexcessloc
            endif
           endif
@@ -1522,15 +1512,14 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par ', &
+        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par ', &
                  'iso_verif_aberrant_enc_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
-          write(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
+          WRITE(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
           CALL abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
         endif  
-        endif !if (iso_HDO.gt.0) then
-
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_O18_aberrant_enc_vect2D
 
@@ -1725,9 +1714,9 @@
         do ixt=1,ni
          if ((x(ixt,i,j).gt.-borne).and. &
-                  (x(ixt,i,j).lt.borne)) then
+                  (x(ixt,i,j).lt.borne)) THEN
          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
+            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.
@@ -1738,5 +1727,5 @@
 #ifdef ISOVERIF
 #else
-        write(*,*) 'err_msg iso1772=',err_msg,': pourquoi verif?'
+        WRITE(*,*) 'err_msg iso1772=',err_msg,': pourquoi verif?'
         stop
 #endif           
@@ -1764,13 +1753,13 @@
         !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 (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
+                         .lt.deltaDmin)) THEN
               iso_verif_aberrant_nostop_loc=1
               ifaux=i
@@ -1781,16 +1770,15 @@
         enddo !do i=1,n
 
-        if (iso_verif_aberrant_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par iso_verif_aberrant_par2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
+        if (iso_verif_aberrant_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_aberrant_par2D:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
                  /q(ifaux,jfaux))
-          write(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
-          write(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
+          WRITE(*,*) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
+          WRITE(*,*) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
           stop
         endif  
-        endif !if (iso_HDO.gt.0) then
-
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_aberrant_enc_par2D
 
@@ -1813,12 +1801,12 @@
         integer ifaux,jfaux
 
-        if (iso_eau.gt.0) then
+        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)).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
+                 .gt.errmaxrel) THEN
               iso_verif_egalite_nostop_loc=1
               ifaux=i
@@ -1829,9 +1817,9 @@
         enddo !do i=1,n
 
-        if (iso_verif_egalite_nostop_loc.eq.1) then
-          write(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
-          write(*,*) err_msg
-          write(*,*) 'i,j=',ifaux,jfaux
-          write(*,*) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
+        if (iso_verif_egalite_nostop_loc.eq.1) THEN
+          WRITE(*,*) 'erreur detectee par iso_verif_egalite_vect2D:'
+          WRITE(*,*) err_msg
+          WRITE(*,*) 'i,j=',ifaux,jfaux
+          WRITE(*,*) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
           stop
         endif 
@@ -1867,5 +1855,5 @@
 
         ! 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 
@@ -1873,23 +1861,22 @@
         ! verif masse
         if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) then
+                 errmax,errmaxrel).eq.1) THEN
              iso_verif_traceur_choix_nostop=1
         endif              
 
         ! verif deltaD
-        if (iso_HDO.gt.0) then
+        if (iso_HDO.gt.0) THEN
         if (iso_verif_tracdD_choix_nostop(x,err_msg, &
-                 ridicule_trac,deltalimtrac).eq.1) then
+                 ridicule_trac,deltalimtrac).eq.1) THEN
              iso_verif_traceur_choix_nostop=1
         endif  
-        endif !if (iso_HDO.gt.0) then  
-
+        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
+                 1e-5).eq.1) THEN
              iso_verif_traceur_choix_nostop=1
         endif 
 
-        end function iso_verif_traceur_choix_nostop
+        END FUNCTION iso_verif_traceur_choix_nostop
 
         function iso_verif_tracnps_choix_nostop(x,err_msg, &
@@ -1918,5 +1905,5 @@
 
         ! 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 
@@ -1924,21 +1911,19 @@
         ! verif masse
         if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) then
+                 errmax,errmaxrel).eq.1) THEN
              iso_verif_tracnps_choix_nostop=1
         endif              
 
         ! verif deltaD
-        if (iso_HDO.gt.0) then
+        if (iso_HDO.gt.0) THEN
         if (iso_verif_tracdD_choix_nostop(x,err_msg, &
-                 ridicule_trac,deltalimtrac).eq.1) then
+                 ridicule_trac,deltalimtrac).eq.1) THEN
              iso_verif_tracnps_choix_nostop=1
         endif   
-        endif ! if (iso_HDO.gt.0) then  
-
-
-        end function iso_verif_tracnps_choix_nostop
+        endif ! if (iso_HDO.gt.0) THEN
+        END FUNCTION iso_verif_tracnps_choix_nostop
 
         function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
-        use isotopes_mod, only: isoName
+        use isotopes_mod, ONLY: isoName
         IMPLICIT NONE
 
@@ -1960,14 +1945,14 @@
        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
+                 ', verif positif, iso'//TRIM(isoName(ixt))).eq.1) THEN
             iso_verif_tracpos_choix_nostop=1
           endif
         enddo
 
-        end function iso_verif_tracpos_choix_nostop
+        END FUNCTION iso_verif_tracpos_choix_nostop
 
 
         function iso_verif_traceur_noNaN_nostop(x,err_msg)
-        use isotopes_mod, only: isoName
+        use isotopes_mod, ONLY: isoName
         IMPLICIT NONE
 
@@ -1988,13 +1973,13 @@
 
         do ixt=niso+1,ntraciso
-!          write(*,*) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
+!          WRITE(*,*) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
           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
         enddo
 
-        end function iso_verif_traceur_noNaN_nostop
+        END FUNCTION iso_verif_traceur_noNaN_nostop
 
         function iso_verif_tracm_choix_nostop(x,err_msg, &
@@ -2031,10 +2016,10 @@
               err_msg//', verif trac egalite1, iso '// &
               TRIM(isoName(iiso)), &
-              errmaxin,errmaxrelin).eq.1) then
-            write(*,*) 'iso_verif_traceur 202: x=',x
-!            write(*,*) 'xtractot=',xtractot
+              errmaxin,errmaxrelin).eq.1) THEN
+            WRITE(*,*) 'iso_verif_traceur 202: x=',x
+!            WRITE(*,*) 'xtractot=',xtractot
             do izone=1,nzone  
               ixt=itZonIso(izone,iiso)
-              write(*,*) 'izone,iiso,ixt=',izone,iiso,ixt
+              WRITE(*,*) 'izone,iiso,ixt=',izone,iiso,ixt
             enddo
             iso_verif_tracm_choix_nostop=1
@@ -2043,8 +2028,8 @@
           ! verif ajoutée le 19 fev 2011
           if ((abs(xtractot).lt.ridicule**2).and. &
-                 (abs(x(iiso)).gt.ridicule)) then
-            write(*,*) err_msg,', verif masse traceurs, iso ', &
+                 (abs(x(iiso)).gt.ridicule)) THEN
+            WRITE(*,*) err_msg,', verif masse traceurs, iso ', &
                 TRIM(isoName(iiso))
-            write(*,*) 'iso_verif_traceur 209: x=',x
+            WRITE(*,*) 'iso_verif_traceur 209: x=',x
 !            iso_verif_tracm_choix_nostop=1
           endif
@@ -2052,5 +2037,5 @@
         enddo !do iiso=1,ntraceurs_iso  
 
-        end function iso_verif_tracm_choix_nostop
+        END FUNCTION iso_verif_tracm_choix_nostop
 
         function iso_verif_tracdD_choix_nostop(x,err_msg, &
@@ -2058,5 +2043,5 @@
 
         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
@@ -2076,5 +2061,5 @@
         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)
@@ -2084,8 +2069,8 @@
                  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
-!             if (x(ieau).gt.ridicule) then
+!             if (x(ieau).gt.ridicule) THEN
 !              CALL iso_verif_aberrant(x(ixt)/x(ieau),
 !     :           err_msg//', verif trac no aberrant zone '
@@ -2093,7 +2078,6 @@
 !             endif
         enddo !do izone=1,nzone
-       endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
-
-       end function iso_verif_tracdD_choix_nostop
+       endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
+       END FUNCTION iso_verif_tracdD_choix_nostop
 
 INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
@@ -2112,9 +2096,9 @@
   IF(x(ieau)>ridicule) THEN
     IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
-      res=1; write(*,*) 'x=',x
+      res=1; WRITE(*,*) 'x=',x
     END IF
   END IF
   IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
-    res=1; write(*,*) 'x=',x
+    res=1; WRITE(*,*) 'x=',x
   END IF
   !--- Check whether q is small ; then, qt01 < 10%
@@ -2122,5 +2106,5 @@
     ieau1= itZonIso(1,iso_eau)
     IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
-      res=1; write(*,*) 'x=',x
+      res=1; WRITE(*,*) 'x=',x
     END IF
   END IF
@@ -2139,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
@@ -2157,5 +2141,5 @@
         if (iso_verif_traceur_choix_nostop(x,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) then
+             .eq.1) THEN
                 stop
         endif
@@ -2166,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
@@ -2190,5 +2174,5 @@
         if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) then
+             .eq.1) THEN
                 stop
         endif
@@ -2198,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
@@ -2222,5 +2206,5 @@
         if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) then
+             .eq.1) THEN
                 stop
         endif
@@ -2231,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
@@ -2254,5 +2238,5 @@
         if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) then
+             .eq.1) THEN
                 stop
         endif
@@ -2286,8 +2270,7 @@
 
         ! 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        
-
+        endif !if (iso_HDO.gt.0) THEN
         ! verif pas aberramment negatif: iso_verif_tracpos_choix_nostop
         CALL iso_verif_tracpos_vect(x,n,m,err_msg,1e-5)
@@ -2321,8 +2304,7 @@
 
         ! 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        
-        
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_tracnps_vect
 
@@ -2347,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
@@ -2358,10 +2340,10 @@
         
 
-        if (iso_verif_traceur_nostop) then
-            write(*,*) 'erreur detectée par iso_verif_nonNAN ', &
+        if (iso_verif_traceur_nostop) THEN
+            WRITE(*,*) 'erreur detectée par iso_verif_nonNAN ', &
                  'dans iso_verif_traceur_vect'
-            write(*,*) ''
-            write(*,*) err_msg
-            write(*,*) 'x=',x(:,ifaux,jfaux)
+            WRITE(*,*) ''
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'x=',x(:,ifaux,jfaux)
             stop
         endif
@@ -2372,5 +2354,5 @@
         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
        
@@ -2411,6 +2393,6 @@
 
         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
        
@@ -2426,5 +2408,5 @@
        integer lnblnk
 
-       if (iso_HDO.gt.0) then
+       if (iso_HDO.gt.0) THEN
         do izone=1,nzone
           ieau=itZonIso(izone,iso_eau)
@@ -2448,6 +2430,5 @@
                  deltalimtrac)
          enddo !do izone=1,nzone
-        endif !if (iso_HDO.gt.0) then
-
+        endif !if (iso_HDO.gt.0) THEN
         END SUBROUTINE  iso_verif_tracdd_vect
 
@@ -2470,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
@@ -2480,10 +2461,10 @@
         enddo !do j=1,m        
 
-        if (iso_verif_traceur_nostop) then
-            write(*,*) 'erreur detectée par verif positif ', &
+        if (iso_verif_traceur_nostop) THEN
+            WRITE(*,*) 'erreur detectée par verif positif ', &
                  'dans iso_verif_traceur_vect'
-            write(*,*) ''
-            write(*,*) err_msg
-            write(*,*) 'x=',x(:,ifaux,jfaux)
+            WRITE(*,*) ''
+            WRITE(*,*) err_msg
+            WRITE(*,*) 'x=',x(:,ifaux,jfaux)
             stop
         endif
@@ -2494,5 +2475,5 @@
 
         SUBROUTINE iso_verif_tracnps(x,err_msg)
-        use isotrac_mod, only: ridicule_trac
+        use isotrac_mod, ONLY: ridicule_trac
 
         IMPLICIT NONE
@@ -2513,5 +2494,5 @@
         if (iso_verif_tracnps_choix_nostop(x,err_msg, &
              errmax,errmaxrel,ridicule_trac,deltalimtrac) &
-             .eq.1) then
+             .eq.1) THEN
                 stop
         endif
@@ -2537,5 +2518,5 @@
 
         if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
-             .eq.1) then
+             .eq.1) THEN
                 stop
         endif
@@ -2560,5 +2541,5 @@
         if (iso_verif_traceur_choix_nostop(x,err_msg, &
              errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
-             .eq.1) then
+             .eq.1) THEN
                 stop
         endif
@@ -2567,6 +2548,6 @@
 
         function iso_verif_traceur_nostop(x,err_msg)
-        use isotrac_mod, only: ridicule_trac
-        !use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
+        use isotrac_mod, ONLY: ridicule_trac
+        !use isotopes_verif, ONLY: errmax,errmaxrel,deltalimtrac
         IMPLICIT NONE
         ! vérifier des choses sur les traceurs
@@ -2591,5 +2572,5 @@
              errmax,errmaxrel,ridicule_trac,deltalimtrac)
 
-        end function iso_verif_traceur_nostop
+        END FUNCTION iso_verif_traceur_nostop
 
 
@@ -2610,5 +2591,5 @@
 
         ! 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 
@@ -2616,5 +2597,5 @@
         ! verif masse
         if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) then
+                 errmax,errmaxrel).eq.1) THEN
              stop
         endif    
@@ -2642,5 +2623,5 @@
         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 
@@ -2648,13 +2629,13 @@
         ! verif masse
         if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax,errmaxrel).eq.1) then
+                 errmax,errmaxrel).eq.1) THEN
              iso_verif_traceur_jm_nostop=1
         endif   
         
-        end function iso_verif_traceur_jm_nostop
+        END FUNCTION iso_verif_traceur_jm_nostop
 
         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
 
@@ -2671,5 +2652,5 @@
 
         if ((option_traceurs.eq.17).or. &
-                 (option_traceurs.eq.18)) then
+                 (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 à 
@@ -2679,35 +2660,34 @@
         do i=1,n
          do k=1,m
-           if (x(ieau,i,k).gt.ridicule) then
+           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'
-                write(*,*) 'i,k=',i,k
-                write(*,*) 'x(:,i,k)=',x(:,i,k)
+                  .gt.-200.0) THEN
+                WRITE(*,*) err_msg,', vect:deltaDt05 trop fort'
+                WRITE(*,*) 'i,k=',i,k
+                WRITE(*,*) 'x(:,i,k)=',x(:,i,k)
                 stop
              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
-                write(*,*) err_msg,', vect:qt05 trop fort'
-                write(*,*) 'i,k=',i,k
-                write(*,*) 'x(:,i,k)=',x(:,i,k)
+           endif !if (x(ieau).gt.ridicule) THEN
+           if (x(ieau,i,k).gt.2.0e-3) THEN
+                WRITE(*,*) err_msg,', vect:qt05 trop fort'
+                WRITE(*,*) 'i,k=',i,k
+                WRITE(*,*) 'x(:,i,k)=',x(:,i,k)
                 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
-                   write(*,*) err_msg,', vect: qt01 trop abondant'
-                   write(*,*) 'i,k=',i,k
-                   write(*,*) 'ieau1,iso_eau,x(ieau1,i,k),', &
+           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
+                   WRITE(*,*) 'ieau1,iso_eau,x(ieau1,i,k),', &
                        'x(iso_eau,i,k)=',ieau1,iso_eau, &
                         x(ieau1,i,k),x(iso_eau,i,k)
-                   write(*,*) 'x(:,i,k)=',x(:,i,k)
+                   WRITE(*,*) 'x(:,i,k)=',x(:,i,k)
                    stop
-                endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
+                endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) THEN
             endif
           enddo !do k=1,m
         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
 
@@ -2715,5 +2695,5 @@
         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
 
@@ -2730,5 +2710,5 @@
 
         if ((option_traceurs.eq.17).or. &
-                 (option_traceurs.eq.18)) then
+                 (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 à 
@@ -2739,29 +2719,29 @@
         do i=1,n
          do k=1,m
-           if (x(i,k,iq,ieau).gt.ridicule) then
+           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'
-                write(*,*) 'i,k=',i,k
-                write(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
+                  .gt.-200.0) THEN
+                WRITE(*,*) err_msg,', vect:deltaDt05 trop fort'
+                WRITE(*,*) 'i,k=',i,k
+                WRITE(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
                 stop
              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
-                write(*,*) err_msg,', vect:qt05 trop fort'
-                write(*,*) 'i,k=',i,k
-                write(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
+           endif !if (x(ieau).gt.ridicule) THEN
+           if (x(i,k,iq,ieau).gt.2.0e-3) THEN
+                WRITE(*,*) err_msg,', vect:qt05 trop fort'
+                WRITE(*,*) 'i,k=',i,k
+                WRITE(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
                 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
-                   write(*,*) err_msg,', vect: qt01 trop abondant'
-                   write(*,*) 'i,k=',i,k
-                   write(*,*) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
+           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
+                   WRITE(*,*) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
                        'x(i,k,iq,ieau)=',ieau1,iso_eau, &
                         x(i,k,iq,ieau1),x(i,k,iq,iso_eau)
-                   write(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
+                   WRITE(*,*) 'x(i,k,iq,:)=',x(i,k,iq,:)
                    stop
-                endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
+                endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) THEN
             endif
           enddo !do k=1,m
@@ -2769,6 +2749,5 @@
         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
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_mod.F90	(revision 5116)
@@ -472,5 +472,5 @@
                izone=izone_lat+(izone_pres-1)*nzone_lat
                strtrac(izone) = 't'//TRIM(int2str(izone_pres))//TRIM(int2str(izone_lat))
-               write(*,*) 'izone_pres, izone_lat, izone, strtrac = ',izone_pres, izone_lat, izone, strtrac(izone)
+               WRITE(*,*) 'izone_pres, izone_lat, izone, strtrac = ',izone_pres, izone_lat, izone, strtrac(izone)
             END DO
          END DO
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_routines_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_routines_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotrac_routines_mod.F90	(revision 5116)
@@ -64,5 +64,5 @@
 
     USE isotopes_mod, ONLY: ridicule,iso_eau,iso_HDO,ridicule_evap
-    USE isotrac_mod, only: option_revap,evap_franche,izone_revap, &
+    USE isotrac_mod, ONLY: option_revap,evap_franche,izone_revap, &
 &       ridicule_trac
 #ifdef ISOVERIF
@@ -105,5 +105,5 @@
 #endif         
 
-!        write(*,*) 'compress_stewart 315 tmp: ',
+!        WRITE(*,*) 'compress_stewart 315 tmp: ',
 !     :           'entrée dans uncompress_commun_zone_revap'
 
@@ -115,10 +115,10 @@
               ((liq.eq.0).and. &
               (Eqi_stewart(il)*fac_ftmr_cas(il).ge.0.0))).or. &
-              (izone.eq.izone_revap))) then
+              (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
+!     :           (izone.eq.izone_revap))) THEN
             ! on met la revap dans izone_revap si option_revap=1 et si:
             ! * evap glace (non fractionnante)
@@ -127,12 +127,12 @@
             ! si option_revap=1 et izone=izone_revap, on met aussi dans izone_revap
 !#ifdef ISOVERIF            
-!            if (il.eq.1) then
-!            write(*,*) 'compress tmp 341: revap dans izone_revap'
-!            write(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il),evap_franche=',
+!            if (il.eq.1) THEN
+!            WRITE(*,*) 'compress tmp 341: revap dans izone_revap'
+!            WRITE(*,*) 'Eqi_stewart(il),fac_ftmr_cas(il),evap_franche=',
 !     :           Eqi_stewart(il),fac_ftmr_cas(il),evap_franche
-!            write(*,*) 'il,xtp_cas(iso_eau,il)=',il,xtp_cas(iso_eau,il)
-!            write(*,*) 'il,xtp_avantevap_cas(iso_eau,il)=',il,
+!            WRITE(*,*) 'il,xtp_cas(iso_eau,il)=',il,xtp_cas(iso_eau,il)
+!            WRITE(*,*) 'il,xtp_avantevap_cas(iso_eau,il)=',il,
 !     :            xtp_avantevap_cas(iso_eau,il)
-!            write(*,*) 'xtp(ixt_revap,cas(il))=',
+!            WRITE(*,*) 'xtp(ixt_revap,cas(il))=',
 !     :            xtp(index_trac(izone_revap,iso_eau),cas(il))
 !            endif
@@ -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), &
@@ -168,9 +168,9 @@
                     xtevap(ieau,cas(il)),ridicule_trac,deltalimtrac*2, &
                     'compress 344b')
-            endif !if (iso_HDO.gt.0) then
+            endif !if (iso_HDO.gt.0) THEN
 #endif            
 
             ! 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,9 +181,9 @@
 
 !#ifdef ISOVERIF            
-!            if (il.eq.1) then
-!            write(*,*) 'compress tmp 341: revap dans izone_revap'
-!            write(*,*) 'xtp(ixt_revap,cas(il))=',
+!            if (il.eq.1) THEN
+!            WRITE(*,*) 'compress tmp 341: revap dans izone_revap'
+!            WRITE(*,*) 'xtp(ixt_revap,cas(il))=',
 !     :           xtp(index_trac(izone_revap,iso_eau),cas(il))
-!            write(*,*) 'xtp(ixt,cas(il))=',
+!            WRITE(*,*) 'xtp(ixt,cas(il))=',
 !     :            xtp(index_trac(izone,iso_eau),cas(il))
 !            endif
@@ -209,5 +209,5 @@
            enddo !do iiso=1,niso
          enddo !do il=1,ncas
-!         write(*,*) 'compress_stewart 361 tmp: ',
+!         WRITE(*,*) 'compress_stewart 361 tmp: ',
 !     :           'sortie de uncompress_commun_zone_revap'
          
@@ -260,8 +260,8 @@
           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)))
-            else !if (qp_avantevap_cas(cas(il)).gt.0.0) then
+            else !if (qp_avantevap_cas(cas(il)).gt.0.0) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_egalite_choix( &
@@ -272,9 +272,9 @@
             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)) &
                  /(Pqisup(cas(il))-Eqi_prime(cas(il))))
-            else !if (Pqisup(cas(il)).gt.0.0) then
+            else !if (Pqisup(cas(il)).gt.0.0) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_egalite_choix(water(cas(il)),0.0, &
@@ -282,6 +282,5 @@
 #endif
                 water_cas(il)=0.0
-            endif !if (Pqisup(cas(il)).gt.0.0) then
-
+            endif !if (Pqisup(cas(il)).gt.0.0) THEN
             Pqisup_cas(il)=Pxtisup(ieau,cas(il))
             qp_avantevap_cas(il)=xtp_avantevap(ieau,cas(il))
@@ -349,5 +348,5 @@
           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)))
@@ -357,9 +356,9 @@
             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)) &
                  /(Pqisup(cas(il))-Eqi_prime(cas(il))))
-            else !if (Pqisup(cas(il)).gt.0.0) then
+            else !if (Pqisup(cas(il)).gt.0.0) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_egalite_choix(water(cas(il)),0.0, &
@@ -367,11 +366,10 @@
 #endif
                 water_cas(il)=0.0
-            endif !if (Pqisup(cas(il)).gt.0.0) then  
-
+            endif !if (Pqisup(cas(il)).gt.0.0) THEN
             Pqisup_cas(il)=Pxtisup(ieau,cas(il))
             qp_avantevap_cas(il)=xtp_avantevap(ieau,cas(il))
             q_cas(il)=xt(ieau,cas(il))
 !#ifdef ISOVERIF
-!            if (qp_avantevap(cas(il)).gt.0.0) then
+!            if (qp_avantevap(cas(il)).gt.0.0) THEN
 !              evap_cas(il)=evap(cas(il))
 !     :           *(xtp_avantevap(ieau,cas(il))/qp_avantevap(cas(il)))
@@ -430,5 +428,5 @@
           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)))
@@ -506,7 +504,7 @@
           integer il,ixt,iiso,ieau
 
-!          write(*,*) 'compress 910: xtp_avantevap(iso_eau,cas(1))=',
+!          WRITE(*,*) 'compress 910: xtp_avantevap(iso_eau,cas(1))=',
 !     :           xtp_avantevap(iso_eau,cas(1))
-!        write(*,*) 'compress_evap_liq_zone 510: ncas,ncum=',ncas,ncum
+!        WRITE(*,*) 'compress_evap_liq_zone 510: ncas,ncum=',ncas,ncum
         ptrac(:)=0. ! CR 31 mars 2023: initialisation de ptrac
 
@@ -515,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)) &
@@ -528,9 +526,9 @@
             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)) &
                  /(Pqisup(cas(il))-Eqi_prime(cas(il))))
-            else !if (Pqisup(cas(il)).gt.0.0) then
+            else !if (Pqisup(cas(il)).gt.0.0) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_egalite_choix(water(cas(il)),0.0, &
@@ -538,7 +536,5 @@
 #endif
                 water_cas(il)=0.0
-            endif !if (Pqisup(cas(il)).gt.0.0) then
-
-            
+            endif !if (Pqisup(cas(il)).gt.0.0) THEN
 !            qp_cas(il)=qp(cas(il))
 #ifdef ISOVERIF              
@@ -558,8 +554,8 @@
             enddo
           enddo !do il=1,ncas
-!         write(*,*) 'compress_stewart 931: ',
+!         WRITE(*,*) 'compress_stewart 931: ',
 !     &           'xtp_avantevap_cas(iso_eau,1)=', 
 !     &           xtp_avantevap_cas(iso_eau,1)
-!         write(*,*) 'xtp_avantevap(iso_eau,cas(1))=',
+!         WRITE(*,*) 'xtp_avantevap(iso_eau,cas(1))=',
 !     &           xtp_avantevap(iso_eau,cas(1))
 
@@ -574,7 +570,7 @@
       !    Eqi_prime sont les même que Eqi_par
           do il=1,ncas  
-           if (Pqisup(cas(il)).gt.0.0) then            
+           if (Pqisup(cas(il)).gt.0.0) THEN
             if ((water(cas(il)).gt.ridicule/100).and. &
-                  (Pqiinf_par(cas(il)).le.0.0)) then
+                  (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
              ! alors que le bilan de masse n'enprédit pas.
@@ -582,14 +578,14 @@
              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
-          else ! if (Pqisup(cas(il).gt.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
                CALL iso_verif_egalite((Pqiinf(cas(il))), &
@@ -604,5 +600,5 @@
                Pqiinf_stewart(il)=0.0
                Eqi_stewart(il)=0.0
-          endif ! if (Pqisup(cas(il).gt.0.0) then 
+          endif ! if (Pqisup(cas(il).gt.0.0) THEN
          enddo !do il=1,ncas_evap_glace
 
@@ -611,10 +607,10 @@
         do il=1,ncas
           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)
-              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
-              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
-              write(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
+                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+              WRITE(*,*) 'compress_stewart 498: evap liq:'
+              WRITE(*,*) 'water(il,i)=', water_cas(il)
+              WRITE(*,*) 'Pqiinf=',Pqiinf(cas(il))
+              WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
+              WRITE(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
               stop                   
           endif
@@ -678,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)))
@@ -693,9 +689,9 @@
             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)) &
                  /(Pqisup(cas(il))-Eqi_prime(cas(il))))
-            else !if (Pqisup(cas(il)).gt.0.0) then
+            else !if (Pqisup(cas(il)).gt.0.0) THEN
 #ifdef ISOVERIF
                 CALL iso_verif_egalite_choix(water(cas(il)),0.0, &
@@ -703,7 +699,5 @@
 #endif
                 water_cas(il)=0.0
-            endif !if (Pqisup(cas(il)).gt.0.0) then
-
-
+            endif !if (Pqisup(cas(il)).gt.0.0) THEN
             qp_avantevaptrac_cas(il)=xtp_avantevap(ieau,cas(il))
 !            qp_cas(il)=xtp(ieau,cas(il))
@@ -734,8 +728,7 @@
       !    Eqi_prime sont les même que Eqi_par
           do il=1,ncas  
-           if (Pqisup(cas(il)).gt.0.0) then  
-
+           if (Pqisup(cas(il)).gt.0.0) THEN
             if ((water(cas(il)).gt.ridicule/100).and. &
-                  (Pqiinf_par(cas(il)).le.0.0)) then
+                  (Pqiinf_par(cas(il)).le.0.0)) THEN
              ! on ne peut pas utiliser la méthode 1, car KE prédit de l'eau
              ! alors que le bilan de masse n'enprédit pas.
@@ -745,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)))
@@ -756,8 +749,6 @@
                   *(Pxtisup(ieau,cas(il))/Pqisup(cas(il)))
              endif
-           endif !if ((water(il,i).gt.ridicule/100).and.(Pqiinf_par.le.0.0)) then
-
-          else !if (Pqisup(cas(il).gt.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
               CALL iso_verif_egalite((Pqiinf(cas(il))), &
@@ -772,5 +763,5 @@
                Pqiinf_stewart(il)=0.0
                Eqi_stewart(il)=0.0              
-          endif !if (Pqisup(cas(il).gt.0.0) then  
+          endif !if (Pqisup(cas(il).gt.0.0) THEN
          enddo !do il=1,ncas_evap_glace
 
@@ -779,10 +770,10 @@
         do il=1,ncas
           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)
-              write(*,*) 'Pqiinf=',Pqiinf(cas(il))
-              write(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
-              write(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
+                 .and.(Pqiinf_stewart(il).le.0.0)) THEN
+              WRITE(*,*) 'compress_stewart 498: evap glace:'
+              WRITE(*,*) 'water(il,i)=', water_cas(il)
+              WRITE(*,*) 'Pqiinf=',Pqiinf(cas(il))
+              WRITE(*,*) 'Pqiinf_par=',Pqiinf_par(cas(il))
+              WRITE(*,*) 'Pqiinf_stewart=',Pqiinf_stewart(il)
               stop                   
           endif
@@ -799,5 +790,5 @@
 
     USE isotopes_mod, ONLY: ridicule,iso_eau
-    USE isotrac_mod, only: option_revap,evap_franche
+    USE isotrac_mod, ONLY: option_revap,evap_franche
 #ifdef ISOVERIF
         use isotopes_verif_mod
@@ -826,7 +817,7 @@
          integer il,ixt,iiso
 
-!         write(*,*) 'uncompress_stewart 1420 tmp: zxt=',
+!         WRITE(*,*) 'uncompress_stewart 1420 tmp: zxt=',
 !     :            zxt(iso_eau:ntraciso:3,cas(1))
-!         write(*,*) 'Exi,fac_ftmr=',
+!         WRITE(*,*) 'Exi,fac_ftmr=',
 !     :            Exi(iso_eau,1),fac_ftmr(1)
          do il=1,ncas
@@ -837,7 +828,7 @@
           enddo !do iiso=1,niso
 !#ifdef ISOVERIF
-!          if (il.eq.9) then
-!            write(*,*) 'uncompress 1521'
-!            write(*,*) 'il,Eqi,fac_ftmr,evap_franche,Exi(2,il)=',
+!          if (il.eq.9) THEN
+!            WRITE(*,*) 'uncompress 1521'
+!            WRITE(*,*) 'il,Eqi,fac_ftmr,evap_franche,Exi(2,il)=',
 !     :         il,Eqi(il),fac_ftmr(il),evap_franche,Exi(2,il)
 !          endif
@@ -848,5 +839,5 @@
                .and.(hdiag(il).lt.0.99)).or. &
                ((liq.eq.0).and. &
-               (Eqi(il)*fac_ftmr(il).ge.0.0)))) then
+               (Eqi(il)*fac_ftmr(il).ge.0.0)))) THEN
           ! le flux d'évap va dans un tag particulier
           ! -> zxt est inchangé mais xtrevap_tag(ixt,il) est incrémenté
@@ -873,5 +864,5 @@
           endif !if ((Eqi(il)*fac_ftmr(il).gt.evap_franche).and.
          enddo !do il=1,ncas
-!         write(*,*) 'compress_stewart 1453 tmp: zxt=',
+!         WRITE(*,*) 'compress_stewart 1453 tmp: zxt=',
 !     :            zxt(iso_eau:ntraciso:3,cas(1))
 
@@ -927,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))
@@ -933,16 +924,16 @@
             zqev_diag_cas(il)=zqev_diag(cas(il))*ptrac(il)
 !#ifdef ISOVERIF              
-!            if (il.eq.9) then
-!              write(*,*) 'compress tmp: il, ptrac=',il,ptrac(il)
-!              write(*,*) 'ieau,zxtrfl_ancien(ieau,cas(il))=',
+!            if (il.eq.9) THEN
+!              WRITE(*,*) 'compress tmp: il, ptrac=',il,ptrac(il)
+!              WRITE(*,*) 'ieau,zxtrfl_ancien(ieau,cas(il))=',
 !     :           ieau,zxtrfl_ancien(ieau,cas(il))
-!              write(*,*) 'zrfl_ancien(cas(il))=',zrfl_ancien(cas(il))
-!              write(*,*) 'zrfl_cas(il)=',zrfl_cas(il)
+!              WRITE(*,*) 'zrfl_ancien(cas(il))=',zrfl_ancien(cas(il))
+!              WRITE(*,*) 'zrfl_cas(il)=',zrfl_cas(il)
 !            endif
 !#endif
 
-          else !if (zrfl_ancien(cas(il)).gt.0.0) then
+          else !if (zrfl_ancien(cas(il)).gt.0.0) THEN
 #ifdef ISOVERIF  
-!              write(*,*) 'il,cas(il),zrfln,zrfl_ancien,zqev_diag=',
+!              WRITE(*,*) 'il,cas(il),zrfln,zrfl_ancien,zqev_diag=',
 !     :              il,cas(il),zrfln(cas(il)),zrfl_ancien(cas(il)),
 !     :              zqev_diag(cas(il))   
@@ -955,5 +946,5 @@
                 zqev_diag_cas(il)=0.0
                
-          endif !if (zrfl_ancien(cas(il)).gt.0.0) then
+          endif !if (zrfl_ancien(cas(il)).gt.0.0) THEN
           ! les lignes suvantes ne sont pas à recalculer
 !          zt_cas(il)=zt(cas(il))
@@ -1011,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)))
@@ -1020,5 +1011,5 @@
              zqev_diag_cas(il)=zqev_diag(cas(il)) &
                *zxtrfl_ancien(ieau,cas(il))/zrfl_ancien(cas(il))
-          else !if (zrfl_ancien(cas(il)).gt.0.0) then
+          else !if (zrfl_ancien(cas(il)).gt.0.0) THEN
 #ifdef ISOVERIF  
               CALL iso_verif_egalite(zqev_diag(cas(il)),0.0, &
@@ -1029,5 +1020,5 @@
                 zrfln_cas(il)=0.0
                 zqev_diag_cas(il)=0.0
-          endif !if (zrfl_ancien(cas(il)).gt.0.0) then
+          endif !if (zrfl_ancien(cas(il)).gt.0.0) THEN
          enddo
 
@@ -1041,5 +1032,5 @@
 USE isotopes_verif_mod
 #endif
-USE isotrac_mod, only: izone_revap
+USE isotrac_mod, ONLY: izone_revap
       IMPLICIT NONE
 
@@ -1081,7 +1072,7 @@
 #ifdef ISOVERIF
                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)
+                         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)
 !                  stop
                endif
@@ -1106,5 +1097,5 @@
 
       function is_in_bassin(lat,lon,bassin)
-      USE isotrac_mod, only: use_bassin_atlantic,use_bassin_medit, &
+      USE isotrac_mod, ONLY: use_bassin_atlantic,use_bassin_medit, &
 &       use_bassin_indian,use_bassin_austral,use_bassin_pacific, &
 &       use_bassin_MerArabie,use_bassin_BengalGolf,use_bassin_SouthIndian, &
@@ -1130,162 +1121,162 @@
       is_in_bassin=.FALSE.
 #ifdef ISOVERIF      
-      write(*,*) 'is_in_basin 84: entree,bassin=',bassin
-#endif
-      if (use_bassin_atlantic .and. bassin==bassin_atlantic) then
+      WRITE(*,*) 'is_in_basin 84: entree,bassin=',bassin
+#endif
+      if (use_bassin_atlantic .and. bassin==bassin_atlantic) THEN
 #ifdef ISOVERIF           
-          write(*,*) 'bassin Atlantique?'
+          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
+            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
+            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
+            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
+            RETURN
           endif
           if (is_in_triangle(lon,lat, &
-                 -62.0,0.0,-62.0,30.0,-112.0,30.0)) then
+                 -62.0,0.0,-62.0,30.0,-112.0,30.0)) THEN
             ! golfe du Mexique
             is_in_bassin=.TRUE.
-            return
+            RETURN
           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?'
+          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
+            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
+            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?'
+          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
+            RETURN
           endif
           if (is_in_triangle(lon,lat, &
-                 90.0,30.0,90.0,-45.0,150.0,-45.0)) then
+                 90.0,30.0,90.0,-45.0,150.0,-45.0)) THEN
             ! Ouest Australie
             is_in_bassin=.TRUE.
-            return
+            RETURN
           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?'
+          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
+            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?'
+          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
+            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?'
+          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
+            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?'
+          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
+            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
+            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
+            RETURN
           endif
           if (is_in_triangle(lon,lat, &
-                  90.0,28.0,150.0,-45.0,150.0,28.0)) then
+                  90.0,28.0,150.0,-45.0,150.0,28.0)) THEN
             ! Pacifque Sud Ouest
             is_in_bassin=.TRUE.
-            return
+            RETURN
           endif
           if (is_in_triangle(lon,lat, &
-                  -62.0,0.0,-112.0,30.0,-112.0,0.0)) then
+                  -62.0,0.0,-112.0,30.0,-112.0,0.0)) THEN
             ! Ouest Amérique centrale
             is_in_bassin=.TRUE.
-            return
+            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.
-            return
+            RETURN
           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?'
+          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?'
+          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?'
+          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?'
+          WRITE(*,*) 'bassin mid lats?'
 #endif           
           if ((abs(lat).ge.15.0).and. &
-                 (abs(lat).le.35.0)) then
+                 (abs(lat).le.35.0)) THEN
                 is_in_bassin=.TRUE.
                 return    
@@ -1293,27 +1284,27 @@
 
       else
-          write(*,*) 'iso_traceurs_routines 59: bassin inconnu'
-          write(*,*) 'bassin_atlantic=' ,bassin_atlantic  
-          write(*,*) 'bassin_medit=' ,bassin_medit
-          write(*,*) 'bassin_indian=' ,bassin_indian
-          write(*,*) 'bassin_austral=' ,bassin_austral
-          write(*,*) 'bassin_MerArabie=' ,bassin_MerArabie
-          write(*,*) 'bassin_BengalGolf=' ,bassin_BengalGolf
-          write(*,*) 'bassin_SouthIndian=' ,bassin_SouthIndian
-          write(*,*) 'use_bassin_atlantic=' ,use_bassin_atlantic  
-          write(*,*) 'use_bassin_medit=' ,use_bassin_medit
-          write(*,*) 'use_bassin_indian=' ,use_bassin_indian
-          write(*,*) 'use_bassin_austral=' ,use_bassin_austral
-          write(*,*) 'use_bassin_MerArabie=' ,use_bassin_MerArabie
-          write(*,*) 'use_bassin_BengalGolf=' ,use_bassin_BengalGolf
-          write(*,*) 'use_bassin_SouthIndian=' ,use_bassin_SouthIndian
+          WRITE(*,*) 'iso_traceurs_routines 59: bassin inconnu'
+          WRITE(*,*) 'bassin_atlantic=' ,bassin_atlantic
+          WRITE(*,*) 'bassin_medit=' ,bassin_medit
+          WRITE(*,*) 'bassin_indian=' ,bassin_indian
+          WRITE(*,*) 'bassin_austral=' ,bassin_austral
+          WRITE(*,*) 'bassin_MerArabie=' ,bassin_MerArabie
+          WRITE(*,*) 'bassin_BengalGolf=' ,bassin_BengalGolf
+          WRITE(*,*) 'bassin_SouthIndian=' ,bassin_SouthIndian
+          WRITE(*,*) 'use_bassin_atlantic=' ,use_bassin_atlantic
+          WRITE(*,*) 'use_bassin_medit=' ,use_bassin_medit
+          WRITE(*,*) 'use_bassin_indian=' ,use_bassin_indian
+          WRITE(*,*) 'use_bassin_austral=' ,use_bassin_austral
+          WRITE(*,*) 'use_bassin_MerArabie=' ,use_bassin_MerArabie
+          WRITE(*,*) 'use_bassin_BengalGolf=' ,use_bassin_BengalGolf
+          WRITE(*,*) 'use_bassin_SouthIndian=' ,use_bassin_SouthIndian
           stop
       endif
       
 
-      end function is_in_bassin
+      END FUNCTION is_in_bassin
 
       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
@@ -1334,27 +1325,27 @@
      
 #ifdef ISOVERIF       
-      write(*,*) ''
-      write(*,*) 'find bassin lat,lon=',lat,lon
+      WRITE(*,*) ''
+      WRITE(*,*) 'find bassin lat,lon=',lat,lon
 #endif       
       do while (continu)
 !#ifdef ISOVERIF       
-!!      write(*,*) 'find_bassin 169: lat,lon,bassin=',lat,lon,bassin
+!!      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                 
-                write(*,*) 'find_bassin 173: trouve: bassin=',bassin
+                WRITE(*,*) 'find_bassin 173: trouve: bassin=',bassin
 #endif                 
          else
 !#ifdef ISOVERIF              
-!             write(*,*) 'find_bassin 175: pas trouve: bassin=',bassin
+!             WRITE(*,*) 'find_bassin 175: pas trouve: bassin=',bassin
 !#endif              
              bassin=bassin+1
          endif
-         if (bassin.eq.izone_poubelle) then
+         if (bassin.eq.izone_poubelle) THEN
                 continu=.FALSE.
                 bassin=izone_poubelle
 !#ifdef ISOVERIF                 
-!                write(*,*) 'find_bassin 179: poubelle: bassin=',bassin
+!                WRITE(*,*) 'find_bassin 179: poubelle: bassin=',bassin
 !#endif  
          endif
@@ -1372,7 +1363,7 @@
 
         SUBROUTINE initialise_bassins_boites(presnivs)
-        USE dimphy, only: klev
+        USE dimphy, ONLY: klev
         USE lmdz_geometry, ONLY: longitude_deg, latitude_deg
-        use isotrac_mod, only: bassin_map,option_traceurs,boite_map
+        use isotrac_mod, ONLY: bassin_map,option_traceurs,boite_map
 #ifdef ISOVERIF
         use isotopes_verif_mod
@@ -1381,14 +1372,14 @@
         real presnivs(klev)
 
-       if (option_traceurs.eq.3) then
+       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'
+           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
@@ -1398,5 +1389,5 @@
 
         SUBROUTINE bassin_map_init(lat,lon,bassin_map)
-        USE dimphy, only: klon
+        USE dimphy, ONLY: klon
 #ifdef ISOVERIF
         use isotopes_verif_mod
@@ -1415,5 +1406,5 @@
              CALL find_bassin(lat(i),lon(i),bassin_map(i))
 #ifdef ISOVERIF              
-             write(*,*) 'init 233: i,lat,lon,bassin=',i,lat(i),lon(i), &
+             WRITE(*,*) 'init 233: i,lat,lon,bassin=',i,lat(i),lon(i), &
                   bassin_map(i)
 #endif             
@@ -1435,9 +1426,9 @@
 
 !#ifdef ISOVERIF        
-!        write(*,*) 'is_in_rectange 237: x,y=',x,y
-!        write(*,*) 'x1,y1,x2,y2=',x1,y1,x2,y2
+!        WRITE(*,*) 'is_in_rectange 237: x,y=',x,y
+!        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
+                  (y-y1.lt.0.1).and.(y-y2.gt.-0.1)) THEN
           is_in_rectangle=.TRUE.
         else
@@ -1445,8 +1436,8 @@
         endif
 !#ifdef ISOVERIF        
-!        write(*,*) 'is_in_rectangle=',is_in_rectangle
+!        WRITE(*,*) 'is_in_rectangle=',is_in_rectangle
 !#endif        
 
-        end function is_in_rectangle
+        END FUNCTION is_in_rectangle
 
         function is_in_triangle(x,y,x1,y1,x2,y2,x3,y3)
@@ -1468,6 +1459,6 @@
         real det3
 !#ifdef ISOVERIF
-!        write(*,*) 'is_in_triange 271: x,y=',x,y
-!        write(*,*) 'x1,y1,x2,y2,x3,y3=',x1,y1,x2,y2,x3,y3
+!        WRITE(*,*) 'is_in_triange 271: x,y=',x,y
+!        WRITE(*,*) 'x1,y1,x2,y2,x3,y3=',x1,y1,x2,y2,x3,y3
 !#endif        
         det1=(x1-x)*(y2-y)-(y1-y)*(x2-x)
@@ -1475,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
@@ -1481,14 +1472,14 @@
         endif
 !#ifdef ISOVERIF        
-!        write(*,*) 'det1,det2,det3,is_in_triangle',
+!        WRITE(*,*) 'det1,det2,det3,is_in_triangle',
 !     :         det1,det2,det3,is_in_triangle
 !#endif
 
-        end function is_in_triangle
+        END FUNCTION is_in_triangle
 
 
         SUBROUTINE isotrac_recolorise_tmin(xt,t)
-        USE dimphy, only: klon, klev
-        USE isotrac_mod, only: zone_temp,nzone_temp
+        USE dimphy, ONLY: klon, klev
+        USE isotrac_mod, ONLY: zone_temp,nzone_temp
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -1510,7 +1501,7 @@
           do i=1,klon
 !#ifdef ISOVERIF
-!            if (i.eq.1) then
-!                write(*,*) 'recolorise 396: i,k,t=',i,k,t(i,k)
-!                write(*,*) 'zone_temp=',zone_temp     
+!            if (i.eq.1) THEN
+!                WRITE(*,*) 'recolorise 396: i,k,t=',i,k,t(i,k)
+!                WRITE(*,*) 'zone_temp=',zone_temp
 !            endif
 !#endif           
@@ -1519,6 +1510,6 @@
 
 !#ifdef ISOVERIF
-!            if (i.eq.1) then
-!                write(*,*) 'recolorise 414: izone_temp=',izone_temp    
+!            if (i.eq.1) THEN
+!                WRITE(*,*) 'recolorise 414: izone_temp=',izone_temp
 !            endif
 !#endif            
@@ -1527,10 +1518,10 @@
                ! températures plus basses sont convertis
 !#ifdef ISOVERIF
-!            if (i.eq.1) then
-!                write(*,*) 'recolorise 405: izone,xt_eau=',
+!            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
@@ -1539,8 +1530,8 @@
                    xt(ixt,i,k)=0.0 
                   enddo !do iiso=1,niso
-               endif  !if (izone.lt.izone_temp) then
+               endif  !if (izone.lt.izone_temp) THEN
 !#ifdef ISOVERIF
-!            if (i.eq.1) then
-!                write(*,*) 'recolorise 419: xt_eau,xt_recoit=',
+!            if (i.eq.1) THEN
+!                WRITE(*,*) 'recolorise 419: xt_eau,xt_recoit=',
 !     :               xt(index_trac(izone,iso_eau),i,k),
 !     :               xt(index_trac(izone_temp,iso_eau),i,k)
@@ -1573,6 +1564,6 @@
 
         SUBROUTINE isotrac_recolorise_tmin_sfrev(xt,t)
-        USE dimphy, only: klon,klev
-        USE isotrac_mod, only: nzone_temp,zone_temp
+        USE dimphy, ONLY: klon,klev
+        USE isotrac_mod, ONLY: nzone_temp,zone_temp
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -1603,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
@@ -1610,5 +1601,5 @@
                    xt(ixt,i,k)=0.0 
                   enddo !do iiso=1,niso
-               endif  !if (izone.lt.izone_temp) then
+               endif  !if (izone.lt.izone_temp) THEN
             enddo !do izone=1,zone_pot(k)-1
 
@@ -1629,5 +1620,5 @@
 
         SUBROUTINE isotrac_recolorise_saturation(xt,rh,lat,pres)
-        USE dimphy, only: klon,klev
+        USE dimphy, ONLY: klon,klev
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -1665,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
@@ -1677,5 +1668,5 @@
                  endif
                 enddo !do izone=1,ntraceurs_zone
-            endif !if (rh(i,k).gt.rh_seuil) then
+            endif !if (rh(i,k).gt.rh_seuil) THEN
           enddo !do i=1,klon
         enddo !do k=1,klev
@@ -1693,5 +1684,5 @@
 
         SUBROUTINE isotrac_recolorise_boite(xt,boite_map)
-        USE dimphy, only: klon,klev
+        USE dimphy, ONLY: klon,klev
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -1714,9 +1705,9 @@
           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
@@ -1727,7 +1718,7 @@
                         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
+            endif !if (izone_recoit.gt.0) THEN
           enddo !do i=1,klon
         enddo !do k=1,klev
@@ -1745,6 +1736,6 @@
 
         SUBROUTINE isotrac_recolorise_extra(xt,rlat)
-        USE dimphy, only: klon,klev
-        usE isotrac_mod, only: lim_tag20,izone_trop,izone_extra
+        USE dimphy, ONLY: klon,klev
+        usE isotrac_mod, ONLY: lim_tag20,izone_trop,izone_extra
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -1764,8 +1755,8 @@
         integer iiso,ixt,ixt_recoit
        
-!        write(*,*) 'iso_traceurs_routines 723: lim_tag20=',lim_tag20
+!        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
@@ -1776,5 +1767,5 @@
                         xt(ixt,i,k)=0.0
                  enddo                  
-            endif ! if (abs(rlat(i)).lt.35.0) then
+            endif ! if (abs(rlat(i)).lt.35.0) THEN
           enddo !do i=1,klon
         enddo !do k=1,klev
@@ -1792,6 +1783,6 @@
 
         SUBROUTINE isotrac_recolorise_conv(xt,rlat,presnivs,rain_con)
-        USE dimphy, only: klon,klev
-        use isotrac_mod, only: lim_precip_tag22, &
+        USE dimphy, ONLY: klon,klev
+        use isotrac_mod, ONLY: lim_precip_tag22, &
 &       izone_conv_BT,izone_conv_UT
 #ifdef ISOVERIF
@@ -1814,19 +1805,18 @@
         integer iiso,ixt,ixt_recoit,izone
        
-!        write(*,*) 'iso_traceurs_routines 723: lim_tag20=',lim_tag20
-!        write(*,*) 'presnivs=',presnivs
+!        WRITE(*,*) 'iso_traceurs_routines 723: lim_tag20=',lim_tag20
+!        WRITE(*,*) 'presnivs=',presnivs
 !        stop
         do k=1,klev
           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. &
-                  (rain_con(i)*86400.gt.lim_precip_tag22)) then
-            
+                  (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
@@ -1835,15 +1825,15 @@
                   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
-!                write(*,*) 'k,presnivs,ixt,ixt_recoit=',k,presnivs(k),
+!                WRITE(*,*) 'k,presnivs,ixt,ixt_recoit=',k,presnivs(k),
 !     :                   ixt,ixt_recoit
-!                write(*,*) 'xt(:,i,k)=',xt(:,i,k)
-            endif ! if (abs(rlat(i)).lt.35.0) then
+!                WRITE(*,*) 'xt(:,i,k)=',xt(:,i,k)
+            endif ! if (abs(rlat(i)).lt.35.0) THEN
           enddo !do i=1,klon
         enddo !do k=1,klev
@@ -1862,9 +1852,9 @@
 
         SUBROUTINE boite_AMMA_init(lat,lon,presnivs,boite_map)
-        USE dimphy, only: klon,klev
+        USE dimphy, ONLY: klon,klev
 #ifdef ISOVERIF
         USE isotopes_verif_mod
 #endif
-        USE isotrac_mod, only: izone_aej,izone_mousson,izone_harmattan
+        USE isotrac_mod, ONLY: izone_aej,izone_mousson,izone_harmattan
         IMPLICIT NONE
 
@@ -1876,10 +1866,10 @@
         integer i,k
 
-!        write(*,*) 'izone_aej,izone_mousson,izone_harmattan=',
+!        WRITE(*,*) 'izone_aej,izone_mousson,izone_harmattan=',
 !     :       izone_aej,izone_mousson,izone_harmattan    
         do k=1,klev
           do i=1,klon
                 boite_map(i,k)=0.0
-!                write(*,*) 'i,k,lat,lon,pres=',
+!                WRITE(*,*) 'i,k,lat,lon,pres=',
 !     :                   i,k,lat(i),lon(i),presnivs(k)
                 if ((presnivs(k).le.700.0*100.0).and. &
@@ -1888,23 +1878,23 @@
                     (lat(i).lt.20.0).and. &
                     (lon(i).gt.10.0).and. &
-                    (lon(i).lt.30.0)) then
+                    (lon(i).lt.30.0)) THEN
                    boite_map(i,k)=izone_aej
-!                   write(*,*) '   -> zone 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. &
-                    (lon(i).lt.15.0)) then
+                    (lon(i).lt.15.0)) THEN
                    boite_map(i,k)=izone_mousson
-!                   write(*,*) '   -> zone flux de 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. &
-                    (lon(i).lt.40.0)) then
+                    (lon(i).lt.40.0)) THEN
                    boite_map(i,k)=izone_harmattan
-!                   write(*,*) '   -> zone Harmattan'
+!                   WRITE(*,*) '   -> zone Harmattan'
                 endif
-!                write(*,*) '   ** boite_map=',boite_map(i,k)
+!                WRITE(*,*) '   ** boite_map=',boite_map(i,k)
           enddo
         enddo
@@ -1915,6 +1905,6 @@
         
         SUBROUTINE boite_UT_extra_init(lat,lon,presnivs,boite_map)
-        USE dimphy, only: klon,klev
-        use isotrac_mod, only: izone_extra,izone_trop
+        USE dimphy, ONLY: klon,klev
+        use isotrac_mod, ONLY: izone_extra,izone_trop
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -1929,20 +1919,20 @@
         integer i,k
 
-!        write(*,*) 'izone_trop,izone_extra=',
+!        WRITE(*,*) 'izone_trop,izone_extra=',
 !     :       izone_trop,izone_extra    
         do k=1,klev
           do i=1,klon
                 boite_map(i,k)=0.0
-!                write(*,*) 'i,k,lat,lon,pres=',
+!                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
+                    .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
+!                   WRITE(*,*) '   -> zone trop'
+                else if (abs(lat(i)).gt.35.0) THEN
                    boite_map(i,k)=izone_extra
-!                   write(*,*) '   -> zone extratropiques'
+!                   WRITE(*,*) '   -> zone extratropiques'
                 endif
-!                write(*,*) '   ** boite_map=',boite_map(i,k)
+!                WRITE(*,*) '   ** boite_map=',boite_map(i,k)
           enddo
         enddo
@@ -1953,5 +1943,5 @@
 
         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
 
@@ -1961,5 +1951,5 @@
         integer index_zone_lat
 
-        if (lat.lt.lattag_min) then
+        if (lat.lt.lattag_min) THEN
                 index_zone_lat=1
         else
@@ -1969,9 +1959,9 @@
 
 
-        end function index_zone_lat
+        END FUNCTION index_zone_lat
 
 
         function index_zone_pres(pres)
-        use isotrac_mod, only: nzone_pres,zone_pres
+        use isotrac_mod, ONLY: nzone_pres,zone_pres
         IMPLICIT NONE
 
@@ -1984,10 +1974,10 @@
         
         index_zone_pres=find_index(pres,nzone_pres,zone_pres) 
-        write(*,*) 'iso_traceurs_routines 802: pres,index_zone_pres=', &
+        WRITE(*,*) 'iso_traceurs_routines 802: pres,index_zone_pres=', &
                  pres,index_zone_pres
-        write(*,*) 'zone_pres=',zone_pres(1:nzone_pres-1)
-
-
-        end function index_zone_pres
+        WRITE(*,*) 'zone_pres=',zone_pres(1:nzone_pres-1)
+
+
+        END FUNCTION index_zone_pres
 
         function find_index(pres,nzone_pres,zone_pres)
@@ -2002,14 +1992,14 @@
         logical continu
 
-        if (nzone_pres.gt.1) then
-          if (pres.ge.zone_pres(1)) then
+        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
+          else !if (t(i,k).ge.zone_temp1) THEN
                 continu=.TRUE.
                 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
@@ -2018,15 +2008,12 @@
                   endif     
                 enddo !do while (continu)
-           endif !if (t(i,k).ge.zone_temp1) then
-
-        else !if (nzone_pres.gt.1) then
+           endif !if (t(i,k).ge.zone_temp1) THEN
+        else !if (nzone_pres.gt.1) THEN
             find_index=1
-        endif !if (nzone_pres.gt.1) then
-
-
-        end function find_index
+        endif !if (nzone_pres.gt.1) THEN
+        END FUNCTION find_index
 
         function index_zone_latpres(lat,pres)
-        use isotrac_mod, only: nzone_lat
+        use isotrac_mod, ONLY: nzone_lat
         IMPLICIT NONE
 
@@ -2046,12 +2033,12 @@
 
 
-        end function index_zone_latpres
+        END FUNCTION index_zone_latpres
 
         SUBROUTINE iso_recolorise_condensation(qt,cond, &
                  xt,zxtcond,tcond,ep,xtres, &
                  seuil_in)
-        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 dimphy, ONLY: klon,klev
+        USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau
+        use isotrac_mod, ONLY: option_seuil_tag_tmin,izone_cond, &
 &       nzone_temp,zone_temp
 #ifdef ISOVERIF
@@ -2085,6 +2072,5 @@
 !        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    
@@ -2100,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 +2097,5 @@
             xtres(ixt)=0.0
           enddo
-!          write(*,*) 'iso_trac_routines tmp 916: xtres=',xtres
+!          WRITE(*,*) 'iso_trac_routines tmp 916: xtres=',xtres
 
 #ifdef ISOVERIF 
@@ -2122,8 +2108,8 @@
              ! cas de izone sfc et izone precip et izone cond et izone< izone_temp
 
-!             write(*,*) 'iso_trac 940: cond/qt,seuil_in,izone_temp=',
+!             WRITE(*,*) 'iso_trac 940: cond/qt,seuil_in,izone_temp=',
 !     :                   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 
@@ -2131,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
@@ -2140,9 +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  
@@ -2152,28 +2137,26 @@
                          +(xt(ixt)-zxtcond(ixt))
                    xtres(ixt)=0.0   
-!                   write(*,*) 'iso_trac 920: izone,ixt,',
+!                   WRITE(*,*) 'iso_trac 920: izone,ixt,',
 !     :                 'ixt_recoit=',
 !     :                 izone,ixt,ixt_recoit     
-!                   write(*,*) 'isotrac 924: xt=',xt
-!                   write(*,*) 'isotrac 925: zxtcond=',zxtcond
+!                   WRITE(*,*) 'isotrac 924: xt=',xt
+!                   WRITE(*,*) 'isotrac 925: zxtcond=',zxtcond
                  enddo !do iiso=1,niso
-!                 write(*,*) 'iso_trac tmp 944: izone,xtres=',izone,xtres
-                endif !if (izone.ne.izone_cond) then  
+!                 WRITE(*,*) 'iso_trac tmp 944: izone,xtres=',izone,xtres
+                endif !if (izone.ne.izone_cond) THEN
               enddo !do izone=nzones_temp+1,ntraceurs_zone
 
-             else !if (cond/qt.gt.seuil_in) then
-                
+             else !if (cond/qt.gt.seuil_in) THEN
                 ! 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
 
-             endif !if (cond/qt.gt.seuil_in) then
-
+             endif !if (cond/qt.gt.seuil_in) THEN
               ! izone_temp est conservé, on lui enlève juste son
               ! condesat
@@ -2197,24 +2180,23 @@
                    ixt= index_trac(izone,iiso)
                    xtres(ixt)=xt(ixt)-zxtcond(ixt)
-!                   write(*,*) 'iso_trac 931: izone,ixt,ixt_recoit=',
+!                   WRITE(*,*) 'iso_trac 931: izone,ixt,ixt_recoit=',
 !     :                 izone,ixt,ixt_recoit       
-!                   write(*,*) 'isotrac 934: xt=',xt
-!                   write(*,*) 'isotrac 935: zxtice=',zxtice
+!                   WRITE(*,*) 'isotrac 934: xt=',xt
+!                   WRITE(*,*) 'isotrac 935: zxtice=',zxtice
                enddo !do iiso=1,niso  
-!               write(*,*) 'iso_trac tmp 965: izone,xtres=',izone,xtres
+!               WRITE(*,*) 'iso_trac tmp 965: izone,xtres=',izone,xtres
              enddo !do izone=izone_temp+1,nzones_temp
 
              ! 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) 
                    xtres(ixt)=xtres(ixt)+(1.0-ep)*zxtcond(iiso)
-!                   write(*,*) 'iso_trac 940: izone,ixt,ixt_recoit=',
+!                   WRITE(*,*) 'iso_trac 940: izone,ixt,ixt_recoit=',
 !     :                 izone,ixt,ixt_recoit     
-!                   write(*,*) 'isotrac 1014: xt=',xt
-!                   write(*,*) 'isotrac 945: zxtice=',zxtice
+!                   WRITE(*,*) 'isotrac 1014: xt=',xt
+!                   WRITE(*,*) 'isotrac 945: zxtice=',zxtice
                 enddo  !do iiso=1,niso      
-            endif !if (ep.lt.0.0) then
-
+            endif !if (ep.lt.0.0) THEN
         else
             ! si cond=0 ou qt=0, tot reste pareil
@@ -2223,13 +2205,12 @@
            enddo  !do ixt=1,ntraciso     
 
-        endif ! if (qt.gt.0.0) then    
-
+        endif ! if (qt.gt.0.0) THEN
 #ifdef ISOVERIF
         if (iso_verif_traceur_jm_nostop(xtres, &
-                'iso_trac_routines 166').eq.1) then
-          write(*,*) 'isotrac 1024: xt=',xt
-          write(*,*) 'zxtcond=',zxtcond
-          write(*,*) 'xtres=',xtres
-          write(*,*) 'ep=',ep
+                'iso_trac_routines 166').eq.1) THEN
+          WRITE(*,*) 'isotrac 1024: xt=',xt
+          WRITE(*,*) 'zxtcond=',zxtcond
+          WRITE(*,*) 'xtres=',xtres
+          WRITE(*,*) 'ep=',ep
           stop
         endif 
@@ -2239,17 +2220,17 @@
           CALL iso_verif_positif(xtres(ixt),'iso_trac_routines 953')
         enddo
-        if (nzone_temp.ge.5) 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
-            write(*,*) 'xtres=',xtres
-            write(*,*) 'ep=',ep
-            write(*,*) 'tcond=',tcond
-            write(*,*) 'izone_temp=',izone_temp
+                 'iso_trac_routines 1025').eq.1) THEN
+            WRITE(*,*) 'xt=',xt
+            WRITE(*,*) 'zxtcond=',zxtcond
+            WRITE(*,*) 'xtres=',xtres
+            WRITE(*,*) 'ep=',ep
+            WRITE(*,*) 'tcond=',tcond
+            WRITE(*,*) 'izone_temp=',izone_temp
             stop
         endif
         endif
-!       write(*,*) 'isotrac 1048: sortie de iso_recolorise_condensation'
+!       WRITE(*,*) 'isotrac 1048: sortie de iso_recolorise_condensation'
 #endif
 
@@ -2258,6 +2239,6 @@
 
         SUBROUTINE bassin_map_init_opt20(lat,bassin_map)
-        USE dimphy, only: klon
-        use isotrac_mod, only: izone_cont,izone_trop,lim_tag20
+        USE dimphy, ONLY: klon
+        use isotrac_mod, ONLY: izone_cont,izone_trop,lim_tag20
 #ifdef ISOVERIF
         USE isotopes_verif_mod
@@ -2272,7 +2253,7 @@
         integer i
 
-        write(*,*) 'iso_traceurs_routines 1142: lim_tag20=',lim_tag20
+        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  
@@ -2286,6 +2267,6 @@
         SUBROUTINE isotrac_recolorise_general(xt_seri,t_seri,zx_rh,presnivs)
         USE lmdz_geometry, ONLY: latitude_deg
-        USE dimphy, only: klon,klev
-        use isotrac_mod, only: option_traceurs,boite_map
+        USE dimphy, ONLY: klon,klev
+        use isotrac_mod, ONLY: option_traceurs,boite_map
         IMPLICIT NONE
 
@@ -2296,18 +2277,16 @@
         real, dimension(klev), intent(in) :: presnivs
 
-              if (option_traceurs.eq.4) then
+              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
+                  (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
 
@@ -2317,5 +2296,5 @@
         SUBROUTINE iso_verif_traceur_jbid_vect(x,n,m)
         USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
-        !use isotrac_mod, only: ntraceurs_zone=>nzone
+        !use isotrac_mod, ONLY: ntraceurs_zone=>nzone
         USE infotrac_phy, ONLY: ntraceurs_zone=>nzone
         IMPLICIT NONE
@@ -2330,5 +2309,5 @@
        real xtractot(n,m)
                 
-        if (bidouille_anti_divergence) then        
+        if (bidouille_anti_divergence) THEN
         do iiso=1,niso
 
@@ -2354,9 +2333,9 @@
             do j=1,m
              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*10) 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) 
-              endif !if (abs(xtractot(i,j)).gt.ridicule*10) then
+              endif !if (abs(xtractot(i,j)).gt.ridicule*10) THEN
              enddo !do i=1,n
             enddo !do j=1,m   
@@ -2369,13 +2348,12 @@
 !             do i=1,n
 !              if ((abs(xtractot(i,j)).lt.1e-18).and.
-!     :           (x(iiso,i,j).gt.ridicule)) then
+!     :           (x(iiso,i,j).gt.ridicule)) THEN
 !                  x(ixt,i,j)=x(iiso,i,j)
-!              endif !if (abs(xtractot(i,j)).gt.ridicule*10) then
+!              endif !if (abs(xtractot(i,j)).gt.ridicule*10) THEN
 !             enddo ! do i=1,n
 !           enddo !do j=1,m
 
         enddo !do iiso=1,ntraceurs_iso  
-        endif !if (bidouille_anti_divergence) then    
-
+        endif !if (bidouille_anti_divergence) THEN
         END SUBROUTINE  iso_verif_traceur_jbid_vect
 
@@ -2394,6 +2372,5 @@
        real xtractot
         
-        if (bidouille_anti_divergence) then
-
+        if (bidouille_anti_divergence) THEN
         do iiso=1,niso
 
@@ -2406,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) 
@@ -2414,6 +2391,5 @@
 
         enddo !do iiso=1,ntraceurs_iso   
-        endif !if (bidouille_anti_divergence) then     
-
+        endif !if (bidouille_anti_divergence) THEN
         END SUBROUTINE  iso_verif_traceur_jbidouille
 
@@ -2422,5 +2398,5 @@
         USE isotopes_mod, ONLY: bidouille_anti_divergence,iso_eau,ridicule
 !#ifdef ISOVERIF
-!        use isotopes_verif_mod, only: iso_verif_traceur_pbidouille
+!        use isotopes_verif_mod, ONLY: iso_verif_traceur_pbidouille
 !#endif
         IMPLICIT NONE
@@ -2443,7 +2419,6 @@
        real xtractot,xtractotprec
         
-        if (bidouille_anti_divergence) then
-
-!            write(*,*) 'pgm 532 tmp: x=',x
+        if (bidouille_anti_divergence) THEN
+!            WRITE(*,*) 'pgm 532 tmp: x=',x
         do iiso=1,niso
 
@@ -2456,11 +2431,11 @@
             xtractot=xtractot+x(ixt)
           enddo !do izone=1,ntraceurs_zone
-!          write(*,*) 'iiso,xtractotprec,xtractot=',
+!          WRITE(*,*) 'iiso,xtractotprec,xtractot=',
 !     :          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) 
@@ -2470,5 +2445,5 @@
                 ! négatif   
 !                x(iiso)=xtractot
-              else  !if (abs(xtractot).gt.ridicule) then
+              else  !if (abs(xtractot).gt.ridicule) THEN
                 ! normallement, valeurs restantes très faibles
                 ! on ne fait rien. 
@@ -2479,7 +2454,6 @@
                   x(ixt)=max(x(ixt),0.0)
                 enddo !do izone=1,ntraceurs_zone
-              endif !if (abs(xtractot).gt.ridicule) then
-          endif !if (xtractot.gt.xtractotprec) then      
-
+              endif !if (abs(xtractot).gt.ridicule) THEN
+          endif !if (xtractot.gt.xtractotprec) THEN
         enddo !do iiso=1,ntraceurs_iso
 #ifdef ISOVERIF        
@@ -2488,6 +2462,5 @@
         CALL iso_verif_traceur_jbidouille(x)
 #endif
-        endif !if (bidouille_anti_divergence) then     
-
+        endif !if (bidouille_anti_divergence) THEN
         END SUBROUTINE  iso_verif_traceur_jbid_pos
 
@@ -2508,7 +2481,6 @@
        integer i,j
         
-        if (bidouille_anti_divergence) then
-
-!            write(*,*) 'pgm 532 tmp: x=',x
+        if (bidouille_anti_divergence) THEN
+!            WRITE(*,*) 'pgm 532 tmp: x=',x
                
         do iiso=1,niso          
@@ -2531,13 +2503,13 @@
             
           enddo !do izone=1,ntraceurs_zone
-!          write(*,*) 'iiso,xtractotprec,xtractot=',
+!          WRITE(*,*) 'iiso,xtractotprec,xtractot=',
 !     :          iiso,xtractotprec,xtractot
                   
          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) 
@@ -2547,5 +2519,5 @@
                 ! négatif   
 !                x(iiso)=xtractot
-              else  !if (abs(xtractot).gt.ridicule) then
+              else  !if (abs(xtractot).gt.ridicule) THEN
                 ! normallement, valeurs restantes très faibles
                 ! on ne fait rien. 
@@ -2556,6 +2528,6 @@
                   x(ixt,i,j)=max(x(ixt,i,j),0.0)
                 enddo !do izone=1,ntraceurs_zone
-              endif !if (abs(xtractot).gt.ridicule) then
-          endif !if (xtractot.gt.xtractotprec) then
+              endif !if (abs(xtractot).gt.ridicule) THEN
+          endif !if (xtractot.gt.xtractotprec) THEN
          enddo !do i=1,n      
          enddo !do j=1,m 
@@ -2568,6 +2540,5 @@
         CALL iso_verif_traceur_jbid_vect(x,n,m)
 #endif
-        endif !if (bidouille_anti_divergence) then     
-
+        endif !if (bidouille_anti_divergence) THEN
         END SUBROUTINE  iso_verif_traceur_jbid_pos_vect
 
@@ -2593,13 +2564,13 @@
        real dqtmp,factmp
         
-        if (bidouille_anti_divergence) then
-!        write(*,*) 'iso_verif_trac 578 tmp: q,xt=',
+        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
-!                    write(*,*) 'local_x<0 pour izone=',izone
+                if (x(ieau).lt.0.0) THEN
+!                    WRITE(*,*) 'local_x<0 pour izone=',izone
                     dqtmp=dqtmp-x(ieau)
                     do iiso=1,niso    
@@ -2607,9 +2578,9 @@
                       x(ixt) =0.0
                     enddo !do iiso=1,niso  
-                endif  !if (local_xt(ieau,i,k).lt.0.0) then                
+                endif  !if (local_xt(ieau,i,k).lt.0.0) THEN
               enddo !do izone=1,ntraceurs_zone
-!              write(*,*) 'dqtmp=',dqtmp
-              if (dqtmp.gt.0.0) then  
-!                  write(*,*) 'iso_verif_trac 593 warning: q,dqtmp,xt=',
+!              WRITE(*,*) 'dqtmp=',dqtmp
+              if (dqtmp.gt.0.0) THEN
+!                  WRITE(*,*) 'iso_verif_trac 593 warning: q,dqtmp,xt=',
 !     :                q,dqtmp,x(1:ntraciso)
                     ! on redistribue la négativité des traceurs dans les
@@ -2618,26 +2589,24 @@
                     ! correction janv 2010
                     factmp=(q/(q+dqtmp))
-!                    write(*,*) 'factmp=',factmp
+!                    WRITE(*,*) 'factmp=',factmp
                      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)
                              x(ixt)=x(ixt)*factmp
                           enddo !do iiso=1,niso
-                       endif !if (local_xt(ieau,i,k).gt.0.0) then
+                       endif !if (local_xt(ieau,i,k).gt.0.0) THEN
                      enddo ! do izone=1,ntraceurs_zone
-!                     write(*,*) 'apres bidouille: xt=',x(1:ntraciso)
-              endif !if (dqtmp.gt.0.0) then   
+!                     WRITE(*,*) 'apres bidouille: xt=',x(1:ntraciso)
+              endif !if (dqtmp.gt.0.0) THEN
 #ifdef ISOVERIF
               CALL iso_verif_traceur(x,'iso_verif_traceurs 612')
 #endif
-          endif !if (local_q(i,k).lt.0.0) then
-
+          endif !if (local_q(i,k).lt.0.0) THEN
 #ifdef ISOVERIF
         CALL iso_verif_traceur_pbidouille(x,'iso_verif_trac 625')
 #endif
-        endif ! if (bidouille_anti_divergence) then  
-
+        endif ! if (bidouille_anti_divergence) THEN
         END SUBROUTINE  iso_verif_traceur_jbid_pos2
 
@@ -2656,6 +2625,5 @@
        real xtractot
         
-        if (bidouille_anti_divergence) then
-
+        if (bidouille_anti_divergence) THEN
         do i=1,n
         do iiso=1,niso
@@ -2669,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) 
@@ -2678,6 +2646,5 @@
         enddo !do iiso=1,ntraceurs_iso  
         enddo  !do i=1,n
-        endif !if (bidouille_anti_divergence) then             
-
+        endif !if (bidouille_anti_divergence) THEN
         END SUBROUTINE  iso_verif_traceur_jbid_vect1D
       
@@ -2704,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
@@ -2712,5 +2679,5 @@
         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 isotrac_mod, ONLY: ridicule_trac
         use isotopes_verif_mod
         IMPLICIT NONE
@@ -2741,5 +2708,5 @@
         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
@@ -2748,5 +2715,5 @@
         ! verif masse
         if (iso_verif_tracm_choix_nostop(x,err_msg, &
-                 errmax*10,errmaxrel*50).eq.1) then
+                 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
@@ -2755,20 +2722,18 @@
         endif  
 
-        if (bidouille_anti_divergence) then
+        if (bidouille_anti_divergence) THEN
             ! on réajuste pour que les traceurs fasses bien la somme
             ! des traceurs
             CALL iso_verif_traceur_jbidouille(x)
-        endif !if (bidouille_anti_divergence) then    
-
+        endif !if (bidouille_anti_divergence) THEN
        ! verif deltaD
-       if (iso_HDO.gt.0) then
+       if (iso_HDO.gt.0) THEN
         if (iso_verif_tracdD_choix_nostop(x,err_msg, &
-                 ridicule_trac,deltalimtrac).eq.1) then
+                 ridicule_trac,deltalimtrac).eq.1) THEN
 !             stop
               iso_verif_traceur_pbid_ns=1
         endif  
-       endif !if (iso_HDO.gt.0) then
-
-        end function iso_verif_traceur_pbid_ns
+       endif !if (iso_HDO.gt.0) THEN
+        END FUNCTION iso_verif_traceur_pbid_ns
 
         SUBROUTINE iso_verif_traceur_pbid_vect(x,n,m,err_msg)
@@ -2793,12 +2758,11 @@
                  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
             CALL iso_verif_traceur_jbid_vect(x,n,m)
-        endif !if (bidouille_anti_divergence) then    
-
+        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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/limit_read_mod.F90	(revision 5116)
@@ -164,5 +164,5 @@
 #ifdef ISO
   real, intent(out), dimension(niso,klon) :: Roce 
-  integer :: ixt  
+  INTEGER :: ixt
   real, intent(in),dimension(klon) :: rlat
   real lat_locale
@@ -178,5 +178,5 @@
 
 #ifdef ISO
-     if (iso_HTO.gt.0) then
+     if (iso_HTO.gt.0) THEN
      if (ok_prod_nucl_tritium) then ! si on active la production nucleaire de tritium
         DO i = 1, knon
@@ -188,22 +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
+        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
                 sst_out(i)= sst_out(i)+deltaTtestpoles
             else
@@ -212,7 +210,7 @@
             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
+    endif !if (modif_sst.ge.1) THEN
 #endif
 #ifdef ISOVERIF
@@ -235,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.
@@ -244,6 +242,6 @@
         do i=1,knon
           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)
+              'limit_read 368').eq.1) THEN
+             WRITE(*,*) 'i,knindex,sst_out=',i,knindex,sst_out(i)
              stop
           endif
@@ -267,5 +265,5 @@
 ! 2) Read fraction, if not type_ocean=couple
 ! 3) Read sea surface temperature, if not type_ocean=couple
-! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
+! 4) Read albedo and rugosity for land surface, ONLY in case of no vegetation model
 ! 5) Close file and distribuate variables to all processus
 
@@ -526,7 +524,7 @@
              do ii=1,klon_glo
                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
+                'limit_read 384').eq.1) THEN
+                 WRITE(*,*) 'ii,sst_glo=',ii,sst_glo(ii)
+                 WRITE(*,*) 'jour,start,epais=',jour,start,epais
                  stop
                endif
@@ -538,5 +536,5 @@
 
 !****************************************************************************************
-! 4) Read albedo and rugosity for land surface, only in case of no vegetation model
+! 4) Read albedo and rugosity for land surface, ONLY in case of no vegetation model
 
 !****************************************************************************************
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90	(revision 5116)
@@ -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
@@ -329,10 +329,10 @@
   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)
      CALL getin_p('iflag_evap_prec',iflag_evap_prec)
      CALL getin_p('seuil_neb',seuil_neb)
-     write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp 
+     WRITE(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp
 
      WRITE(lunout,*) 'fisrtilp, ninter:', ninter
@@ -350,17 +350,17 @@
         ! cam verif 
 #ifdef ISOVERIF
-        write(*,*) 'ilp 310'
+        WRITE(*,*) 'ilp 310'
           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
+            endif !if (iso_eau.gt.0) 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')
-             endif !if (zq(i).gt.ridicule) then
-            endif  !if (iso_HDO.gt.0) then
+             endif !if (zq(i).gt.ridicule) THEN
+            endif  !if (iso_HDO.gt.0) THEN
            enddo !do k=1,klev
           enddo !do i=1,klon
@@ -371,5 +371,5 @@
            enddo
         enddo
-        write(*,*) 'ilp 331'
+        WRITE(*,*) 'ilp 331'
 #endif
          ! end cam verif
@@ -508,15 +508,15 @@
        ! verif en debut de boucle
 #ifdef ISOVERIF
-       !write(*,*) 'ilp 478: boucle en k: k=',k         
+       !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  
+        endif !if (iso_eau.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')
-        endif  !if (iso_HDO.gt.0) then  
+        endif  !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC   
         CALL iso_verif_traceur(zxtrfl(1,i), &
@@ -528,5 +528,5 @@
 #endif
 #ifdef ISOVERIF   
-        !write(*,*) 'ilp tmp 412'      
+        !WRITE(*,*) 'ilp tmp 412'
        do i=1,klon
          do ixt=1,ntraciso
@@ -546,6 +546,6 @@
         zq(i)=q(i,k)
 #ifdef ISOVERIF
-        if (q(i,k).lt.0.0) then
-               write(*,*) 'ilp 400: avant clmain 31janv: i,k,q=', &
+        if (q(i,k).lt.0.0) THEN
+               WRITE(*,*) 'ilp 400: avant clmain 31janv: i,k,q=', &
                  i,k,q(i,k)
                CALL abort_physic('ilp 484', 'on stop ', 1)
@@ -567,17 +567,17 @@
          ! cam verif
 #ifdef ISOVERIF
-         !write(*,*) 'ilp tmp 562'
+         !WRITE(*,*) 'ilp tmp 562'
              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
+          endif !if (iso_eau.gt.0) 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')
-             endif !if (zq(i).gt.ridicule) then
-          endif  !if (iso_HDO.gt.0) then  
+             endif !if (zq(i).gt.ridicule) THEN
+          endif  !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur(zxt(1,i),'ilp 431')
@@ -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 
@@ -652,6 +652,6 @@
       enddo   ! DO i = 1, klon  
 #ifdef ISOVERIF
-        !write(*,*) 'ilp tmp 616'
-      if (iso_eau.gt.0) then
+        !WRITE(*,*) 'ilp tmp 616'
+      if (iso_eau.gt.0) THEN
        DO i = 1, klon           
           CALL iso_verif_egalite_choix(zxt(iso_eau,i),zq(i), &
@@ -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
@@ -937,5 +937,5 @@
      ! Calculer Qs et L/Cp*dQs/dT:
 #ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 849'
+!        WRITE(*,*) 'ilp tmp 849'
            do i=1,klon
              CALL iso_verif_positif(370.0-zt(i),'il pleut 938')
@@ -944,37 +944,37 @@
               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_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)
-                     write(*,*) 'zrfl_ancien(i)=',zrfl_ancien(i)
-                     write(*,*) 'zrfln(i)=',zrfln(i)
-                     write(*,*) 'zq_ancien(i)=',zq_ancien(i)
-                     write(*,*) 'deltaD(zrfl_ancien)=',deltaD(zxtrfl_ancien(iso_HDO,i))
-                     write(*,*) 'deltaO(zrfl_ancien)=',deltaO(zxtrfl_ancien(iso_O18,i))
-                     write(*,*) 'deltaD(zq_ancien)=',deltaD(zxt_ancien(iso_HDO,i))
-                     write(*,*) 'deltaO(zq_ancien)=',deltaO(zxt_ancien(iso_O18,i))
-                     write(*,*) 'zt=',zt(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)
+                     WRITE(*,*) 'zrfl_ancien(i)=',zrfl_ancien(i)
+                     WRITE(*,*) 'zrfln(i)=',zrfln(i)
+                     WRITE(*,*) 'zq_ancien(i)=',zq_ancien(i)
+                     WRITE(*,*) 'deltaD(zrfl_ancien)=',deltaD(zxtrfl_ancien(iso_HDO,i))
+                     WRITE(*,*) 'deltaO(zrfl_ancien)=',deltaO(zxtrfl_ancien(iso_O18,i))
+                     WRITE(*,*) 'deltaD(zq_ancien)=',deltaD(zxt_ancien(iso_HDO,i))
+                     WRITE(*,*) 'deltaO(zq_ancien)=',deltaO(zxt_ancien(iso_O18,i))
+                     WRITE(*,*) 'zt=',zt(i)
                      stop
                 endif !if (iso_verif_O18_aberrant_nostop
-               endif !if (iso_O18.gt.0) then
-              endif !if (iso_HDO.gt.0) then
-             endif !if (zq(i).gt.ridicule) then                
+               endif !if (iso_O18.gt.0) THEN
+              endif !if (iso_HDO.gt.0) THEN
+             endif !if (zq(i).gt.ridicule) THEN
            enddo !do i=1,klon
 #ifdef ISOTRAC
-!      write(*,*) 'ilp tmp 633'
+!      WRITE(*,*) 'ilp tmp 633'
            do i=1,klon
               CALL iso_verif_traceur(zxtrfl(1,i),'il pleut 632')
            enddo
-!      write(*,*) 'ilp tmp 637,thermcep'
+!      WRITE(*,*) 'ilp tmp 637,thermcep'
 #endif           
 #endif    
 #ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 888'
+!        WRITE(*,*) 'ilp tmp 888'
            do i=1,klon
             do ixt=1,ntraciso
@@ -982,5 +982,5 @@
             enddo !do ixt=1,ntraciso
            enddo ! do i=1,klon
-!        write(*,*) 'ilp tmp 638: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
+!        WRITE(*,*) 'ilp tmp 638: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
 #endif
 
@@ -1018,6 +1018,6 @@
 
 !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
-!         write(*,*) " iflag_ice_thermo==1 requires iflag_fisrtilp_qsat==0", &
+!       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."
 !         stop
@@ -1056,11 +1056,11 @@
 #ifdef ISOVERIF
         do i=1,klon
-          if (iso_eau.gt.0) 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
+                  'il pleut 608',errmax,errmaxrel).eq.1) THEN
+              WRITE(*,*) 'i=',i
               stop
             endif
-          endif !if (iso_eau.gt.0) then
+          endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur(zxt(1,i),'il pleut 1106')
@@ -1070,6 +1070,5 @@
 #endif 
 
-        if (iflag_pdf.eq.0) then
-
+        if (iflag_pdf.eq.0) THEN
            ! version creneau de (Li, 1998)
            do i=1,klon
@@ -1085,5 +1084,5 @@
            ! ----------------------------------------------------------------
            do i=1,klon
-              if(zq(i).lt.1.e-15) then
+              IF(zq(i).lt.1.e-15) THEN
                  ncoreczq=ncoreczq+1
 #ifdef ISO
@@ -1093,21 +1092,20 @@
 #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)
                      zxt(ixt,i)=max(0.0,zxt(ixt,i))
                    enddo   
-                else !if (zq_ancien(i).gt.0.0) then
+                else !if (zq_ancien(i).gt.0.0) THEN
                     do ixt=1,ntraciso
                      zxt(ixt,i)=0.0
                    enddo 
-                endif !if (zq_ancien(i).gt.0.0) then
-
+                endif !if (zq_ancien(i).gt.0.0) THEN
                 ! 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)
-                  endif !if (iso_eau.gt.0) then
+                  endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
              CALL iso_verif_traceur(zxt(1,i),'il pleut 1207')
@@ -1119,7 +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, &
@@ -1128,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, &
@@ -1138,5 +1135,5 @@
               !Version these Jean Jouhaud, Decembre 2018 
               !----------------------------------              
-              elseif (iflag_cloudth_vert==6) then
+              elseif (iflag_cloudth_vert==6) THEN
                CALL cloudth_v6(klon,klev,k,ztv, &
                    zq,zqta,fraca, &
@@ -1155,7 +1152,7 @@
            endif
 
-           if (iflag_cld_th <= 4) then
+           if (iflag_cld_th <= 4) THEN
               lognormale = .TRUE.
-           elseif (iflag_cld_th >= 6) then
+           elseif (iflag_cld_th >= 6) THEN
               ! lognormale en l'absence des thermiques
               lognormale = fraca(:,k) < 1e-10
@@ -1190,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) 
              ! -----------------------------------------------------
@@ -1200,5 +1197,5 @@
                  ! ------------------------------
                  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
 
@@ -1212,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
@@ -1228,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
@@ -1250,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)
@@ -1259,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)
@@ -1274,11 +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
@@ -1293,12 +1289,11 @@
                  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)
@@ -1308,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
@@ -1324,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)
@@ -1354,5 +1349,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:
@@ -1410,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)
@@ -1442,15 +1437,15 @@
          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
-!                write(*,*) 'rneb,zq,zqn,zqcs=',rneb(i,k),zq(i), &
+!                WRITE(*,*) 'rneb,zq,zqn,zqcs=',rneb(i,k),zq(i), &
 !     &                zqn(i),zqcs(i)
                 CALL iso_verif_positif(zqcs(i),'ipleut 853')
@@ -1459,11 +1454,11 @@
                 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)
-              endif !if (iso_eau.gt.0) then
+              endif !if (iso_eau.gt.0) THEN
               do ixt=1,ntraciso
                 CALL iso_verif_positif_choix(zxt(ixt,i),0.0,'ilp 857')
@@ -1475,18 +1470,18 @@
 #endif
               if ((bidouille_anti_divergence).and. &
-                 (iso_eau.gt.0)) then
+                 (iso_eau.gt.0)) THEN
                 zxt(iso_eau,i)= max(zq(i),0.0)  
-!                if (zxt(iso_eau,i).gt.0.0) then
+!                if (zxt(iso_eau,i).gt.0.0) THEN
 !                    do ixt=1,niso
 !                        zxt(ixt,i)=zxt(ixt,i)*zq(i)/zxt(iso_eau,i)
 !                    enddo
-!                else !if (zxt(iso_eau,i).gt.0.0) then
+!                else !if (zxt(iso_eau,i).gt.0.0) THEN
 !                    do ixt=1,niso
 !                        zxt(ixt,i)=0.0
 !                    enddo    
-!                endif !if (zxt(iso_eau,i).gt.0.0) then
+!                endif !if (zxt(iso_eau,i).gt.0.0) THEN
               endif !if ((bidouille_anti_divergence).and. 
 
-              if (zq(i).gt.1e-15) then   
+              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
@@ -1496,11 +1491,11 @@
                 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 
+              else !if (zq(i).gt.0.0) THEN
                   ! problème: zq~0 et sans compo, mais zqn >0
                   ! on fait ce qu'on peut dans ce cas pathologique
@@ -1509,92 +1504,91 @@
                 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
-!                   write(*,*) 'ilp tmp 848: warning: bidouille'
+                         .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
-!                   write(*,*) 'zxtn(:,i)=',zxtn(:,i)
+                   endif ! if (option_tmin.eq.1) THEN
+!                   WRITE(*,*) 'zxtn(:,i)=',zxtn(:,i)
 #endif                   
                 endif !if ((bidouille_anti_divergence)
-              endif  !if (zq(i).gt.0.0) then 
-
+              endif  !if (zq(i).gt.0.0) THEN
 #ifdef ISOVERIF
              do ixt=1,niso     
                   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)
-             endif !if ((iso_eau.gt.0)) then
+             endif !if ((iso_eau.gt.0)) THEN
 #ifdef ISOTRAC
-!             write(*,*) 'zxt(:,i)=',zxt(:,i)   
-!             write(*,*) 'zq,zqn=',zq(i) ,zqn(i)  
+!             WRITE(*,*) 'zxt(:,i)=',zxt(:,i)
+!             WRITE(*,*) 'zq,zqn=',zq(i) ,zqn(i)
              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 ((iso_eau.gt.0)) THEN
+             endif ! if (option_tmin.eq.1) THEN
 #endif 
 #endif                   
-!                 write(*,*) 'il pleut 695: calcul de zxtn, i=',i
-!                 write(*,*) 'zxtn(4,i)=',zxtn(4,i)
-!                 write(*,*) 'zqn(i)=',zqn(i)
+!                 WRITE(*,*) 'il pleut 695: calcul de zxtn, i=',i
+!                 WRITE(*,*) 'zxtn(4,i)=',zxtn(4,i)
+!                 WRITE(*,*) 'zqn(i)=',zqn(i)
               do ixt=1,ntraciso    
                zxtn(ixt,i)=max(0.0,zxtn(ixt,i))          
               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
+               endif !if (iso_eau.gt.0) 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')
-                endif  !if (zqn(i).gt.ridicule) then
-               endif  !if (iso_HDO.gt.0) then  
+                endif  !if (zqn(i).gt.ridicule) THEN
+               endif  !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC               
              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), &
                          'il pleut 971',errmax,errmaxrel)
-               endif !if (iso_eau.gt.0) then
+               endif !if (iso_eau.gt.0) THEN
                CALL iso_verif_traceur_pbidouille &
                         (zxtcs(1,i),'il pleut 1300')
              
-             endif ! if (option_tmin.eq.1) then
+             endif ! if (option_tmin.eq.1) THEN
 #endif                
 #endif   
          enddo ! do i=1,klon
          
-!        write(*,*) 'ilp tmp 1311: zoliq,zxtoliq(1,363)=',zoliq(363),zxtoliq(1,363)
+!        WRITE(*,*) 'ilp tmp 1311: zoliq,zxtoliq(1,363)=',zoliq(363),zxtoliq(1,363)
 #endif    
 
@@ -1613,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
@@ -1627,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)
@@ -1648,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))) &
@@ -1670,17 +1664,17 @@
 #ifdef ISO          
 #ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 1823'
+!        WRITE(*,*) 'ilp tmp 1823'
       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)
-        endif !if (iso_eau.gt.0) then 
+        endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
         CALL iso_verif_traceur(zxtn(1,i),'il pleut 1408')
-!        write(*,*) 'fisrtilp 1421: appel condiso_liq_ice_vectall'
+!        WRITE(*,*) 'fisrtilp 1421: appel condiso_liq_ice_vectall'
 #endif
        enddo !do i=1,klon 
-!       write(*,*) 'il pleut 961: avant condensation'
+!       WRITE(*,*) 'il pleut 961: avant condensation'
        ! end verif
 #endif
@@ -1701,10 +1695,10 @@
 #ifdef ISOTRAC
 !#ifdef ISOVERIF
-!        write(*,*) 'il pleut 980: condensation pour les traceurs'
+!        WRITE(*,*) 'il pleut 980: condensation pour les traceurs'
 !#endif        
         CALL condiso_liq_ice_vectall_trac(zxtn,zqn,zcond, &
                   zt,zfice,zxtice,zxtliq,klon)
 #ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 1859'
+!        WRITE(*,*) 'ilp tmp 1859'
         do i=1,klon             
              CALL iso_verif_traceur(zxtn(1,i),'il pleut 1428a')
@@ -1734,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), &
@@ -1740,18 +1734,18 @@
           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
-               write(*,*) 'zxtn(:,i)=',zxtn(:,i)
-               write(*,*) 'zxt(:,i)=',zxt(:,i)
-               write(*,*) 'zxtliq(:,i)=',zxtliq(:,i)
-               write(*,*) 'zxtice(:,i)=',zxtice(:,i)
+                         .eq.1) THEN
+               WRITE(*,*) 'zxtn(:,i)=',zxtn(:,i)
+               WRITE(*,*) 'zxt(:,i)=',zxt(:,i)
+               WRITE(*,*) 'zxtliq(:,i)=',zxtliq(:,i)
+               WRITE(*,*) 'zxtice(:,i)=',zxtice(:,i)
                stop
              endif
@@ -1782,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
@@ -1791,7 +1785,6 @@
         ! 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
@@ -1823,5 +1816,5 @@
 #endif            
           ! bidouille
-          if (bidouille_anti_divergence) then
+          if (bidouille_anti_divergence) THEN
                 zxtcondn(iso_eau,i)=zcondn(i)
 #ifdef ISOVERIF                
@@ -1831,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) &
@@ -1848,5 +1841,5 @@
          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
@@ -1854,19 +1847,19 @@
                  zxt_ancien(itZonIso(izone,iso_eau),i) &
                 -zxt(itZonIso(izone,iso_eau),i),1e-8,'ilp 1270') &
-                .eq.1) then
-            write(*,*) 'i,izone,rneb=',i,izone,rneb(i,k)
-            write(*,*) 'zxt(:,i)=',zxt(:,i)
-            write(*,*) 'zxt_ancien(:,i)=',zxt_ancien(:,i)
-            write(*,*) 'zxtcs(:,i)=',zxtcs(:,i)
-            write(*,*) 'zxtres(:)=',zxtres(:)
-            write(*,*) 'zxtcond(:,i)=',zxtcond(:,i)
-            write(*,*) 'zxtn(:,i)=',zxtn(:,i)
-            write(*,*) 'zxtcondn(:,i)=',zxtcondn(:,i)
+                .eq.1) THEN
+            WRITE(*,*) 'i,izone,rneb=',i,izone,rneb(i,k)
+            WRITE(*,*) 'zxt(:,i)=',zxt(:,i)
+            WRITE(*,*) 'zxt_ancien(:,i)=',zxt_ancien(:,i)
+            WRITE(*,*) 'zxtcs(:,i)=',zxtcs(:,i)
+            WRITE(*,*) 'zxtres(:)=',zxtres(:)
+            WRITE(*,*) 'zxtcond(:,i)=',zxtcond(:,i)
+            WRITE(*,*) 'zxtn(:,i)=',zxtn(:,i)
+            WRITE(*,*) 'zxtcondn(:,i)=',zxtcondn(:,i)
             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                     
-          endif !if (cond.gt.0.0) then
+          endif !if (cond.gt.0.0) THEN
         enddo !do i=1,klon
 
@@ -1875,11 +1868,10 @@
         CALL iso_verif_positif(float(option_cond-1),'ilp 1310')
 #endif        
-        endif ! if (option_tmin.ge.1) then
-
-        if (option_cond.eq.1) then
+        endif ! if (option_tmin.ge.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
@@ -1895,10 +1887,10 @@
         enddo !do i=1,klon        
 #endif         
-      endif ! if (option_cond.ge.1) then
+      endif ! if (option_cond.ge.1) THEN
 #endif        
      
       
 #ifdef ISOVERIF
-!        write(*,*) 'ilp tmp 2066'
+!        WRITE(*,*) 'ilp tmp 2066'
       do i=1,klon
          do ixt=1,niso
@@ -1912,21 +1904,21 @@
          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
+         endif !if (iso_eau.gt.0) 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_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)
+                 zxt(iso_O18,i)/zq(i),'il pleut 2059').eq.1) THEN
+                   WRITE(*,*) 'i,k,zq=',i,k,zq(i)
                    stop
                 endif !if (iso_verif_O18_aberrant_nostop
-              endif !if (iso_O18.gt.0) then
-            endif !if (zq(i).gt.ridicule) then
-         endif  ! if (iso_HDO.gt.0) then 
+              endif !if (iso_O18.gt.0) THEN
+            endif !if (zq(i).gt.ridicule) THEN
+         endif  ! if (iso_HDO.gt.0) THEN
         enddo  ! i=1,klon
 #ifdef ISOTRAC
@@ -2002,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)
@@ -2010,12 +2002,12 @@
           
 #ifdef ISOVERIF
-!       write(*,*) 'ilp tmp 1626: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
+!       WRITE(*,*) 'ilp tmp 1626: k,zoliq,zxtoliq(1,363)=',k,zoliq(363),zxtoliq(1,363)
        do i=1,klon   
          do ixt=1,ntraciso
            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)
-             write(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
+                 'il pleut 1628').eq.1) THEN
+             WRITE(*,*) 'i,k,ixt=',i,k,ixt
+             WRITE(*,*) 'rneb(i,k)=',rneb(i,k)
+             WRITE(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
              stop
            endif
@@ -2025,25 +2017,25 @@
 #ifdef ISOVERIF
        !i=519
-       !write(*,*) 'k,i,zoliq(i)=',k,i,zoliq(i)
+       !WRITE(*,*) 'k,i,zoliq(i)=',k,i,zoliq(i)
        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  
+           endif !if (iso_eau.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_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)
+                 zxtoliq(iso_O18,i)/zoliq(i),'il pleut 895b').eq.1) THEN
+                   WRITE(*,*) 'i,k,zoliq,zfice=',i,k,zoliq(i),zfice(i)
                    !stop
                 endif
-              endif ! if (iso_HDO.gt.0) then
-            endif  !if (iso_HDO.gt.0) then
-           endif !if (zoliq(i).gt.ridicule) then
+              endif ! if (iso_HDO.gt.0) THEN
+            endif  !if (iso_HDO.gt.0) THEN
+           endif !if (zoliq(i).gt.ridicule) THEN
           ! end cam verif
          enddo ! do i=1,klon
@@ -2063,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
@@ -2079,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))
@@ -2119,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
@@ -2125,10 +2117,10 @@
              zxtoliq(ixt,i)=zoliq(i)*(zxtcond(ixt,i)/zcond(i))
            enddo !do ixt=1,niso           
-        else !if (zcond(i).gt.0.0) then            
-           if (zoliq(i).lt.ridicule) then
+        else !if (zcond(i).gt.0.0) THEN
+           if (zoliq(i).lt.ridicule) THEN
                do ixt=1,ntraciso
                 zxtoliq(ixt,i)=0.0
                enddo
-           else !if (zoliq(i).lt.ridicule) then
+           else !if (zoliq(i).lt.ridicule) THEN
                ! modif 28 oct 2008
               do ixt=1,niso
@@ -2137,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
@@ -2145,10 +2137,10 @@
 #endif    
 #ifdef ISOVERIF                   
-              write(*,*) 'il pleut 1412: zcond(i)=',zcond(i)
-              write(*,*) 'zoliq(i)=',zoliq(i)
+              WRITE(*,*) 'il pleut 1412: zcond(i)=',zcond(i)
+              WRITE(*,*) 'zoliq(i)=',zoliq(i)
               stop
 #endif                   
-            endif   !if (zoliq(i).lt.ridicule) then         
-        endif !if (zcond(i).gt.0.0) then
+            endif   !if (zoliq(i).lt.ridicule) THEN
+        endif !if (zcond(i).gt.0.0) THEN
        endif !IF (rneb(i,k).GT.0.0) THEN
       enddo ! do i=1,klon 
@@ -2169,19 +2161,19 @@
       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
+          endif !if (iso_eau.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')
-          endif !if (iso_HDO.gt.0) then
+          endif !if (iso_HDO.gt.0) THEN
         ! end cam verif
 #ifdef ISOTRAC
-!             write(*,*) 'ilp 1201 tmp: i=',i
-!             write(*,*) 'zoliq(i)=',zoliq(i)
-!             write(*,*) 'zxtoliq(i)=',zxtoliq(iso_eau:ntraciso:3,i)
-!             write(*,*) 'zcond(i)=',zcond(i)
-!             write(*,*) 'zxtcond(i)=',zxtcond(iso_eau:ntraciso:3,i)
+!             WRITE(*,*) 'ilp 1201 tmp: i=',i
+!             WRITE(*,*) 'zoliq(i)=',zoliq(i)
+!             WRITE(*,*) 'zxtoliq(i)=',zxtoliq(iso_eau:ntraciso:3,i)
+!             WRITE(*,*) 'zcond(i)=',zcond(i)
+!             WRITE(*,*) 'zxtcond(i)=',zxtcond(iso_eau:ntraciso:3,i)
              CALL iso_verif_traceur(zxtoliq(1,i),'il pleut 1634')
 #endif        
@@ -2209,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
@@ -2217,6 +2209,6 @@
                         * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
                 enddo !do ixt=1,niso
-            else !if (zcond(i).gt.0.0) then
-                if (zcond(i)-zoliq(i).gt.0.0) then
+            else !if (zcond(i).gt.0.0) THEN
+                if (zcond(i)-zoliq(i).gt.0.0) THEN
                     do ixt=1,niso
                         zxtrfl(ixt,i)=zxtrfl(ixt,i) &
@@ -2226,11 +2218,11 @@
                     enddo !do ixt=1,niso  
 #ifdef ISOVERIF                   
-                    write(*,*) 'il pleut 1023: zcond(i)=',zcond(i)
-                    write(*,*) 'zcond(i),zoliq(i)=',zcond(i),zoliq(i)
+                    WRITE(*,*) 'il pleut 1023: zcond(i)=',zcond(i)
+                    WRITE(*,*) 'zcond(i),zoliq(i)=',zcond(i),zoliq(i)
                     stop
 #endif        
 #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,9 +2232,8 @@
                     enddo !do ixt=1,niso
 #endif                 
-                else !if (zcond(i)-zoliq(i).gt.0.0) then
+                else !if (zcond(i)-zoliq(i).gt.0.0) THEN
                     ! zrfl non modifié
-                endif !if (zcond(i)-zoliq(i).gt.0.0) then
-            endif !if (zcond(i).gt.0.0) then
-
+                endif !if (zcond(i)-zoliq(i).gt.0.0) THEN
+            endif !if (zcond(i).gt.0.0) THEN
          ! cam verif         
 !#ifdef ISOVERIF
@@ -2252,10 +2243,10 @@
                          'il pleut 772').eq.1).or. &
                          (iso_verif_noNAN_nostop(zxtoliq(ixt,i), &
-                         'il pleut 772b').eq.1)) then
-               write(*,*) 'zcond(i)=',zcond(i)
-               write(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
-               write(*,*) 'zoliq(i)=',zoliq(i)
-               write(*,*) 'Rdefault(ixt)=',Rdefault(ixt)
-               write(*,*) 'paprs(i,k),paprs(i,k+1)=',paprs(i,k),paprs(i,k+1)
+                         'il pleut 772b').eq.1)) THEN
+               WRITE(*,*) 'zcond(i)=',zcond(i)
+               WRITE(*,*) 'zxtcond(ixt,i)=',zxtcond(ixt,i)
+               WRITE(*,*) 'zoliq(i)=',zoliq(i)
+               WRITE(*,*) 'Rdefault(ixt)=',Rdefault(ixt)
+               WRITE(*,*) 'paprs(i,k),paprs(i,k+1)=',paprs(i,k),paprs(i,k+1)
                stop
              endif
@@ -2263,24 +2254,24 @@
 #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( &
                  zxtrfl(iso_eau,i),zrfl(i), &
-                 'il pleut 771b',errmax,errmaxrel).eq.1)then
-                 write(*,*) 'trace_cas(i)=',trace_cas(i)
-                 write(*,*) 'zxtcond(iso_eau,i)',zxtcond(iso_eau,i)
-                 write(*,*) 'zcond(i)',zcond(i)
-                 write(*,*) 'zxtoliq(iso_eau,i)',zxtoliq(iso_eau,i)
-                 write(*,*) 'zoliq(i)',zoliq(i)
+                 'il pleut 771b',errmax,errmaxrel).eq.1)THEN
+                 WRITE(*,*) 'trace_cas(i)=',trace_cas(i)
+                 WRITE(*,*) 'zxtcond(iso_eau,i)',zxtcond(iso_eau,i)
+                 WRITE(*,*) 'zcond(i)',zcond(i)
+                 WRITE(*,*) 'zxtoliq(iso_eau,i)',zxtoliq(iso_eau,i)
+                 WRITE(*,*) 'zoliq(i)',zoliq(i)
                  stop
               endif
-            endif !if (iso_eau.gt.0) then
-            if (iso_HDO.gt.0) then
+            endif !if (iso_eau.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), &
                  zrfl(i),ridicule_rain,deltalim_snow,'il pleut 1458')
                 endif
-            endif !if (iso_HDO.gt.0) then
+            endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
              CALL iso_verif_traceur(zxtrfl(1,i),'il pleut 1729')
@@ -2288,12 +2279,12 @@
 #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
+!             if (zxtrfl(iso_eau,i).gt.0.0) THEN
 !             do ixt=1,niso
 !               zxtrfl(ixt,i)=zxtrfl(ixt,i)*zrfl(i)/zxtrfl(iso_eau,i)
 !             enddo
-!           endif !if (zxtrfl(iso_eau,i).gt.0.0) then
-         endif ! if (bidouille_anti_divergence) then
+!           endif !if (zxtrfl(iso_eau,i).gt.0.0) THEN
+         endif ! if (bidouille_anti_divergence) THEN
          ! end bidouille
          ! end cam verif
@@ -2323,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)
@@ -2374,5 +2365,5 @@
 !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
+!           if (.not.ice_thermo) THEN
 !           d_ql(i,k) = zoliq(i)
 !           d_qi(i,k) = 0.
@@ -2396,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)))
@@ -2466,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)
@@ -2474,21 +2465,21 @@
                  'il pleut 1612',errmax,errmaxrel)
           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)
+                 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
+        endif !if (iso_eau.gt.0) 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')
-          endif !if (prfl(i,k).gt.ridicule_rain) then           
+          endif !if (prfl(i,k).gt.ridicule_rain) THEN
           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')
-          endif !if (zq(i).gt.ridicule) then          
-         endif !if (iso_HDO.gt.0) then
+          endif !if (zq(i).gt.ridicule) THEN
+         endif !if (iso_HDO.gt.0) THEN
 #ifdef ISOTRAC
           CALL iso_verif_traceur(zxt(1,i),'il pleut 1792')
@@ -2513,28 +2504,28 @@
          ! cam verif
 #ifdef ISOVERIF
-           if (iso_eau.gt.0) 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)
-                write(*,*) 'xt,q=',xt(iso_eau,i,k),q(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)
+                WRITE(*,*) 'xt,q=',xt(iso_eau,i,k),q(i,k)
                 stop
              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
+           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
-!                write(*,*) 'd_q(i,k)=',d_q(i,k)
-!                write(*,*) 'q(i,k)=',q(i,k)
-!                write(*,*) 'zq(i)=',zq(i)
-!                write(*,*) 'deltaD_prec=',deltaD(xt(iso_HDO,i,k)/q(i,k))
-!                write(*,*) 'deltaD=',deltaD(zxt(iso_HDO,i)/zq(i))
+                 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)
+!                WRITE(*,*) 'zq(i)=',zq(i)
+!                WRITE(*,*) 'deltaD_prec=',deltaD(xt(iso_HDO,i,k)/q(i,k))
+!                WRITE(*,*) 'deltaD=',deltaD(zxt(iso_HDO,i)/zq(i))
 !                stop       
               endif !   if (iso_verif_aberrant_nostop(
-            endif !if (zq(i).gt.ridicule) then          
-           endif !if (iso_HDO.gt.0) then
-          endif !if (1.eq.0) then
+            endif !if (zq(i).gt.ridicule) THEN
+           endif !if (iso_HDO.gt.0) THEN
+          endif !if (1.eq.0) THEN
 #endif
          ! end cam verif
@@ -2547,5 +2538,5 @@
      DO i = 1,klon
 
-        if(zcond(i).gt.zoliq(i)+1.e-10) then
+        IF(zcond(i).gt.zoliq(i)+1.e-10) THEN
          beta(i,k) = (zcond(i)-zoliq(i))/zcond(i)/dtime
         else
@@ -2607,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) &
@@ -2618,5 +2609,5 @@
 #endif        
         enddo !do i=1,klon
-      endif !  if (iso_eau.gt.0) then        
+      endif !  if (iso_eau.gt.0) THEN
 #endif
 #endif      
@@ -2663,18 +2654,18 @@
 #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
+        endif !if (snow(i)*dtime.gt.ridicule) THEN
+       endif !if (iso_eau.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')
            CALL iso_verif_aberrant_choix(xtsnow(iso_hdo,i),snow(i), &
                   ridicule_rain,deltalim_snow,'il pleut 938b')
-       endif !if (iso_eau.gt.0) then
+       endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
        CALL iso_verif_traceur(xtrain(1,i),'il pleut 1952')
@@ -2711,5 +2702,5 @@
   ENDIF
 
-  if (ncoreczq>0) then
+  if (ncoreczq>0) THEN
      WRITE(lunout,*)'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
   endif
@@ -2721,8 +2712,8 @@
        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)
-         endif !if (iso_eau.gt.0) then
+         endif !if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
          CALL iso_verif_traceur(d_xtl(1,i,k),'il pleut 1982')
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90	(revision 5116)
@@ -355,5 +355,5 @@
   ! PRINT*, 'wake initialisations'
 !#ifdef ISOVERIF
-!        write(*,*) 'wake 358: entree'
+!        WRITE(*,*) 'wake 358: entree'
 !#endif
 
@@ -398,6 +398,5 @@
   ! alpk = 0.05
 
- if (first) then
-
+ if (first) THEN
   igout = klon/2+1/klon
 
@@ -686,24 +685,24 @@
   DO k = 1, klev
     DO i = 1, klon
-      ! write(*,*)'wake 1',i,k,rd,te(i,k)
+      ! WRITE(*,*)'wake 1',i,k,rd,te(i,k)
       rho(i, k) = p(i, k)/(rd*te(i,k))
-      ! write(*,*)'wake 2',rho(i,k)
+      ! WRITE(*,*)'wake 2',rho(i,k)
       IF (k==1) THEN
-        ! write(*,*)'wake 3',i,k,rd,te(i,k)
+        ! WRITE(*,*)'wake 3',i,k,rd,te(i,k)
         rhoh(i, k) = ph(i, k)/(rd*te(i,k))
-        ! write(*,*)'wake 4',i,k,rd,te(i,k)
+        ! WRITE(*,*)'wake 4',i,k,rd,te(i,k)
         zhh(i, k) = 0
       ELSE
-        ! write(*,*)'wake 5',rd,(te(i,k)+te(i,k-1))
+        ! WRITE(*,*)'wake 5',rd,(te(i,k)+te(i,k-1))
         rhoh(i, k) = ph(i, k)*2./(rd*(te(i,k)+te(i,k-1)))
-        ! write(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
+        ! WRITE(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
         zhh(i, k) = (ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*rg) + zhh(i, k-1)
       END IF
-      ! write(*,*)'wake 7',ppi(i,k)
+      ! WRITE(*,*)'wake 7',ppi(i,k)
       the(i, k) = te(i, k)/ppi(i, k)
       thu(i, k) = (te(i,k)-deltatw(i,k)*sigmaw(i))/ppi(i, k)
       tu(i, k) = te(i, k) - deltatw(i, k)*sigmaw(i)
       qu(i, k) = qe(i, k) - deltaqw(i, k)*sigmaw(i)
-      ! write(*,*)'wake 8',(rd*(te(i,k)+deltatw(i,k)))
+      ! WRITE(*,*)'wake 8',(rd*(te(i,k)+deltatw(i,k)))
       rhow(i, k) = p(i, k)/(rd*(te(i,k)+deltatw(i,k)))
       dth(i, k) = deltatw(i, k)/ppi(i, k)
@@ -713,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_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
+                        'wake 723c xtu').eq.1) THEN
                      stop
                endif
@@ -1456,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')
@@ -1504,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')
@@ -1632,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')
@@ -1663,9 +1662,9 @@
           ! Jingmei
 
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
+          ! WRITE(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
           ! &  Tgw(i,k),deltatw(i,k)
           d_deltat_gw(i, k) = d_deltat_gw(i, k) - tgw(i, k)*deltatw(i, k)* &
             dtimesub
-          ! write(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
+          ! WRITE(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
           ff(i) = d_deltatw(i, k)/dtimesub
 
@@ -1709,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')
@@ -1728,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)
@@ -1798,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 
@@ -1805,5 +1804,5 @@
           enddo ! DO i = 1,klon     
         enddo ! DO k= 1,klev 
-      endif !if (iso_eau.gt.0) then
+      endif !if (iso_eau.gt.0) THEN
 #endif
 #endif
@@ -1840,6 +1839,6 @@
 #ifdef ISO
 #ifdef ISOVERIF
-      write(*,*) 'wake 1859'
-      if (iso_eau.gt.0) then
+      WRITE(*,*) 'wake 1859'
+      if (iso_eau.gt.0) THEN
         DO k= 1,klev 
           DO i = 1,klon 
@@ -1848,6 +1847,6 @@
           enddo ! DO i = 1,klon     
         enddo ! DO k= 1,klev 
-      endif !if (iso_eau.gt.0) then     
-      if (iso_hdo.gt.0) then
+      endif !if (iso_eau.gt.0) THEN
+      if (iso_hdo.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
             xte,qe, &
@@ -2232,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, &
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyaqua_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyaqua_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyaqua_mod.F90	(revision 5116)
@@ -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 !'
@@ -243,5 +243,5 @@
 
     ! Si alb_ocean on calcule un albedo oceanique moyen
-    ! if (alb_ocean) then
+    ! if (alb_ocean) THEN
     ! Voir pourquoi on avait ca.
     ! CALL ini_alb_oce(phy_alb)
@@ -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 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90	(revision 5116)
@@ -10,5 +10,5 @@
 SUBROUTINE phyetat0(fichnom, clesphy0, tabcntr0)
 
-  USE dimphy, only: klon, zmasq, klev
+  USE dimphy, ONLY: klon, zmasq, klev
   USE iophy, ONLY: init_iophy_new
   USE ocean_cpl_mod,    ONLY: ocean_cpl_init
@@ -48,6 +48,6 @@
   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 netcdf, ONLY: missing_val_netcdf => nf90_fill_real
+  use config_ocean_skin_m, ONLY: activate_ocean_skin
 #ifdef ISO
   USE infotrac_phy, ONLY: niso
@@ -328,5 +328,5 @@
 !===================================================================
 
-   if ( iflag_physiq <= 1 ) then
+   if ( iflag_physiq <= 1 ) THEN
 !===================================================================
   ! Lecture des temperatures du sol profond:
@@ -467,9 +467,9 @@
 !==================================
 
-  IF (iflag_pbl>1) then
+  IF (iflag_pbl>1) THEN
      found=phyetat0_srf(pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
   ENDIF
 
-  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
+  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) THEN
     found=phyetat0_srf(wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
 !!    found=phyetat0_srf(delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
@@ -546,11 +546,11 @@
 #ifdef ISO
         ! initialise les isotopes       
-        write(*,*) 'phyetat0 1069' 
+        WRITE(*,*) 'phyetat0 1069'
          CALL phyisoetat0 (snow,run_off_lic_0, &
                  xtsnow,xtrun_off_lic_0, &
                  Rland_ice)
 #ifdef ISOVERIF 
-      write(*,*) 'phyetat0 1074'
-      if (iso_eau.gt.0) then
+      WRITE(*,*) 'phyetat0 1074'
+      if (iso_eau.gt.0) THEN
       CALL iso_verif_egalite_vect2D(  &
                  xtsnow,snow, &
@@ -561,5 +561,5 @@
          enddo
       endif
-      write(*,*) 'phyetat0 1102'
+      WRITE(*,*) 'phyetat0 1102'
 #endif
 #endif
@@ -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.)
@@ -668,8 +668,8 @@
 ! 994 est trop grand quand OpenMP est activé : on sort du tableau
 !#ifdef ISOVERIF
-!        write(*,*) 'phyetat0 572: snow(994,:)=',snow(994,2)
-!        write(*,*) 'xtsnow(:,994,2)=',xtsnow(:,994,2)
+!        WRITE(*,*) 'phyetat0 572: snow(994,:)=',snow(994,2)
+!        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
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90	(revision 5116)
@@ -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
@@ -183,5 +183,5 @@
     CALL put_field_srf1(pass,"TS","Temperature",ftsol(:,:))
 
-    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
+    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) THEN
        CALL put_field_srf1(pass, "DELTATS", &
                       "w-x surface temperature difference",  delta_tsurf(:,:))
@@ -289,5 +289,5 @@
     ! DEB TKE PBL !
 
-    IF (iflag_pbl>1) then
+    IF (iflag_pbl>1) THEN
       CALL put_field_srf3(pass,"TKE", "Energ. Cineti. Turb.", &
            pbl_tke(:,:,:))
@@ -393,6 +393,6 @@
          "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)
@@ -413,5 +413,5 @@
 
 #ifdef ISO
-      write(*,*) 'phyredem 342'
+      WRITE(*,*) 'phyredem 342'
       CALL phyisoredem (pass, &
                  xtsnow, &
@@ -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
@@ -541,7 +541,7 @@
 #endif      
 
-      write(*,*) 'phyisoredem 41: entrée'
+      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
@@ -561,5 +561,5 @@
         enddo !DO nsrf = 1, nbsrf
        enddo
-      endif !if (iso_eau.gt.0) then
+      endif !if (iso_eau.gt.0) THEN
       do i=1,klon
        do ixt=1,niso
@@ -582,5 +582,5 @@
       i = INDEX(outiso, '_', .TRUE.)
       outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
-      write(*,*) 'phyredem 550: ixt,outiso=',ixt,TRIM(outiso)
+      WRITE(*,*) 'phyredem 550: ixt,outiso=',ixt,TRIM(outiso)
       
       iso_tmp_lonsrf(:,:)=fxtevap(ixt,:,:)
@@ -609,6 +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)
@@ -623,9 +622,8 @@
       CALL put_field(pass,"XTRUNOFFLIC0"//TRIM(outiso), "Runofflic0",  iso_tmp)
 
-      endif ! if (ixt.le.niso) then
-
+      endif ! if (ixt.le.niso) THEN
       enddo !do ixt=1,niso
 
-      write(*,*) 'phyisoredem 261: sortie'
+      WRITE(*,*) 'phyisoredem 261: sortie'
       END SUBROUTINE phyisoredem
 #endif
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_mod.F90	(revision 5116)
@@ -43,5 +43,5 @@
     USE surface_data, ONLY: landice_opt
     USE phys_output_ctrlout_mod
-    USE lmdz_grid_phy, only: klon_glo,nbp_lon,nbp_lat
+    USE lmdz_grid_phy, ONLY: klon_glo,nbp_lon,nbp_lat
     USE lmdz_print_control, ONLY: prt_level,lunout
     USE lmdz_vertical_layers, ONLY: ap,bp,preff,presnivs, aps, bps, pseudoalt, presinter
@@ -52,5 +52,5 @@
     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))
@@ -540,5 +540,5 @@
 
 #ifdef ISO
-    write(*,*) 'phys_output_mid 589'
+    WRITE(*,*) 'phys_output_mid 589'
     do ixt=1,ntraciso
       outiso = TRIM(isoName(ixt))
@@ -590,5 +590,5 @@
       END IF
     enddo !do ixt=1,niso
-    write(*,*) 'phys_output_mid 596'
+    WRITE(*,*) 'phys_output_mid 596'
 #endif
 
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_var_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_var_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_var_mod.F90	(revision 5116)
@@ -186,5 +186,5 @@
   SUBROUTINE phys_output_var_init
     use dimphy
-    use config_ocean_skin_m, only: activate_ocean_skin
+    use config_ocean_skin_m, ONLY: activate_ocean_skin
 
     IMPLICIT NONE
@@ -221,5 +221,5 @@
 ! Variables de sortie simulateur AIRS
 
-!     if (ok_airs) then
+!     if (ok_airs) THEN
       allocate (map_prop_hc(klon),map_prop_hist(klon))
       allocate (alt_tropo(klon))
@@ -285,5 +285,5 @@
 ! Variables de sortie simulateur AIRS
 
- !    if (ok_airs) then
+ !    if (ok_airs) THEN
       deallocate (map_prop_hc,map_prop_hist)
       deallocate (alt_tropo)
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90	(revision 5116)
@@ -20,11 +20,11 @@
 ! PLEASE try to follow this rule 
 
-    USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
+    USE ACAMA_GWD_rando_m, ONLY: ACAMA_GWD_rando
     USE aero_mod
     USE add_phys_tend_mod, ONLY: add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
          fl_ebil, fl_cor_ebil
-    USE lmdz_assert, only: assert
+    USE lmdz_assert, ONLY: assert
     USE change_srf_frac_mod
-    USE conf_phys_m, only: conf_phys
+    USE conf_phys_m, ONLY: conf_phys
     USE carbon_cycle_mod, ONLY: infocfields_init, RCO2_glo, carbon_cycle_rad
     USE CFMIP_point_locations   ! IM stations CFMIP
@@ -32,8 +32,8 @@
     USE dimphy
     USE etat0_limit_unstruct_mod
-    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
+    USE FLOTT_GWD_rando_m, ONLY: FLOTT_GWD_rando
     USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
     USE lmdz_geometry, ONLY: cell_area, latitude_deg, longitude_deg
-    USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
+    USE ioipsl, ONLY: histbeg, histvert, histdef, histend, histsync, &
          histwrite, ju2ymds, ymds2ju, getin
     USE lmdz_ioipsl_getin_p, ONLY: getin_p
@@ -45,15 +45,15 @@
     USE limit_read_mod, ONLY: init_limit_read
     USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
-    USE lmdz_phys_mpi_data, only: is_mpi_root
+    USE lmdz_phys_mpi_data, ONLY: is_mpi_root
     USE lmdz_phys_para
-    USE netcdf95, only: nf95_close
-    USE netcdf, only: nf90_fill_real     ! IM for NMC files
-    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
-    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
+    USE netcdf95, ONLY: nf95_close
+    USE netcdf, ONLY: nf90_fill_real     ! IM for NMC files
+    USE open_climoz_m, ONLY: open_climoz ! ozone climatology from a file
+    USE ozonecm_m, ONLY: ozonecm ! ozone of J.-F. Royer
     USE pbl_surface_mod, ONLY: pbl_surface
-    USE phyaqua_mod, only: zenang_an
-    USE phyetat0_mod, only: phyetat0
+    USE phyaqua_mod, ONLY: zenang_an
+    USE phyetat0_mod, ONLY: phyetat0
     USE phystokenc_mod, ONLY: offline, phystokenc
-    USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
+    USE phys_cal_mod, ONLY: year_len, mth_len, days_elapsed, jh_1jan, &
          year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour, calend
 !!  USE phys_local_var_mod, ONLY: a long list of variables
@@ -66,9 +66,9 @@
     USE readaerosol_mod, ONLY: init_aero_fromfile
     USE readaerosolstrato_m, ONLY: init_readaerosolstrato
-    USE radlwsw_m, only: radlwsw
+    USE radlwsw_m, ONLY: radlwsw
     USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
-    USE regr_pr_time_av_m, only: regr_pr_time_av
+    USE regr_pr_time_av_m, ONLY: regr_pr_time_av
     USE surface_data,     ONLY: type_ocean, ok_veget
-    USE time_phylmdz_mod, only: current_time, itau_phy, pdtphys, raz_date, update_time
+    USE time_phylmdz_mod, ONLY: current_time, itau_phy, pdtphys, raz_date, update_time
     USE tracinca_mod, ONLY: config_inca
     USE tropopause_m,     ONLY: dyn_tropopause
@@ -158,9 +158,9 @@
     USE isotrac_mod, ONLY: option_traceurs,iso_traceurs_init, &
 &       option_tmin,nzone_temp
-    USE isotrac_routines_mod, only: initialise_bassins_boites, &
+    USE isotrac_routines_mod, ONLY: initialise_bassins_boites, &
           isotrac_recolorise_general,isotrac_recolorise_conv, &
           iso_verif_traceur_jbid_vect,iso_verif_traceur_jbid_pos_vect
 #ifdef ISOVERIF
-    USE isotrac_routines_mod, only: iso_verif_traceur_pbidouille
+    USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
     USE isotopes_verif_mod, ONLY: iso_verif_traceur, &
 &       iso_verif_traceur_justmass,iso_verif_traceur_vect, &
@@ -825,5 +825,5 @@
 
 !JLD    !---D\'eclenchement stochastique
-!JLD    integer :: tau_trig(klon)
+!JLD    INTEGER :: tau_trig(klon)
 
     REAL,SAVE :: random_notrig_max=1.
@@ -1284,5 +1284,5 @@
     include "ini_COSP.h"
 #endif
-    real :: mr_ozone(klon,klev), phicosp(klon,klev)
+    REAL :: mr_ozone(klon,klev), phicosp(klon,klev)
 
     !IM stations CFMIP
@@ -1380,5 +1380,5 @@
        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'
@@ -1427,20 +1427,20 @@
     IF (prt_level>=1) THEN
        igout=klon/2+1/klon
-       write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
-       write(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), &
+       WRITE(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
+       WRITE(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), &
             longitude_deg(igout)
-       write(lunout,*) &
+       WRITE(lunout,*) &
             'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
-       write(lunout,*) &
+       WRITE(lunout,*) &
             nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys 
 
-       write(lunout,*) 'paprs, play, phi, u, v, t'
+       WRITE(lunout,*) 'paprs, play, phi, u, v, t'
        DO k=1,klev
-          write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
+          WRITE(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
                u(igout,k),v(igout,k),t(igout,k)
        ENDDO
-       write(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
+       WRITE(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
        DO k=1,klev
-          write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
+          WRITE(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
        ENDDO
     ENDIF
@@ -1740,5 +1740,5 @@
 ! dyn3dmem et physiq
 #ifdef ISO
-    write(*,*) 'physiq 1846a: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
+    WRITE(*,*) 'physiq 1846a: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
     IF(niso  <= 0) CALL abort_gcm('physiq 1756','options iso incompatibles',1)
 #ifdef ISOTRAC
@@ -1748,5 +1748,5 @@
 #endif
 #else
-    if(niso   > 0) CALL abort_gcm('physiq 1772','options iso incompatibles',1)
+    IF(niso   > 0) CALL abort_gcm('physiq 1772','options iso incompatibles',1)
 #endif
 
@@ -1754,17 +1754,17 @@
         ! initialisations isotopiques
 #ifdef ISOVERIF
-           write(*,*) 'physiq 1366: CALL iso_init'
-           write(*,*) 'ok_isotopes=',niso > 0
+           WRITE(*,*) 'physiq 1366: CALL iso_init'
+           WRITE(*,*) 'ok_isotopes=',niso > 0
 #endif
         if (niso > 0) CALL iso_init()
 #ifdef ISOTRAC
-IF(nzone > 0) then
-        write(*,*) 'physiq 1416: CALL iso_traceurs_init'
+IF(nzone > 0) THEN
+        WRITE(*,*) 'physiq 1416: CALL iso_traceurs_init'
         CALL iso_traceurs_init()
 END IF
 #endif
-!write(*,*) 'gcm 265: ntraciso=',ntraciso
+!WRITE(*,*) 'gcm 265: ntraciso=',ntraciso
 #ifdef ISOVERIF
-        write(*,*) 'physiq 1421: CALL iso_verif_init'
+        WRITE(*,*) 'physiq 1421: CALL iso_verif_init'
         CALL iso_verif_init()
 #endif
@@ -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
@@ -1999,5 +1999,5 @@
                              RVTMP2, RTT,RD,RG, RV, RPI)
        ! Test de coherence sur oc_cdnc utilisé uniquement par cloud_optics_prop
-       IF (ok_newmicro) then
+       IF (ok_newmicro) THEN
           IF (iflag_rrtm==1) THEN
 #ifdef CPP_RRTM
@@ -2236,5 +2236,5 @@
        tave = 'ave(X)'
        !IM cf. AM 081204 BEG
-       write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
+       WRITE(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
        !IM cf. AM 081204 END
 
@@ -2602,17 +2602,17 @@
 #ifdef ISO
 #ifdef ISOVERIF
-    write(*,*) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
-    write(*,*) 'iqIsoPha(:,ivap)=',iqIsoPha(:,ivap)
-    write(*,*) 'physiq 1846b: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
+    WRITE(*,*) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
+    WRITE(*,*) 'iqIsoPha(:,ivap)=',iqIsoPha(:,ivap)
+    WRITE(*,*) 'physiq 1846b: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
 #endif
     do ixt=1,ntraciso
 #ifdef ISOVERIF
-      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  
-        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 
+      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
+        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
       DO k = 1, klev
        DO i = 1, klon
@@ -2620,14 +2620,14 @@
           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
        enddo !DO i = 1, klon
       enddo ! DO k = 1, klev
-      !write(*,*) 'physiq tmp 1897: dispatch termine pour ixt=',ixt 
+      !WRITE(*,*) 'physiq tmp 1897: dispatch termine pour ixt=',ixt
     enddo !do ixt=1,niso
-!    write(*,*) 'physiq tmp 1898: dispatch termine pour tous'
+!    WRITE(*,*) 'physiq tmp 1898: dispatch termine pour tous'
 #endif
 ! #ifdef ISO
@@ -2706,38 +2706,38 @@
     ! 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 (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
-                  write(*,*) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k) 
-                  write(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
+                    '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)
                   stop
               endif !  if (iso_verif_o18_aberrant_nostop 
-            endif !if (q_seri(i,k).gt.errmax) then  
-            if (ql_seri(i,k).gt.ridicule) then  
+            endif !if (q_seri(i,k).gt.errmax) THEN
+            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
-                  write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k) 
+                    '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  
+            endif !if (q_seri(i,k).gt.errmax) THEN
+            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
-                  write(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k) 
+                    'physiq 2099 qs').eq.1) THEN
+                  WRITE(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k)
                   !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
-            endif !if (q_seri(i,k).gt.errmax) then
+            endif !if (q_seri(i,k).gt.errmax) THEN
           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
@@ -2775,5 +2775,5 @@
 
 #ifdef ISO
-!       write(*,*) 'physiq tmp 2112'
+!       WRITE(*,*) 'physiq tmp 2112'
          DO k = 1, klev
          DO i = 1, klon
@@ -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')
@@ -2860,8 +2860,8 @@
 
 #ifdef ISO
-!        write(*,*) 'physiq tmp 2115'
+!        WRITE(*,*) 'physiq tmp 2115'
 !        i=496
 !        k=18
-!        write(*,*) 'physiq 2105: q_seri(i,k),ql_seri(i,k),qs_seri(i,k),ridicule=', &
+!        WRITE(*,*) 'physiq 2105: q_seri(i,k),ql_seri(i,k),qs_seri(i,k),ridicule=', &
 !                q_seri(i,k),ql_seri(i,k),qs_seri(i,k),ridicule
          DO k = 1, klev
@@ -2874,5 +2874,5 @@
           enddo
          enddo
-!        write(*,*) 'physiq tmp 2125'
+!        WRITE(*,*) 'physiq tmp 2125'
 #endif
 
@@ -2934,8 +2934,8 @@
        IF (read_climoz <= 0) THEN
           ! Once per day, update ozone from Royer:
-          IF (solarlong0<-999.) then
+          IF (solarlong0<-999.) THEN
              ! Generic case with evolvoing season
              zzz=real(days_elapsed+1)
-          ELSE IF (abs(solarlong0-1000.)<1.e-4) then
+          ELSE IF (abs(solarlong0-1000.)<1.e-4) THEN
              ! Particular case with annual mean insolation
              zzz=real(90) ! could be revisited
@@ -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), &
@@ -3033,17 +3033,16 @@
                  xts_seri(iso_eau,i,k),qs_seri(i,k), &
                 '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  
+       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( &
                     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
-                  write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
+                    '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 (q_seri(i,k).gt.errmax) THEN
+        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
 #ifdef ISOTRAC      
              CALL iso_verif_traceur(xt_seri(1,i,k), &
@@ -3091,5 +3090,5 @@
     ENDIF
 
-    IF (prt_level>=1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
+    IF (prt_level>=1) WRITE(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
 
 
@@ -3241,8 +3240,8 @@
           jlr_g_c = (((19.8*(pr_et(1:klon)**2))/(1.5+pr_et(1:klon)+pr_et(1:klon)**2))**(0.4))**2
           gustiness(1:klon)=jlr_g_c+jlr_g_s
-!!       write(*,*) "rain ",pr_et
-!!       write(*,*) "jlr_g_c",jlr_g_c
-!!       write(*,*) "wstar",wstar(1,3)
-!!       write(*,*) "jlr_g_s",jlr_g_s
+!!       WRITE(*,*) "rain ",pr_et
+!!       WRITE(*,*) "jlr_g_c",jlr_g_c
+!!       WRITE(*,*) "wstar",wstar(1,3)
+!!       WRITE(*,*) "jlr_g_s",jlr_g_s
           ! ELSE IF (iflag_gusts==2) THEN
           !    do i = 1, klon
@@ -3320,5 +3319,5 @@
 
 #ifdef ISO
-       ! write(*,*) 'physiq 2402: apres pbl_surface'
+       ! WRITE(*,*) 'physiq 2402: apres pbl_surface'
 #ifdef ISOVERIF 
       do i=1,klon
@@ -3341,20 +3340,20 @@
         
       ! verif iso_eau
-      !write(*,*) 'physiq tmp 2748: iso_eau=',iso_eau
-      !write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
-      !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
-!        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)
+      !WRITE(*,*) 'physiq tmp 2748: iso_eau=',iso_eau
+      !WRITE(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
+      !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
+!        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)
       do i=1,klon
-!        write(*,*) 'physiq 2667: i,k=',i,k
-!        write(*,*) '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)
+!        WRITE(*,*) 'physiq 2667: i,k=',i,k
+!        WRITE(*,*) '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)
         do k=1,klev
-!          write(*,*) 'physiq 2670: i,k=',i,k
-!        write(*,*) '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)
-!        write(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,i,k)=',d_q_vdf(i,k),d_xt_vdf(iso_eau,i,k)
+!          WRITE(*,*) 'physiq 2670: i,k=',i,k
+!        WRITE(*,*) '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)
+!        WRITE(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,i,k)=',d_q_vdf(i,k),d_xt_vdf(iso_eau,i,k)
           CALL iso_verif_egalite_choix( &
                  d_xt_vdf(iso_eau,i,k),d_q_vdf(i,k), &
@@ -3369,21 +3368,21 @@
         enddo !k=1,klev
       enddo  !i=1,klon
-      endif !if (iso_eau.gt.0) then
-      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
+      endif !if (iso_eau.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 (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
-                  write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
+                    'physiq 4177, apres pbl_surface').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 (q_seri(i,k).gt.errmax) THEN
           enddo !k=1,klev
          enddo  !i=1,klon
-        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
-        !write(*,*) 'physiq tmp 2689'
+        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
+        !WRITE(*,*) 'physiq tmp 2689'
 #endif
 !#ifdef ISOVERIF 
@@ -3532,6 +3531,6 @@
 
     IF (prt_level>=1) THEN
-       write(lunout,*) 'L   qsat (g/kg) avant clouds_gno'
-       write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
+       WRITE(lunout,*) 'L   qsat (g/kg) avant clouds_gno'
+       WRITE(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
     ENDIF
 
@@ -3571,5 +3570,5 @@
     ENDDO
 
-    IF (prt_level>=1) write(lunout,*) 'omega(igout, :) = ', &
+    IF (prt_level>=1) WRITE(lunout,*) 'omega(igout, :) = ', &
          omega(igout, :)
 
@@ -3651,5 +3650,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-        write(*,*) 'physiq 2877'
+        WRITE(*,*) 'physiq 2877'
       CALL iso_verif_noNaN_vect2D( &
                  wake_deltaxt, &
@@ -3662,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, &
@@ -3670,24 +3669,24 @@
                  '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 (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
-                  write(*,*) 'physic 3315: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
+                    'physiq 2947, avant calcul undi').eq.1) THEN
+                  WRITE(*,*) 'physic 3315: 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 (q_seri(i,k).gt.errmax) THEN
         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   
@@ -3711,21 +3710,21 @@
                 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_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
-                     write(*,*) 'i,k=',i,k
-                     write(*,*) 'q_x(i,k),q_seri(i,k),wake_s(i),wake_deltaq(i,k)=', &
+                        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)=', &
                                 q_x(i,k),q_seri(i,k),wake_s(i),wake_deltaq(i,k)
-                     write(*,*) 'xt_x(iso_hdo,i,k),xt_seri(iso_hdo,i,k),wake_s(i),wake_deltaxt(iso_hdo,i,k)=', &
+                     WRITE(*,*) 'xt_x(iso_hdo,i,k),xt_seri(iso_hdo,i,k),wake_s(i),wake_deltaxt(iso_hdo,i,k)=', &
                                 xt_x(iso_hdo,i,k),xt_seri(iso_hdo,i,k),wake_s(i),wake_deltaxt(iso_hdo,i,k)
-                     write(*,*) 'deltaD_seri,wake=',deltaD(xt_seri(iso_hdo,i,k)/q_seri(i,k)), &
+                     WRITE(*,*) 'deltaD_seri,wake=',deltaD(xt_seri(iso_hdo,i,k)/q_seri(i,k)), &
                                 deltaD(wake_deltaxt(iso_hdo,i,k)/wake_deltaq(i,k))
-                     write(*,*) 'deltaD_x,deltaD_w=',deltaD(xt_x(iso_hdo,i,k)/q_x(i,k)),deltaD(xt_w(iso_hdo,i,k)/q_w(i,k))
+                     WRITE(*,*) 'deltaD_x,deltaD_w=',deltaD(xt_x(iso_hdo,i,k)/q_x(i,k)),deltaD(xt_w(iso_hdo,i,k)/q_w(i,k))
                      stop
                   endif
@@ -3749,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
@@ -3755,5 +3754,5 @@
             enddo
           enddo
-        endif ! if (iso_eau.gt.0) then
+        endif ! if (iso_eau.gt.0) THEN
 #endif
 
@@ -3762,5 +3761,5 @@
        ! The corresponding tendencies are added to the convective tendencies
        ! after the CALL to the convective scheme.
-       IF (iflag_wake>=1) then
+       IF (iflag_wake>=1) THEN
           IF (iflag_adjwk >= 1) THEN
              limbas(:) = 1
@@ -3828,5 +3827,5 @@
 #ifdef ISO
 #ifdef ISOVERIF
-       write(*,*) 'physic 2553: avant appel concvl'
+       WRITE(*,*) 'physic 2553: avant appel concvl'
        do k = 1, klev
         do i = 1, klon
@@ -3836,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,37 +3845,37 @@
                  xt_w(iso_eau,i,k),q_w(i,k), &
                 '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
+           endif !if (iso_eau.gt.0) 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
+             endif !if (q_seri(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
+             endif !if (q_x(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), &
                 'physic 2657c')
-             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
+             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
              CALL iso_verif_O18_aberrant( &
                     xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                     xt_seri(iso_O18,i,k)/q_seri(i,k), &
                     '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 (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
               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 (q_seri(i,k).gt.ridicule) 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')
@@ -3885,9 +3884,9 @@
            if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                  'physiq 3060, avantconcvl',1e-5) &
-                 .eq.1) then
-              write(*,*) 'i,k=',i,k 
+                 .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')
@@ -3899,5 +3898,5 @@
 !ISOVERIF         
           if ((bidouille_anti_divergence).and. &
-                 (iso_eau.gt.0)) then
+                 (iso_eau.gt.0)) THEN
            do k=1,klev
             do i=1,klon  
@@ -3971,15 +3970,15 @@
 #ifdef ISO
 #ifdef ISOVERIF
-!          write(*,*) 'q_detrainement(1,:)=',q_detrainement(1,:)
+!          WRITE(*,*) 'q_detrainement(1,:)=',q_detrainement(1,:)
       CALL iso_verif_noNaN_vect2D(d_xt_con, &
                  'physiq 3203a apres conv',ntraciso,klon,klev)
       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, &
@@ -4120,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
@@ -4133,11 +4132,11 @@
           IF (itop_con(i)>klev-3) THEN
              IF (prt_level >= 9) THEN
-                write(lunout,*)'La convection monte trop haut '
-                write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
+                WRITE(lunout,*)'La convection monte trop haut '
+                WRITE(lunout,*)'itop_con(,',i,',)=',itop_con(i)
              ENDIF
           ENDIF
        ENDDO
     ELSE IF (iflag_con==0) THEN
-       write(lunout,*) 'On n appelle pas la convection'
+       WRITE(lunout,*) 'On n appelle pas la convection'
        clwcon0=0.
        rnebcon0=0.
@@ -4286,11 +4285,11 @@
 #ifdef ISO
 #ifdef ISOVERIF
-     write(*,*) 'physiq 3425: apres convection'
-      if (iso_HDO.gt.0) then
+     WRITE(*,*) 'physiq 3425: apres convection'
+      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, &
@@ -4375,8 +4374,8 @@
          
 #ifdef ISOVERIF
-        write(*,*) 'physiq 3977: verif des inputs de calwake'
+        WRITE(*,*) 'physiq 3977: verif des inputs de calwake'
         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')
@@ -4417,8 +4416,8 @@
        itapwk = itapwk+1
 #ifdef ISOVERIF
-        write(*,*) 'physiq 4020: verif des outputs de calwake'
+        WRITE(*,*) 'physiq 4020: verif des outputs de calwake'
         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')
@@ -4518,41 +4517,41 @@
 #endif         
 #ifdef ISOVERIF         
-      write(*,*) 'physiq 3570'
+      WRITE(*,*) 'physiq 3570'
          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
+             endif !if (iso_eau.gt.0) 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  
+               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( &
                     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
-                  write(*,*) 'physic 4115: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
+                    '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 (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
                  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 3178: avant clmain')
-               endif !if (q_seri(i,k).gt.ridicule) then
-             endif !if (iso_O17.gt.0) then
+               endif !if (q_seri(i,k).gt.ridicule) THEN
+             endif !if (iso_O17.gt.0) THEN
 #ifdef ISOTRAC      
         CALL iso_verif_traceur(xt_seri(1,i,k),'physiq 3389')
         if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                  'physiq 3481, avant ajsec',1e-5) &
-                 .eq.1) then
-              write(*,*) 'i,k=',i,k 
+                 .eq.1) THEN
+              WRITE(*,*) 'i,k=',i,k
 #ifdef ISOVERIF
                   stop
@@ -4566,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
@@ -4576,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      
@@ -4692,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)
@@ -4790,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
@@ -4831,30 +4830,30 @@
 #endif         
 #ifdef ISOVERIF
-      write(*,*) 'physiq 3691c: avant CALL ajsec'
-      if (iso_eau.gt.0) then
+      WRITE(*,*) 'physiq 3691c: avant CALL ajsec'
+      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 (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
-                  write(*,*) 'physiq 4367: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
+                    'physiq 4051, avant ajsec').eq.1) THEN
+                  WRITE(*,*) 'physiq 4367: 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 (q_seri(i,k).gt.errmax) THEN
         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, &
@@ -4941,13 +4940,13 @@
 #ifdef ISO    
 #ifdef ISOVERIF
-      write(*,*) 'physiq 3837: verif avant ilp'
+      WRITE(*,*) 'physiq 3837: verif avant ilp'
 #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, &
@@ -4958,22 +4957,22 @@
        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) &
                  /q_seri(i,k),'physiq 3389')
-            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  
+            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( &
                     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
-                  write(*,*) 'physic 4475: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
+                    '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 (q_seri(i,k).gt.errmax) 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')
@@ -4982,11 +4981,11 @@
         if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                  'physiq 3707, avant fisrtilp',1e-5) &
-                 .eq.1) then
-              write(*,*) 'i,k=',i,k 
+                 .eq.1) THEN
+              WRITE(*,*) 'i,k=',i,k
 #ifdef ISOVERIF
                   stop
 #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')
@@ -5006,9 +5005,9 @@
            enddo
         enddo
-      write(*,*) 'physiq 3113: appel de fisrtilp'
+      WRITE(*,*) 'physiq 3113: appel de fisrtilp'
 #endif     
 !ISOVERIF
           if ((bidouille_anti_divergence).and. &
-                 (iso_eau.gt.0)) then
+                 (iso_eau.gt.0)) THEN
            do k=1,klev
             do i=1,klon  
@@ -5075,16 +5074,16 @@
       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), &
                         xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
                         'physiq 4335, avant il pleut')
-               endif ! if (iso_O18.gt.0) then  
-             endif !if (ql_seri(i,k).gt.errmax) then  
-         endif !if (iso_HDO.gt.0) then 
+               endif ! if (iso_O18.gt.0) THEN
+             endif !if (ql_seri(i,k).gt.errmax) THEN
+         endif !if (iso_HDO.gt.0) THEN
        ENDDO ! i=1,klon
       ENDDO !DO k = 1, klev
@@ -5093,8 +5092,8 @@
 
 !+JLD
-!    write(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
+!    WRITE(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
 !        & ,((rcw-rcpd)*rain_lsc + (rcs-rcpd)*snow_lsc)*t_seri(1,1)-rlvtt*rain_lsc+rlstt*snow_lsc &
 !        & ,rain_lsc,snow_lsc
-!    write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
+!    WRITE(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
 !-JLD 
     CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,dqbs0,paprs, &
@@ -5172,5 +5171,5 @@
 #ifdef ISO      
 !#ifdef ISOVERIF
-!      write(*,*) 'physiq 4030: verif apres ajout lsc'
+!      WRITE(*,*) 'physiq 4030: verif apres ajout lsc'
 !#endif      
 #ifdef ISOVERIF
@@ -5179,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, &
@@ -5193,53 +5192,53 @@
       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  
+          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( &
                     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
-                  write(*,*) 'physic 4656: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
+                    'physiq 2863, after il pleut').eq.1) THEN
+                  WRITE(*,*) 'physic 4656: i,k,q_seri(i,k)=',i,k,q_seri(i,k)
                   stop
                 endif
-              endif ! if (iso_O18.gt.0) then  
-            endif !if (q_seri(i,k).gt.errmax) then
-            if (ql_seri(i,k).gt.ridicule) then
+              endif ! if (iso_O18.gt.0) THEN
+            endif !if (q_seri(i,k).gt.errmax) 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_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
-                        write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
-                        write(*,*) 'd_ql_lsc(i,k)=',d_ql_lsc(i,k)
-                        write(*,*) 'deltaD(d_ql_lsc(i,k))=',deltaD( &
+                        '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)
+                        WRITE(*,*) 'deltaD(d_ql_lsc(i,k))=',deltaD( &
                                  d_xtl_lsc(iso_HDO,i,k)/d_ql_lsc(i,k))
-                        write(*,*) 'deltaO(d_ql_lsc(i,k))=',deltaO( &
+                        WRITE(*,*) 'deltaO(d_ql_lsc(i,k))=',deltaO( &
                                  d_xtl_lsc(iso_O18,i,k)/d_ql_lsc(i,k))
                         !stop
                  endif
-               endif ! if (iso_O18.gt.0) then  
-             endif !if (ql_seri(i,k).gt.errmax) then  
-         endif !if (iso_HDO.gt.0) then 
+               endif ! if (iso_O18.gt.0) THEN
+             endif !if (ql_seri(i,k).gt.errmax) THEN
+         endif !if (iso_HDO.gt.0) THEN
        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) &
                  /q_seri(i,k),'physiq 3549')
-           endif !if (q_seri(i,k).gt.ridicule) then
+           endif !if (q_seri(i,k).gt.ridicule) THEN
           enddo !do k=1,nlev
         enddo  !do i=1,klon        
-      endif !if (iso_O17.gt.0) then
+      endif !if (iso_O17.gt.0) THEN
 #endif  
 !#ifdef ISOVERIF
@@ -5247,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 (nzone_temp.ge.5) 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)
@@ -5262,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
@@ -5453,5 +5452,5 @@
       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), &
@@ -5459,20 +5458,20 @@
                  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
-              write(*,*) 'rain_fall(i)=',rain_lsc(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 (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
-              write(*,*) 'rain_fall(i)=',rain_fall(i)
+                 'physiq 3405').eq.1) THEN
+            if (rain_fall(i).ge.0.0) THEN
+              WRITE(*,*) 'rain_fall(i)=',rain_fall(i)
               stop
-            endif !if (rain_con(i).ge.0.0) then
+            endif !if (rain_con(i).ge.0.0) THEN
           endif  !if (iso_verif_positif_nostop
         ENDDO !DO i = 1, klon   
-      endif !if (iso_eau.gt.0) then
-      if (iso_HDO.gt.0) then
+      endif !if (iso_eau.gt.0) THEN
+      if (iso_HDO.gt.0) THEN
           DO i = 1, klon
           CALL iso_verif_aberrant_choix(xtsnow_fall(iso_hdo,i), &
@@ -5502,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)
@@ -5547,5 +5546,5 @@
        tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA
        IF (thermcep) THEN
-          IF(zt2m(i)<RTT) then
+          IF(zt2m(i)<RTT) THEN
              Lheat=RLSTT
           ELSE
@@ -6063,5 +6062,5 @@
 ! a declarer comme iflag_rrtm et a lire dans physiq.def
 #ifdef CPP_ECRAD
-          IF (ok_3Deffect) then
+          IF (ok_3Deffect) THEN
 !                PRINT*,'ok_3Deffect = ',ok_3Deffect
                 namelist_ecrad_file='namelist_ecrad_s2'
@@ -6302,5 +6301,5 @@
     ENDIF ! fin de test sur ok_orolf
 
-    IF (ok_hines) then
+    IF (ok_hines) THEN
        !  HINES GWD PARAMETRIZATION
        east_gwstress=0.
@@ -6330,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, &
@@ -6585,43 +6584,43 @@
 #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, &
                  '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 (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
-                  write(*,*) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k) 
-                  write(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
+                    '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)
                   stop
               endif !  if (iso_verif_o18_aberrant_nostop 
-            endif !if (q_seri(i,k).gt.errmax) then  
-            if (ql_seri(i,k).gt.ridicule) then  
+            endif !if (q_seri(i,k).gt.errmax) THEN
+            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
-                  write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k) 
+                    '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  
+            endif !if (q_seri(i,k).gt.errmax) THEN
+            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
-                  write(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k) 
+                    'physiq 5937c, juste apres methox, qs').eq.1) THEN
+                  WRITE(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k)
                   !stop
               endif !  if (iso_verif_o18_aberrant_nostop 
-            endif !if (q_seri(i,k).gt.errmax) then
+            endif !if (q_seri(i,k).gt.errmax) THEN
           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
@@ -6744,7 +6743,7 @@
        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
-          write(*,*) 'ixt,i,klon,k,klev=',ixt,i,klon,k,klev
-          write(*,*) 'xt_seri(iso_HTO,i,k)=',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)
           stop
           endif
@@ -6753,7 +6752,7 @@
        endif
 #endif
-!      write(*,*)'itap=',itap
-!      write(*,*)'itau_phy=',itau_phy
-!      write(*,*)'jD_cur=',jD_cur
+!      WRITE(*,*)'itap=',itap
+!      WRITE(*,*)'itau_phy=',itau_phy
+!      WRITE(*,*)'jD_cur=',jD_cur
 #endif
 !ifdef ISO
@@ -6762,8 +6761,7 @@
 ! Marine
 
-  IF (ok_airs) then
-
+  IF (ok_airs) 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
+     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,&
           map_prop_hc,map_prop_hist,&
@@ -7089,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
@@ -7144,39 +7142,39 @@
 
     IF (prt_level>=1) THEN
-       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
-       write(lunout,*) &
+       WRITE(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
+       WRITE(lunout,*) &
             'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
-       write(lunout,*) &
+       WRITE(lunout,*) &
             nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
             pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
             pctsrf(igout,is_sic)
-       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
+       WRITE(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
        DO k=1,klev
-          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
+          WRITE(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
                d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
                d_t_eva(igout,k)
        ENDDO
-       write(lunout,*) 'cool,heat'
+       WRITE(lunout,*) 'cool,heat'
        DO k=1,klev
-          write(lunout,*) cool(igout,k),heat(igout,k)
+          WRITE(lunout,*) cool(igout,k),heat(igout,k)
        ENDDO
 
        !jyg<     (En attendant de statuer sur le sort de d_t_oli)
-       !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
+       !jyg!     WRITE(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
        !jyg!     do k=1,klev
-       !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
+       !jyg!        WRITE(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
        !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
        !jyg!     enddo
-       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
+       WRITE(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
        DO k=1,klev
-          write(lunout,*) d_t_vdf(igout,k), &
+          WRITE(lunout,*) d_t_vdf(igout,k), &
                d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
        ENDDO
        !>jyg
 
-       write(lunout,*) 'd_ps ',d_ps(igout)
-       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
+       WRITE(lunout,*) 'd_ps ',d_ps(igout)
+       WRITE(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
        DO k=1,klev
-          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
+          WRITE(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
                d_qx(igout,k,1),d_qx(igout,k,2)
        ENDDO
@@ -7270,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
@@ -7292,17 +7290,17 @@
 #ifdef ISO   
 #ifdef ISOVERIF
-IF (iso_HDO.gt.0) then
+IF (iso_HDO.gt.0) THEN
       CALL iso_verif_aberrant_enc_vect2D( &
                  xt_ancien,q_ancien, &
                  'physiq 6577',ntraciso,klon,klev)
 END IF
-         write(*,*) 'physiq 3731: verif avant phyisoredem'    
+         WRITE(*,*) 'physiq 3731: verif avant phyisoredem'
          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', &
                  errmax,errmaxrel)
-            endif ! if (iso_eau.gt.0) then
+            endif ! if (iso_eau.gt.0) THEN
 #ifdef ISOTRAC
             IF(nzone > 0) CALL iso_verif_traceur(xt_ancien(1,i,k),'physiq 4802')
@@ -7322,5 +7320,5 @@
        CALL phyredem ("restartphy.nc")
        !         open(97,form="unformatted",file="finbin")
-       !         write(97) u_seri,v_seri,t_seri,q_seri
+       !         WRITE(97) u_seri,v_seri,t_seri,q_seri
        !         close(97)
       
Index: /LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90
===================================================================
--- /LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90	(revision 5115)
+++ /LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90	(revision 5116)
@@ -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,6 +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
