Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.f90	(revision 5117)
@@ -18,7 +18,7 @@
   !     ierr    = severity of situation ( = 0 normal )
 
-  CHARACTER(LEN=*), intent(in):: modname
+  CHARACTER(LEN=*), INTENT(IN):: modname
   INTEGER :: ierr, ierror_mpi
-  CHARACTER(LEN=*), intent(in):: message
+  CHARACTER(LEN=*), INTENT(IN):: message
 
   WRITE(lunout,*) 'in abort_gcm'
@@ -26,7 +26,7 @@
   CALL histclo
   CALL restclo
-  if (MPI_rank == 0) THEN
+  IF (MPI_rank == 0) THEN
      CALL getin_dump
-  endif
+  ENDIF
 !$OMP END MASTER
   ! CALL histclo(2)
@@ -36,10 +36,10 @@
   WRITE(lunout,*) 'Stopping in ', modname
   WRITE(lunout,*) 'Reason = ',message
-  if (ierr == 0) THEN
+  IF (ierr == 0) THEN
     WRITE(lunout,*) 'Everything is cool'
   else
     WRITE(lunout,*) 'Houston, we have a problem, ierr = ', ierr
 
-    if (using_mpi) THEN
+    IF (using_mpi) THEN
 !$OMP CRITICAL (MPI_ABORT_GCM)
       CALL MPI_ABORT(COMM_LMDZ, 1, ierror_mpi)
@@ -49,4 +49,4 @@
     endif
 
-  endif
+  ENDIF
 END SUBROUTINE abort_gcm
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90	(revision 5117)
@@ -96,5 +96,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  k    = 1, llm
@@ -109,7 +109,7 @@
    ENDDO
 !$OMP END DO NOWAIT
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  k    = 1, llm
@@ -124,11 +124,11 @@
    ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
   !
 
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -140,5 +140,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_nord) ijb=ij_begin
+  IF (pole_nord) ijb=ij_begin
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -151,5 +151,5 @@
 
   !
-  if (pole_sud)  ije=ij_end
+  IF (pole_sud)  ije=ij_end
 !$OMP MASTER
   DO j = ijb,ije
@@ -158,5 +158,5 @@
 !$OMP END MASTER
 
-  if (planet_type=="earth") THEN
+  IF (planet_type=="earth") THEN
   ! earth case, special treatment for first 2 tracers (water)
   DO iq = 1, 2
@@ -193,8 +193,8 @@
 !$OMP END DO NOWAIT
    ENDDO
-  endif ! of if (planet_type=="earth")
+  ENDIF ! of if (planet_type=="earth")
 
 !$OMP MASTER
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO  ij   = 1, iim
       xpn(ij) = aire(   ij   ) * pps(  ij     )
@@ -207,7 +207,7 @@
     ENDDO
 
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
     DO  ij   = 1, iim
       xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
@@ -220,8 +220,8 @@
     ENDDO
 
-  endif
+  ENDIF
 !$OMP END MASTER
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO iq = 1, nqtot
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -238,7 +238,7 @@
 !$OMP END DO NOWAIT	
     ENDDO
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
     DO iq = 1, nqtot
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -255,5 +255,5 @@
 !$OMP END DO NOWAIT	
     ENDDO
-  endif
+  ENDIF
 
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.f90	(revision 5117)
@@ -75,6 +75,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ijb + iip1
-  if (pole_sud)  ije = ije - iip1
+  IF (pole_nord) ijb = ijb + iip1
+  IF (pole_sud)  ije = ije - iip1
 
   DO ij = ijb, ije
@@ -85,5 +85,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   DO ij = ijb, ije
@@ -107,6 +107,6 @@
     ijb = ij_begin
     ije = ij_end
-    if (pole_nord) ijb = ijb + iip1
-    if (pole_sud)  ije = ije - iip1
+    IF (pole_nord) ijb = ijb + iip1
+    IF (pole_sud)  ije = ije - iip1
 
     ! DO    ij     = iip2, ip1jmp1
@@ -124,5 +124,5 @@
     ENDDO
 
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO      ij = 1, iip1
         uav(ij, l) = 0.
@@ -130,5 +130,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO      ij = 1, iip1
         uav(ip1jm + ij, l) = 0.
@@ -145,5 +145,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -180,5 +180,5 @@
     ijb = ij_begin
     ije = ij_end + iip1
-    if (pole_sud)  ije = ij_end
+    IF (pole_sud)  ije = ij_end
 
     DO ij = ijb, ije
@@ -191,6 +191,6 @@
     ijb = ij_begin
     ije = ij_end
-    if (pole_nord) ijb = ijb + iip1
-    if (pole_sud)  ije = ije - iip1
+    IF (pole_nord) ijb = ijb + iip1
+    IF (pole_sud)  ije = ije - iip1
 
     DO ij = ijb, ije - 1
@@ -204,5 +204,5 @@
     ijb = ij_begin
     ije = ij_end
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_sud)  ije = ij_end - iip1
 
     DO ij = ijb, ije
@@ -247,6 +247,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ijb + iip1
-  if (pole_sud)  ije = ije - iip1
+  IF (pole_nord) ijb = ijb + iip1
+  IF (pole_sud)  ije = ije - iip1
   IF (CPPKEY_DEBUGIO) THEN
     CALL WriteField_u('du_bis', du)
@@ -270,5 +270,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90	(revision 5117)
@@ -14,9 +14,9 @@
   USE Bands
   USE mod_hallo
-  USE Vampir
+  USE lmdz_vampir
   USE times
   USE advtrac_mod, ONLY: finmasse
   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
-  USE strings_mod, ONLY: int2str
+  USE lmdz_strings, ONLY: int2str
   USE lmdz_description, ONLY: descript
   USE lmdz_libmath, ONLY: minmax
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90	(revision 5117)
@@ -4,14 +4,14 @@
   module Bands
   USE parallel_lmdz
-    integer, parameter :: bands_caldyn=1
-    integer, parameter :: bands_vanleer=2
-    integer, parameter :: bands_dissip=3
+    INTEGER, parameter :: bands_caldyn=1
+    INTEGER, parameter :: bands_vanleer=2
+    INTEGER, parameter :: bands_dissip=3
     
-    INTEGER,dimension(:),allocatable :: jj_Nb_Caldyn
-    INTEGER,dimension(:),allocatable :: jj_Nb_vanleer
-    INTEGER,dimension(:),allocatable :: jj_Nb_vanleer2
-    INTEGER,dimension(:),allocatable :: jj_Nb_dissip
-    INTEGER,dimension(:),allocatable :: jj_Nb_physic
-    INTEGER,dimension(:),allocatable :: jj_Nb_physic_bis
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_Caldyn
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_vanleer
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_vanleer2
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_dissip
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_physic
+    INTEGER,DIMENSION(:),ALLOCATABLE :: jj_Nb_physic_bis
    
     TYPE(distrib),SAVE,TARGET :: distrib_Caldyn
@@ -22,5 +22,5 @@
     TYPE(distrib),SAVE,TARGET :: distrib_physic_bis
 
-    INTEGER,dimension(:),allocatable :: distrib_phys
+    INTEGER,DIMENSION(:),ALLOCATABLE :: distrib_phys
   
   contains
@@ -46,6 +46,6 @@
     include "dimensions.h"
       INTEGER :: i,j
-      character (len=4) :: siim,sjjm,sllm,sproc
-      character (len=255) :: filename
+      CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
+      CHARACTER (LEN=255) :: filename
       INTEGER :: unit_number=10
       INTEGER :: ierr
@@ -61,5 +61,5 @@
       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr)
       
-      if (ierr==0) THEN
+      IF (ierr==0) THEN
          do i=0,mpi_size-1
           read (unit_number,*) j,jj_nb_caldyn(i)
@@ -83,5 +83,5 @@
         do i=0,mpi_size-1
           jj_nb_caldyn(i)=(jjm+1)/mpi_size
-	  if (i<MOD(jjm+1,mpi_size)) jj_nb_caldyn(i)=jj_nb_caldyn(i)+1
+	  IF (i<MOD(jjm+1,mpi_size)) jj_nb_caldyn(i)=jj_nb_caldyn(i)+1
         enddo
       
@@ -112,5 +112,5 @@
       do i=0,mpi_size-1
          jj_nb_vanleer2(i)=(jjm+1)/mpi_size
-	 if (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
+	 IF (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
       enddo
           
@@ -128,6 +128,6 @@
        do i=0,MPI_Size-1
         jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
-        if (i/=0) THEN
-          if (jj_para_begin(i)==jj_para_end(i-1)) THEN
+        IF (i/=0) THEN
+          IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
             jj_Nb_physic(i-1)=jj_Nb_physic(i-1)-1
           endif
@@ -137,11 +137,11 @@
       do i=0,MPI_Size-1
         jj_Nb_physic_bis(i)=jj_para_end(i)-jj_para_begin(i)+1
-        if (i/=0) THEN
-          if (jj_para_begin(i)==jj_para_end(i-1)) THEN
+        IF (i/=0) THEN
+          IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
             jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
           else
 	    jj_Nb_physic_bis(i-1)=jj_Nb_physic_bis(i-1)+1
 	    jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
-	  endif
+	  ENDIF
         endif
       enddo
@@ -174,5 +174,5 @@
 
     SUBROUTINE AdjustBands_caldyn(new_dist)
-      use times
+      USE times
       USE parallel_lmdz
       IMPLICIT NONE
@@ -182,6 +182,6 @@
       INTEGER :: min_proc,max_proc
       INTEGER :: i,j
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: index
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
       REAL :: tmpvalue
       INTEGER :: tmpindex
@@ -200,5 +200,5 @@
       do i=0,mpi_size-2
         do j=i+1,mpi_size-1
-	  if (value(i)>value(j)) THEN
+	  IF (value(i)>value(j)) THEN
 	    tmpvalue=value(i)
 	    value(i)=value(j)
@@ -218,11 +218,11 @@
         minvalue=value(i)
         min_proc=index(i)
-        if (jj_nb_caldyn(max_proc)>2) THEN
-          if (timer_iteration(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)<=1 ) THEN
+        IF (jj_nb_caldyn(max_proc)>2) THEN
+          IF (timer_iteration(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)<=1 ) THEN
              jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
              jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
 	     exit
            else
-             if (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)                 &
+             IF (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)                 &
 	        -timer_delta(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) < maxvalue) THEN
                jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
@@ -241,5 +241,5 @@
     
     SUBROUTINE AdjustBands_vanleer(new_dist)
-      use times
+      USE times
       USE parallel_lmdz
       IMPLICIT NONE
@@ -249,6 +249,6 @@
       INTEGER :: min_proc,max_proc
       INTEGER :: i,j
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: index
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
       REAL :: tmpvalue
       INTEGER :: tmpindex
@@ -267,5 +267,5 @@
       do i=0,mpi_size-2
         do j=i+1,mpi_size-1
-	  if (value(i)>value(j)) THEN
+	  IF (value(i)>value(j)) THEN
 	    tmpvalue=value(i)
 	    value(i)=value(j)
@@ -286,6 +286,6 @@
         min_proc=index(i)
 
-        if (jj_nb_vanleer(max_proc)>2) THEN
-          if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc)==0. .or. &
+        IF (jj_nb_vanleer(max_proc)>2) THEN
+          IF (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc)==0. .OR. &
              timer_average(jj_nb_vanleer(max_proc)-1,timer_vanleer,max_proc)==0.) THEN
              jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
@@ -293,5 +293,5 @@
 	     exit
            else
-             if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) THEN
+             IF (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) THEN
                jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
                jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
@@ -310,5 +310,5 @@
 
     SUBROUTINE AdjustBands_dissip(new_dist)
-      use times
+      USE times
       USE parallel_lmdz
       IMPLICIT NONE
@@ -318,6 +318,6 @@
       INTEGER :: min_proc,max_proc
       INTEGER :: i,j
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: index
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
       REAL :: tmpvalue
       INTEGER :: tmpindex
@@ -336,5 +336,5 @@
       do i=0,mpi_size-2
         do j=i+1,mpi_size-1
-	  if (value(i)>value(j)) THEN
+	  IF (value(i)>value(j)) THEN
 	    tmpvalue=value(i)
 	    value(i)=value(j)
@@ -355,11 +355,11 @@
         min_proc=index(i)
 
-        if (jj_nb_dissip(max_proc)>3) THEN
-          if (timer_iteration(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)<=1) THEN
+        IF (jj_nb_dissip(max_proc)>3) THEN
+          IF (timer_iteration(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)<=1) THEN
              jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
              jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
 	     exit
            else
-             if (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)         &
+             IF (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)         &
 	        - timer_delta(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) < maxvalue) THEN
                jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
@@ -379,5 +379,5 @@
 
     SUBROUTINE AdjustBands_physic
-      use times
+      USE times
 
       ! Ehouarn: what follows is only related to // physics
@@ -389,6 +389,6 @@
 
       INTEGER :: i,Index
-      real,allocatable,dimension(:) :: value
-      integer,allocatable,dimension(:) :: Inc
+      REAL,ALLOCATABLE,DIMENSION(:) :: value
+      INTEGER,ALLOCATABLE,DIMENSION(:) :: Inc
       REAL :: medium
       INTEGER :: NbTot,sgn
@@ -414,5 +414,5 @@
       enddo
       
-      if (NbTot>=0) THEN
+      IF (NbTot>=0) THEN
         Sgn=1
       else
@@ -425,5 +425,5 @@
         Inc(Index)=Inc(Index)-Sgn
 	Index=Index+1
-	if (Index>mpi_size-1) Index=0
+	IF (Index>mpi_size-1) Index=0
       enddo
       
@@ -441,6 +441,6 @@
 
       INTEGER :: i,j
-      character (len=4) :: siim,sjjm,sllm,sproc
-      character (len=255) :: filename
+      CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
+      CHARACTER (LEN=255) :: filename
       INTEGER :: unit_number=10
       INTEGER :: ierr
@@ -456,5 +456,5 @@
       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
       
-      if (ierr==0) THEN
+      IF (ierr==0) THEN
 !	write (unit_number,*) '*** Bandes caldyn ***'
 	do i=0,mpi_size-1
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.f90	(revision 5117)
@@ -45,9 +45,9 @@
   ijb=ij_begin
   ije=ij_end+iip1
-  if (pole_sud) ije=ij_end
+  IF (pole_sud) ije=ij_end
 
   jjb=jj_begin
   jje=jj_end+1
-  if (pole_sud) jje=jj_end
+  IF (pole_sud) jje=jj_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90	(revision 5117)
@@ -13,5 +13,5 @@
   USE parallel_lmdz
   USE mod_hallo
-  use misc_mod
+  USE misc_mod
   USE write_field_loc
   USE comconst_mod, ONLY: cpp, pi
@@ -56,5 +56,5 @@
   !   =======
 
-  integer,SAVE :: icum,ncum
+  INTEGER,SAVE :: icum,ncum
 !$OMP THREADPRIVATE(icum,ncum)
   LOGICAL,SAVE :: first=.TRUE.
@@ -76,10 +76,10 @@
   parameter (ifile=4)
 
-  integer,PARAMETER :: itemp=1,igeop=2,iecin=3,iang=4,iu=5
+  INTEGER,PARAMETER :: itemp=1,igeop=2,iecin=3,iang=4,iu=5
   INTEGER,PARAMETER :: iovap=6,iun=7
-  integer,PARAMETER :: i_sortie=1
-
-  real,SAVE :: time=0.
-  integer,SAVE :: itau=0.
+  INTEGER,PARAMETER :: i_sortie=1
+
+  REAL,SAVE :: time=0.
+  INTEGER,SAVE :: itau=0.
 !$OMP THREADPRIVATE(time,itau)
 
@@ -95,16 +95,16 @@
 
   !   champ contenant les scalaires advectés.
-  real,SAVE,ALLOCATABLE :: Q(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE :: Q(:,:,:,:)
 
   !   champs cumulés
-  real,SAVE,ALLOCATABLE ::  ps_cum(:,:)
-  real,SAVE,ALLOCATABLE ::  masse_cum(:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_u_cum(:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_v_cum(:,:,:)
-  real,SAVE,ALLOCATABLE ::  Q_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_uQ_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_vQ_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  flux_wQ_cum(:,:,:,:)
-  real,SAVE,ALLOCATABLE ::  dQ(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  ps_cum(:,:)
+  REAL,SAVE,ALLOCATABLE ::  masse_cum(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_u_cum(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_v_cum(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  Q_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_uQ_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_vQ_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  flux_wQ_cum(:,:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  dQ(:,:,:,:)
 
 
@@ -125,9 +125,9 @@
   data ctrs/'  ','TOT','MMC','TRS','STN'/
 
-  real,SAVE,ALLOCATABLE ::  zvQ(:,:,:,:),zvQtmp(:,:)
-  real,SAVE,ALLOCATABLE ::  zavQ(:,:,:),psiQ(:,:,:)
-  real,SAVE,ALLOCATABLE ::  zmasse(:,:),zamasse(:)
-
-  real,SAVE,ALLOCATABLE ::  zv(:,:),psi(:,:)
+  REAL,SAVE,ALLOCATABLE ::  zvQ(:,:,:,:),zvQtmp(:,:)
+  REAL,SAVE,ALLOCATABLE ::  zavQ(:,:,:),psiQ(:,:,:)
+  REAL,SAVE,ALLOCATABLE ::  zmasse(:,:),zamasse(:)
+
+  REAL,SAVE,ALLOCATABLE ::  zv(:,:),psi(:,:)
 
   INTEGER :: i,j,l,iQ
@@ -139,5 +139,5 @@
   CHARACTER(LEN=10) :: infile
 
-  integer, save :: fileid
+  INTEGER, save :: fileid
   INTEGER :: thoriid, zvertiid
 
@@ -153,5 +153,5 @@
   INTEGER :: zan, dayref
   !
-  real,SAVE,ALLOCATABLE :: rlong(:),rlatg(:)
+  REAL,SAVE,ALLOCATABLE :: rlong(:),rlatg(:)
   INTEGER :: jjb,jje,jjn,ijb,ije
   type(Request),SAVE :: Req
@@ -173,10 +173,10 @@
   !   Initialisation
   !=====================================================================
-  if (adjust) return
+  IF (adjust) return
 
   time=time+dt_app
   itau=itau+1
 
-  if (first) THEN
+  IF (first) THEN
 !$OMP BARRIER
 !$OMP MASTER
@@ -223,5 +223,5 @@
   !   ncum est la frequence de stokage en pas de temps
     ncum=dt_cum/dt_app
-    if (abs(ncum*dt_app-dt_cum)>1.e-5*dt_app) THEN
+    IF (abs(ncum*dt_app-dt_cum)>1.e-5*dt_app) THEN
        WRITE(lunout,*) &
              'Pb : le pas de cumule doit etre multiple du pas'
@@ -358,5 +358,5 @@
 
 !$OMP END MASTER
-  endif
+  ENDIF
 
 
@@ -419,10 +419,10 @@
       Q_cum(:,jjb:jje,l,:)=0.
       flux_uQ_cum(:,jjb:jje,l,:)=0.
-      if (pole_sud) jje=jj_end-1
+      IF (pole_sud) jje=jj_end-1
       flux_v_cum(:,jjb:jje,l)=0.
       flux_vQ_cum(:,jjb:jje,l,:)=0.
     ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
 
   IF (prt_level > 5) &
@@ -447,5 +447,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -499,5 +499,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   do iQ=1,nQ
@@ -582,5 +582,5 @@
   !   PAS DE TEMPS D'ECRITURE
   !=====================================================================
-  if (icum==ncum) THEN
+  IF (icum==ncum) THEN
   !=====================================================================
 
@@ -647,5 +647,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -670,5 +670,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -717,5 +717,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   zvQ=0.
@@ -776,10 +776,10 @@
   !   sorties proprement dites
 !$OMP MASTER
-  if (i_sortie==1) THEN
+  IF (i_sortie==1) THEN
   jjb=jj_begin
   jje=jj_end
   jjn=jj_nb
-  if (pole_sud) jje=jj_end-1
-  if (pole_sud) jjn=jj_nb-1
+  IF (pole_sud) jje=jj_end-1
+  IF (pole_sud) jjn=jj_nb-1
   do iQ=1,nQ
      do itr=1,ntr
@@ -801,5 +801,5 @@
         jjn*llm,ndex3d)
 
-  endif
+  ENDIF
 
 
@@ -832,5 +832,5 @@
   !/////////////////////////////////////////////////////////////////////
   icum=0                  !///////////////////////////////////////
-  endif ! icum.eq.ncum    !///////////////////////////////////////
+  ENDIF ! icum.EQ.ncum    !///////////////////////////////////////
   !/////////////////////////////////////////////////////////////////////
   !=====================================================================
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.f90	(revision 5117)
@@ -13,5 +13,5 @@
   USE bands
   USE times
-  USE Vampir
+  USE lmdz_vampir
   USE write_field_loc
   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
@@ -60,6 +60,6 @@
   ijbv = ij_begin - iip1
   ijev = ij_end
-  if (pole_nord) ijbv = ij_begin
-  if (pole_sud)  ijev = ij_end - iip1
+  IF (pole_nord) ijbv = ij_begin
+  IF (pole_sud)  ijev = ij_end - iip1
 
   IF(iadvtr==0) THEN
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caldyn_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caldyn_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caldyn_loc.f90	(revision 5117)
@@ -144,6 +144,6 @@
   ije = ij_end + iip1
 
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud) ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud) ije = ij_end
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -162,5 +162,5 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90	(revision 5117)
@@ -82,5 +82,5 @@
     USE mod_hallo
     USE Bands
-    USE vampir
+    USE lmdz_vampir
     USE write_field_loc
     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
@@ -240,5 +240,5 @@
       !$OMP END DO NOWAIT
 
-      if (1 == 0) THEN
+      IF (1 == 0) THEN
         !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
         !!!                     2) should probably not be here anyway
@@ -274,5 +274,5 @@
       !$OMP END DO NOWAIT
 
-      if (1 == 0) THEN
+      IF (1 == 0) THEN
         !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
         !!!                     2) should probably not be here anyway
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90	(revision 5117)
@@ -1,5 +1,5 @@
 SUBROUTINE check_isotopes(q, ijb, ije, err_msg)
    USE parallel_lmdz
-   USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
+   USE lmdz_strings, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
    USE infotrac,    ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, &
                           ntiso, iH2O, nzone, tracers, isoName,  itZonIso, getKey
@@ -38,5 +38,5 @@
       iso_O17 = strIdx(isoName,'H217O')
       iso_HTO = strIdx(isoName,'HTO')
-      if (tnat1) THEN
+      IF (tnat1) THEN
               tnat(:)=1.0
       else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90	(revision 5117)
@@ -91,5 +91,5 @@
   lunout=6
   CALL getin('lunout', lunout)
-  IF (lunout /= 5 .and. lunout /= 6) THEN
+  IF (lunout /= 5 .AND. lunout /= 6) THEN
      OPEN(UNIT=lunout,FILE='lmdz.out_0000',ACTION='write',  &
           STATUS='unknown',FORM='formatted')
@@ -102,5 +102,5 @@
   ! adjust=y not implemented in case of OpenMP threads...
   !$OMP PARALLEL
-  IF ((OMP_GET_NUM_THREADS()>1).and.adjust) THEN
+  IF ((OMP_GET_NUM_THREADS()>1).AND.adjust) THEN
      WRITE(lunout,*)'conf_gcm: Error, adjust should be set to n' &
           ,' when running with OpenMP threads'
@@ -340,5 +340,5 @@
   maxlatfilter = -1.0
   CALL getin('maxlatfilter',maxlatfilter)
-  if (maxlatfilter > 90) &
+  IF (maxlatfilter > 90) &
        CALL abort_gcm("conf_gcm", 'maxlatfilter should be <=90', 1)
   
@@ -359,5 +359,5 @@
   iflag_top_bound=1
   CALL getin('iflag_top_bound',iflag_top_bound)
-  IF (iflag_top_bound < 0 .or. iflag_top_bound > 2) &
+  IF (iflag_top_bound < 0 .OR. iflag_top_bound > 2) &
        CALL abort_gcm("conf_gcm", 'iflag_top_bound must be 0, 1 or 2', 1)
 
@@ -396,5 +396,5 @@
   CALL getin('ok_guide',ok_guide)
 
-  IF (ok_guide .and. adjust) CALL abort_gcm("conf_gcm", &
+  IF (ok_guide .AND. adjust) CALL abort_gcm("conf_gcm", &
        "adjust does not work with ok_guide", 1)
 
@@ -436,5 +436,5 @@
   !     .........   (  modif  le 17/04/96 )   .........
 
-  test_etatinit: IF (.not. etatinit) THEN
+  test_etatinit: IF (.NOT. etatinit) THEN
      !Config  Key  = clon
      !Config  Desc = centre du zoom, longitude
@@ -933,7 +933,7 @@
      CALL getin('ok_strato',ok_strato)
 
-     vert_prof_dissip = merge(1, 0, ok_strato .and. llm==39)
+     vert_prof_dissip = merge(1, 0, ok_strato .AND. llm==39)
      CALL getin('vert_prof_dissip', vert_prof_dissip)
-     CALL assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1, &
+     CALL assert(vert_prof_dissip == 0 .OR. vert_prof_dissip ==  1, &
           "bad value for vert_prof_dissip")
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90	(revision 5117)
@@ -33,13 +33,13 @@
   ijev=ij_end+iip1
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     ijbu=ij_begin+iip1
     ijbv=ij_begin
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     ijeu=ij_end-iip1
     ijev=ij_end-iip1
-  endif
+  ENDIF
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.f90	(revision 5117)
@@ -34,5 +34,5 @@
   ije=ij_end
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l = 1,klevel
@@ -42,7 +42,7 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l = 1,klevel
@@ -52,10 +52,10 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -69,6 +69,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.f90	(revision 5117)
@@ -92,5 +92,5 @@
   !$OMP END DO NOWAIT
 
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -121,9 +121,9 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud) ije = ij_end - iip1
-
-  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-  DO l = 1, llm
-    if (pole_nord) THEN
+  IF (pole_sud) ije = ij_end - iip1
+
+  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l = 1, llm
+    IF (pole_nord) THEN
       DO ij = 1, iip1
         gdx(ij, l) = 0.
@@ -131,5 +131,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO ij = 1, iip1
         gdx(ij + ip1jm, l) = 0.
@@ -137,10 +137,10 @@
     endif
 
-    if (pole_nord) ijb = ij_begin + iip1
+    IF (pole_nord) ijb = ij_begin + iip1
     DO ij = ijb, ije
       du(ij, l) = du(ij, l) - te1dt(l) * gdx(ij, l)
     ENDDO
 
-    if (pole_nord) ijb = ij_begin
+    IF (pole_nord) ijb = ij_begin
     DO ij = ijb, ije
       dv(ij, l) = dv(ij, l) - te1dt(l) * gdy(ij, l)
@@ -166,10 +166,10 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_sud) ije = ij_end - iip1
-
-  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-  DO l = 1, llm
-
-    if (pole_nord) THEN
+  IF (pole_sud) ije = ij_end - iip1
+
+  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+  DO l = 1, llm
+
+    IF (pole_nord) THEN
       DO ij = 1, iip1
         grx(ij, l) = 0.
@@ -177,10 +177,10 @@
     endif
 
-    if (pole_nord) ijb = ij_begin + iip1
+    IF (pole_nord) ijb = ij_begin + iip1
     DO ij = ijb, ije
       du(ij, l) = du(ij, l) - te2dt(l) * grx(ij, l)
     ENDDO
 
-    if (pole_nord) ijb = ij_begin
+    IF (pole_nord) ijb = ij_begin
     DO ij = ijb, ije
       dv(ij, l) = dv(ij, l) - te2dt(l) * gry(ij, l)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.f90	(revision 5117)
@@ -47,5 +47,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
+  IF (pole_nord) ijb=ij_begin+iip1
   IF(pole_sud)  ije=ij_end-iip1
 
@@ -70,5 +70,5 @@
   ! ....  calcul  aux poles  .....
   !
-   if (pole_nord) THEN
+   IF (pole_nord) THEN
       DO  ij  = 1,iim
        aiy1(ij) =    cuvscvgam(    ij       ) * y(     ij     , l )
@@ -81,5 +81,5 @@
    endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO  ij  = 1,iim
        aiy2(ij) =    cuvscvgam( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90	(revision 5117)
@@ -43,5 +43,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
+  IF (pole_nord) ijb=ij_begin+iip1
   IF(pole_sud)  ije=ij_end-iip1
 
@@ -65,5 +65,5 @@
   ! ....  calcul  aux poles  .....
   !
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO  ij  = 1,iim
        aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
@@ -76,5 +76,5 @@
     endif
 
-   if (pole_sud) THEN
+   IF (pole_sud) THEN
       DO  ij  = 1,iim
        aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90	(revision 5117)
@@ -45,5 +45,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
+  IF (pole_nord) ijb=ij_begin+iip1
   IF(pole_sud)  ije=ij_end-iip1
 
@@ -68,5 +68,5 @@
   ! ....  calcul  aux poles  .....
   !
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO  ij  = 1,iim
        aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
@@ -81,5 +81,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO  ij  = 1,iim
        aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
@@ -99,5 +99,5 @@
     jjb=jj_begin
     jje=jj_end
-    if (pole_sud) jje=jj_end-1
+    IF (pole_sud) jje=jj_end-1
 
     CALL filtreg_p( div,jjb_u,jje_u,jjb,jje, jjp1, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90	(revision 5117)
@@ -44,6 +44,6 @@
   ije=ij_end
 
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb, ije - 1
@@ -60,5 +60,5 @@
 
   ijb=ij_begin-iip1
-  if (pole_nord) ijb=ij_begin
+  IF (pole_nord) ijb=ij_begin
 
   DO ij = ijb,ije
@@ -66,5 +66,5 @@
   END DO
 
-   if (.not. pole_sud) THEN
+   IF (.NOT. pole_sud) THEN
       hbxu(ije+1:ije+iip1,l) = 0
       hbyv(ije+1:ije+iip1,l) = 0
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.f90	(revision 5117)
@@ -33,6 +33,6 @@
   ije=ij_end
 
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb, ije-1
@@ -44,5 +44,5 @@
 
   !
-  if (pole_nord) ijb=ij_begin
+  IF (pole_nord) ijb=ij_begin
 
   DO ij = ijb, ije-1
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90	(revision 5117)
@@ -37,6 +37,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ijb+iip1
-  if (pole_sud)  ije=ije-iip1
+  IF (pole_nord) ijb=ijb+iip1
+  IF (pole_sud)  ije=ije-iip1
 
   DO ij  = ijb, ije - 1
@@ -55,5 +55,5 @@
   !
   !
-  if (pole_nord) ijb=ijb-iip1
+  IF (pole_nord) ijb=ijb-iip1
 
   DO ij  = ijb,ije
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90	(revision 5117)
@@ -8,8 +8,8 @@
   USE parallel_lmdz
   USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
-  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
+  USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
   USE netcdf,      ONLY: nf90_open,  nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, &
                          nf90_close, nf90_get_var, nf90_inquire_variable,  nf90_noerr
-  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
+  USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
   USE control_mod, ONLY: planet_type
   USE lmdz_assert_eq, ONLY: assert_eq
@@ -182,5 +182,5 @@
       iqParent = tracers(iq)%iqParent
       IF(tracers(iq)%iso_iZone == 0) THEN
-         if (tnat1) THEN
+         IF (tnat1) THEN
                  tnat=1.0
                  alpha_ideal=1.0
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90	(revision 5117)
@@ -7,5 +7,5 @@
   USE parallel_lmdz
   USE mod_hallo
-  USE strings_mod, ONLY: maxlen
+  USE lmdz_strings, ONLY: maxlen
   USE infotrac, ONLY: nqtot, tracers
   USE netcdf, ONLY: nf90_create, nf90_def_dim, nf90_inq_varid, nf90_global,    &
@@ -166,5 +166,5 @@
   USE parallel_lmdz
   USE mod_hallo
-  USE strings_mod, ONLY: maxlen
+  USE lmdz_strings, ONLY: maxlen
   USE infotrac, ONLY: nqtot, tracers, type_trac
   USE control_mod
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90	(revision 5117)
@@ -63,16 +63,16 @@
 
     ! Sanity check
-    if (firstcall) THEN
+    IF (firstcall) THEN
       ! sanity checks for Shallow Water case (1 vertical layer)
-      if (llm==1) THEN
-        if (kappa/=1) THEN
+      IF (llm==1) THEN
+        IF (kappa/=1) THEN
           CALL abort_gcm(modname, &
                   "kappa!=1 , but running in Shallow Water mode!!", 42)
         endif
-        if (cpp/=r) THEN
+        IF (cpp/=r) THEN
           CALL abort_gcm(modname, &
                   "cpp!=r , but running in Shallow Water mode!!", 42)
         endif
-      endif ! of if (llm.eq.1)
+      endif ! of if (llm.EQ.1)
 
       firstcall = .FALSE.
@@ -82,5 +82,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) THEN
+    IF (llm==1) THEN
       ! Compute pks(:),pk(:),pkf(:)
       ijb = ij_begin
@@ -90,10 +90,10 @@
         pks(ij) = (cpp / preff) * ps(ij)
         pk(ij, 1) = .5 * pks(ij)
-        if (present(pkf)) pkf(ij, 1) = pk(ij, 1)
+        IF (present(pkf)) pkf(ij, 1) = pk(ij, 1)
       ENDDO
       !$OMP ENDDO
 
       !$OMP BARRIER
-      if (present(pkf)) THEN
+      IF (present(pkf)) THEN
         jjb = jj_begin
         jje = jj_end
@@ -104,5 +104,5 @@
       ! our work is done, exit routine
       RETURN
-    endif ! of if (llm.eq.1)
+    endif ! of if (llm.EQ.1)
 
     ! General case:
@@ -169,5 +169,5 @@
     ENDDO
 
-    if (present(pkf)) THEN
+    IF (present(pkf)) THEN
       !    calcul de pkf
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90	(revision 5117)
@@ -56,16 +56,16 @@
 
     ! Sanity check
-    if (firstcall) THEN
+    IF (firstcall) THEN
        ! sanity checks for Shallow Water case (1 vertical layer)
-       if (llm==1) THEN
-          if (kappa/=1) THEN
+       IF (llm==1) THEN
+          IF (kappa/=1) THEN
              CALL abort_gcm(modname, &
                   "kappa!=1 , but running in Shallow Water mode!!",42)
           endif
-          if (cpp/=r) THEN
+          IF (cpp/=r) THEN
              CALL abort_gcm(modname, &
                   "cpp!=r , but running in Shallow Water mode!!",42)
           endif
-       endif ! of if (llm.eq.1)
+       endif ! of if (llm.EQ.1)
 
        firstcall=.FALSE.
@@ -75,5 +75,5 @@
 
     ! Specific behaviour for Shallow Water (1 vertical layer) case:
-    if (llm==1) THEN
+    IF (llm==1) THEN
        ! Compute pks(:),pk(:),pkf(:)
        ijb=ij_begin
@@ -83,10 +83,10 @@
           pks(ij) = (cpp/preff) * ps(ij)
           pk(ij,1) = .5*pks(ij)
-          if (present(pkf)) pkf(ij,1)=pk(ij,1)
+          IF (present(pkf)) pkf(ij,1)=pk(ij,1)
        ENDDO
        !$OMP ENDDO
 
        !$OMP BARRIER
-       if (present(pkf)) THEN
+       IF (present(pkf)) THEN
           jjb=jj_begin
           jje=jj_end
@@ -97,5 +97,5 @@
        ! our work is done, exit routine
        RETURN
-    endif ! of if (llm.eq.1)
+    endif ! of if (llm.EQ.1)
 
     ! General case:
@@ -140,5 +140,5 @@
     !$OMP ENDDO NOWAIT        
 
-    if (present(pkf)) THEN
+    IF (present(pkf)) THEN
        !    calcul de pkf
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F90	(revision 5117)
@@ -99,5 +99,5 @@
   !-------------------------------------------------------c
 
-  IF(ifiltre==1.or.ifiltre==-1) &
+  IF(ifiltre==1.OR.ifiltre==-1) &
         CALL abort_gcm("fitreg_p","Pas de transformee simple&
         &dans cette version",1)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.f90	(revision 5117)
@@ -10,5 +10,5 @@
   USE bands
   USE times
-  USE Vampir
+  USE lmdz_vampir
   USE write_field_loc
 
@@ -50,6 +50,6 @@
   ijbv = ij_begin - iip1
   ijev = ij_end
-  if (pole_nord) ijbv = ij_begin
-  if (pole_sud)  ijev = ij_end - iip1
+  IF (pole_nord) ijbv = ij_begin
+  IF (pole_sud)  ijev = ij_end - iip1
 
   IF(pasflx==0) THEN
@@ -116,5 +116,5 @@
     !$OMP ENDDO NOWAIT
 
-    if (pole_sud) ije = ij_end - iip1
+    IF (pole_sud) ije = ij_end - iip1
 
     !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.f90	(revision 5117)
@@ -29,7 +29,7 @@
 
   ! arguments:
-  REAL,INTENT(inout) :: ucov( iip1,jjb_u:jje_u,llm )
-  REAL,INTENT(inout) :: vcov( iip1,jjb_v:jje_v,llm )
-  REAL,INTENT(in) :: pdt ! time step
+  REAL,INTENT(INOUT) :: ucov( iip1,jjb_u:jje_u,llm )
+  REAL,INTENT(INOUT) :: vcov( iip1,jjb_v:jje_v,llm )
+  REAL,INTENT(IN) :: pdt ! time step
 
   ! local variables:
@@ -51,5 +51,5 @@
     ! set friction type
     CALL getin("friction_type",friction_type)
-    if ((friction_type<0).or.(friction_type>1)) THEN
+    IF ((friction_type<0).OR.(friction_type>1)) THEN
       abort_message="wrong friction type"
       WRITE(lunout,*)'Friction: wrong friction type',friction_type
@@ -60,10 +60,10 @@
 !$OMP END SINGLE COPYPRIVATE(friction_type,firstcall)
 
-  if (friction_type==0) then ! friction on first layer only
+  IF (friction_type==0) then ! friction on first layer only
 !$OMP SINGLE
   !   calcul des composantes au carre du vent naturel
   jjb=jj_begin
   jje=jj_end+1
-  if (pole_sud) jje=jj_end
+  IF (pole_sud) jje=jj_end
 
   do j=jjb,jje
@@ -75,6 +75,6 @@
   jjb=jj_begin-1
   jje=jj_end+1
-  if (pole_nord) jjb=jj_begin
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -87,6 +87,6 @@
   jjb=jj_begin
   jje=jj_end+1
-  if (pole_nord) jjb=jj_begin+1
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin+1
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -99,5 +99,5 @@
   !   les deux composantes du vent au pole sont obtenues comme
   !   premiers modes de fourier de v pres du pole
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     upoln=0.
     vpoln=0.
@@ -116,7 +116,7 @@
     enddo
 
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     upols=0.
     vpols=0.
@@ -134,5 +134,5 @@
     enddo
 
-  endif
+  ENDIF
 
   !   calcul du frottement au sol.
@@ -140,6 +140,6 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_nord) jjb=jj_begin+1
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin+1
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -153,5 +153,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   do j=jjb,jje
@@ -163,12 +163,12 @@
   enddo
 !$OMP END SINGLE
-  endif ! of if (friction_type.eq.0)
+  ENDIF ! of if (friction_type.EQ.0)
 
-  if (friction_type==1) THEN
+  IF (friction_type==1) THEN
    ! for ucov()
     jjb=jj_begin
     jje=jj_end
-    if (pole_nord) jjb=jj_begin+1
-    if (pole_sud) jje=jj_end-1
+    IF (pole_nord) jjb=jj_begin+1
+    IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -182,5 +182,5 @@
     jjb=jj_begin
     jje=jj_end
-    if (pole_sud) jje=jj_end-1
+    IF (pole_sud) jje=jj_end-1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -190,5 +190,5 @@
     enddo
 !$OMP END DO
-  endif ! of if (friction_type.eq.1)
+  ENDIF ! of if (friction_type.EQ.1)
 
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90	(revision 5117)
@@ -87,5 +87,5 @@
   LOGICAL lafin
 
-  real time_step, t_wrt, t_ops
+  REAL time_step, t_wrt, t_ops
 
   !+jld variables test conservation energie
@@ -101,12 +101,12 @@
 
 
-  character (len=80) :: dynhist_file, dynhistave_file
-  character (len=20) :: modname
-  character (len=80) :: abort_message
+  CHARACTER (LEN=80) :: dynhist_file, dynhistave_file
+  CHARACTER (LEN=20) :: modname
+  CHARACTER (LEN=80) :: abort_message
   ! locales pour gestion du temps
   INTEGER :: an, mois, jour
   REAL :: heure
   ! needed for xios interface
-  character (len=10) :: xios_cal_type
+  CHARACTER (LEN=10) :: xios_cal_type
   INTEGER :: anref, moisref, jourref
   REAL :: heureref
@@ -132,5 +132,5 @@
 
   CALL conf_gcm( 99, .TRUE. )
-  if (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
+  IF (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
        "iphysiq must be a multiple of iperiod", 1)
 
@@ -154,5 +154,5 @@
 
   CALL set_bands
-  if (mpi_rank==0) CALL WriteBands
+  IF (mpi_rank==0) CALL WriteBands
   CALL Set_Distrib(distrib_caldyn)
 
@@ -173,13 +173,13 @@
   !      calend = 'earth_365d'
 
-  if (calend == 'earth_360d') THEN
+  IF (calend == 'earth_360d') THEN
      CALL ioconf_calendar('360_day')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
      xios_cal_type='d360'
-  else if (calend == 'earth_365d') THEN
+  ELSE IF (calend == 'earth_365d') THEN
      CALL ioconf_calendar('noleap')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
      xios_cal_type='noleap'
-  else if (calend == 'gregorian') THEN
+  ELSE IF (calend == 'gregorian') THEN
      CALL ioconf_calendar('gregorian')
      WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
@@ -188,5 +188,5 @@
      abort_message = 'Mauvais choix de calendrier'
      CALL abort_gcm(modname,abort_message,1)
-  endif
+  ENDIF
 
 
@@ -212,16 +212,16 @@
 
   !  lecture du fichier start.nc
-  if (read_start) THEN
+  IF (read_start) THEN
      ! we still need to run iniacademic to initialize some
      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
-     if (iflag_phys/=1) THEN
+     IF (iflag_phys/=1) THEN
         CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
      endif
 
-     !        if (planet_type.eq."earth") THEN
+     !        if (planet_type.EQ."earth") THEN
      ! Load an Earth-format start file
      CALL dynetat0_loc("start.nc",vcov,ucov, &
           teta,q,masse,ps,phis, time_0)
-     !        endif ! of if (planet_type.eq."earth")
+     !        endif ! of if (planet_type.EQ."earth")
 
      !       WRITE(73,*) 'ucov',ucov
@@ -231,14 +231,14 @@
      !       WRITE(77,*) 'q',q
 
-  endif ! of if (read_start)
+  ENDIF ! of if (read_start)
 
   ! le cas echeant, creation d un etat initial
   IF (prt_level > 9) WRITE(lunout,*) &
        'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
-  if (.not.read_start) THEN
+  IF (.NOT.read_start) THEN
      start_time=0.
      annee_ref=anneeref
      CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
-  endif
+  ENDIF
 
   !-----------------------------------------------------------------------
@@ -287,5 +287,5 @@
      WRITE(lunout,*) &
           'GCM: On reinitialise a la date lue dans gcm.def'
-  ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN
+  ELSE IF (annee_ref /= anneeref .OR. day_ref /= dayref) THEN
      WRITE(lunout,*) &
           'GCM: Attention les dates initiales lues dans le fichier'
@@ -297,5 +297,5 @@
      WRITE(lunout,*)' Pas de remise a zero'
   ENDIF
-  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
+  !      if (annee_ref .NE. anneeref .OR. day_ref .NE. dayref) THEN
   !        WRITE(lunout,*)
   !     .  'GCM: Attention les dates initiales lues dans le fichier'
@@ -305,5 +305,5 @@
   !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
   !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
-  !        if (raz_date .ne. 1) THEN
+  !        if (raz_date .NE. 1) THEN
   !          WRITE(lunout,*)
   !     .    'GCM: On garde les dates du fichier restart'
@@ -337,5 +337,5 @@
   WRITE(lunout,*)jD_ref+jH_ref,anref, moisref, jourref, heureref
 
-  if (iflag_phys==1) THEN
+  IF (iflag_phys==1) THEN
      ! these initialisations have already been done (via iniacademic)
      ! if running in SW or Newtonian mode
@@ -355,5 +355,5 @@
      !   --------------------------
      CALL inifilr
-  endif ! of if (iflag_phys.eq.1)
+  ENDIF ! of if (iflag_phys.EQ.1)
 
   !-----------------------------------------------------------------------
@@ -369,9 +369,9 @@
 
 
-  if (nday>=0) THEN
+  IF (nday>=0) THEN
      day_end = day_ini + nday
   else
      day_end = day_ini - nday/day_step
-  endif
+  ENDIF
 
   WRITE(lunout,300)day_ini,day_end
@@ -395,5 +395,5 @@
   istphy=istdyn/iphysiq
 
-  IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
+  IF ((iflag_phys==1).OR.(iflag_phys>=100)) THEN
      ! Physics:
     IF (CPPKEY_PHYS) THEN
@@ -404,8 +404,8 @@
             iflag_phys)
     END IF
-  ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
-
-
-  !      if (planet_type.eq."earth") THEN
+  ENDIF ! of IF ((iflag_phys==1).OR.(iflag_phys>=100))
+
+
+  !      if (planet_type.EQ."earth") THEN
   ! Write an Earth-format restart file
   CALL dynredem0_loc("restart.nc", day_end, phis)
@@ -415,5 +415,5 @@
 
   time_step = zdtvr
-     if (ok_dyn_ins) THEN
+     IF (ok_dyn_ins) THEN
         ! initialize output file for instantaneous outputs
         ! t_ops = iecri * daysec ! do operations every t_ops
@@ -433,8 +433,8 @@
 
 ! setting up DYN3D/XIOS inerface
-  if (ok_dyn_xios) THEN
+  IF (ok_dyn_xios) THEN
       CALL xios_dyn3dmem_init(xios_cal_type, anref, moisref, jourref,heureref, an,   &
           mois, jour, heure, zdtvr)
-  endif
+  ENDIF
 
   !-----------------------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.f90	(revision 5117)
@@ -49,6 +49,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -62,5 +62,5 @@
 !$OMP ENDDO NOWAIT
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,nx
@@ -70,7 +70,7 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,nx
@@ -80,5 +80,5 @@
     ENDDO
 !$OMP ENDDO NOWAIT
-  endif
+  ENDIF
 
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_loc.f90	(revision 5117)
@@ -40,6 +40,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_p.f90	(revision 5117)
@@ -40,6 +40,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90	(revision 5117)
@@ -133,10 +133,10 @@
    DO   l = 1, klevel
 
-     if (pole_sud) ije=ij_end
+     IF (pole_sud) ije=ij_end
      DO  ij = ijb, ije
       gdx_out( ij,l ) = gdx( ij,l ) * nugrads
      ENDDO
 
-     if (pole_sud) ije=ij_end-iip1
+     IF (pole_sud) ije=ij_end-iip1
      DO  ij = ijb, ije
       gdy_out( ij,l ) = gdy( ij,l ) * nugrads
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90	(revision 5117)
@@ -35,5 +35,5 @@
   INTEGER :: i, j, l
 
-  logical :: firstcall
+  LOGICAL :: firstcall
   save firstcall
   !$OMP THREADPRIVATE(firstcall)
@@ -62,6 +62,6 @@
   jjb = jj_begin - 1
   jje = jj_end
-  if (pole_nord) jjb = jj_begin
-  if (pole_sud)  jje = jj_end - 1
+  IF (pole_nord) jjb = jj_begin
+  IF (pole_sud)  jje = jj_end - 1
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
   do l = 1, llm
@@ -81,6 +81,6 @@
   jjb = jj_begin
   jje = jj_end
-  if (pole_nord) jjb = jj_begin + 1
-  if (pole_sud)  jje = jj_end - 1
+  IF (pole_nord) jjb = jj_begin + 1
+  IF (pole_sud)  jje = jj_end - 1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -113,8 +113,8 @@
   enddo
 
-  if (.not. pole_sud) THEN
+  IF (.NOT. pole_sud) THEN
     zconvmm(:, jj_end + 1, :) = 0
     !ym	wm(:,jj_end+1,:)=0
-  endif
+  ENDIF
 
   !$OMP END MASTER
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90	(revision 5117)
@@ -1,12 +1,12 @@
 MODULE guide_loc_mod
 
-!=======================================================================
-!   Auteur:  F.Hourdin
-!            F. Codron 01/09
-!=======================================================================
+  !=======================================================================
+  !   Auteur:  F.Hourdin
+  !            F. Codron 01/09
+  !=======================================================================
 
   USE getparam, ONLY: ini_getparam, fin_getparam, getpar
   USE Write_Field_loc
-  use netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
+  USE netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
           nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_dimid, &
           nf90_inquire_dimension, nf90_enddef, nf90_def_dim, nf90_put_var, nf90_noerr, nf90_close, nf90_inq_varid, &
@@ -14,61 +14,61 @@
           nf90_create, nf90_def_var, nf90_open
   USE parallel_lmdz
-  USE pres2lev_mod, ONLY: pres2lev
+  USE lmdz_pres2lev, ONLY: pres2lev
 
   IMPLICIT NONE
 
-! ---------------------------------------------
-! Declarations des cles logiques et parametres 
-! ---------------------------------------------
-  INTEGER, PRIVATE, SAVE  :: iguide_read,iguide_int,iguide_sav
-  INTEGER, PRIVATE, SAVE  :: nlevnc, guide_plevs
-  LOGICAL, PRIVATE, SAVE  :: guide_u,guide_v,guide_T,guide_Q,guide_P
-  LOGICAL, PRIVATE, SAVE  :: guide_hr,guide_teta  
-  LOGICAL, PRIVATE, SAVE  :: guide_BL,guide_reg,guide_add,gamma4,guide_zon 
-  LOGICAL, PRIVATE, SAVE  :: invert_p,invert_y,ini_anal
-  LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav,guide_modele
-!FC
-  LOGICAL, PRIVATE, SAVE  :: convert_Pa
-  
-  REAL, PRIVATE, SAVE     :: tau_min_u,tau_max_u
-  REAL, PRIVATE, SAVE     :: tau_min_v,tau_max_v
-  REAL, PRIVATE, SAVE     :: tau_min_T,tau_max_T
-  REAL, PRIVATE, SAVE     :: tau_min_Q,tau_max_Q
-  REAL, PRIVATE, SAVE     :: tau_min_P,tau_max_P
-
-  REAL, PRIVATE, SAVE     :: lat_min_g,lat_max_g
-  REAL, PRIVATE, SAVE     :: lon_min_g,lon_max_g
-  REAL, PRIVATE, SAVE     :: tau_lon,tau_lat
-
-  REAL, PRIVATE, SAVE     :: plim_guide_BL
-
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_u,alpha_v 
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_T,alpha_Q 
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_P,alpha_pcor
-  
-! ---------------------------------------------
-! Variables de guidage
-! ---------------------------------------------
-! Variables des fichiers de guidage
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: unat1,unat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: vnat1,vnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: tnat1,tnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: qnat1,qnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: pnat1,pnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: psnat1,psnat2
-  REAL, ALLOCATABLE, DIMENSION(:),     PRIVATE, SAVE   :: apnc,bpnc
-! Variables aux dimensions du modele
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: ugui1,ugui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: vgui1,vgui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: tgui1,tgui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: qgui1,qgui2
-  REAL, ALLOCATABLE, DIMENSION(:),   PRIVATE, SAVE   :: psgui1,psgui2
-  
-  INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev !,ijnu,ijnv
-  INTEGER,SAVE,PRIVATE :: jjbu,jjbv,jjeu,jjev,jjnu,jjnv
+  ! ---------------------------------------------
+  ! Declarations des cles logiques et parametres
+  ! ---------------------------------------------
+  INTEGER, PRIVATE, SAVE :: iguide_read, iguide_int, iguide_sav
+  INTEGER, PRIVATE, SAVE :: nlevnc, guide_plevs
+  LOGICAL, PRIVATE, SAVE :: guide_u, guide_v, guide_T, guide_Q, guide_P
+  LOGICAL, PRIVATE, SAVE :: guide_hr, guide_teta
+  LOGICAL, PRIVATE, SAVE :: guide_BL, guide_reg, guide_add, gamma4, guide_zon
+  LOGICAL, PRIVATE, SAVE :: invert_p, invert_y, ini_anal
+  LOGICAL, PRIVATE, SAVE :: guide_2D, guide_sav, guide_modele
+  !FC
+  LOGICAL, PRIVATE, SAVE :: convert_Pa
+
+  REAL, PRIVATE, SAVE :: tau_min_u, tau_max_u
+  REAL, PRIVATE, SAVE :: tau_min_v, tau_max_v
+  REAL, PRIVATE, SAVE :: tau_min_T, tau_max_T
+  REAL, PRIVATE, SAVE :: tau_min_Q, tau_max_Q
+  REAL, PRIVATE, SAVE :: tau_min_P, tau_max_P
+
+  REAL, PRIVATE, SAVE :: lat_min_g, lat_max_g
+  REAL, PRIVATE, SAVE :: lon_min_g, lon_max_g
+  REAL, PRIVATE, SAVE :: tau_lon, tau_lat
+
+  REAL, PRIVATE, SAVE :: plim_guide_BL
+
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_u, alpha_v
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_T, alpha_Q
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_P, alpha_pcor
+
+  ! ---------------------------------------------
+  ! Variables de guidage
+  ! ---------------------------------------------
+  ! Variables des fichiers de guidage
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: unat1, unat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: vnat1, vnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: tnat1, tnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: qnat1, qnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :, :), PRIVATE, SAVE :: pnat1, pnat2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: psnat1, psnat2
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: apnc, bpnc
+  ! Variables aux dimensions du modele
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: ugui1, ugui2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: vgui1, vgui2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: tgui1, tgui2
+  REAL, ALLOCATABLE, DIMENSION(:, :), PRIVATE, SAVE :: qgui1, qgui2
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: psgui1, psgui2
+
+  INTEGER, SAVE, PRIVATE :: ijbu, ijbv, ijeu, ijev !,ijnu,ijnv
+  INTEGER, SAVE, PRIVATE :: jjbu, jjbv, jjeu, jjev, jjnu, jjnv
 
 
 CONTAINS
-!=======================================================================
+  !=======================================================================
 
   SUBROUTINE guide_init
@@ -78,286 +78,281 @@
 
     IMPLICIT NONE
-  
+
     INCLUDE "dimensions.h"
     INCLUDE "paramet.h"
 
-    INTEGER                :: error,ncidpl,rid,rcod
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'guide_init'
-    CHARACTER (len = 20)   :: namedim
-
-! ---------------------------------------------
-! Lecture des parametres:  
-! ---------------------------------------------
+    INTEGER :: error, ncidpl, rid, rcod
+    CHARACTER (len = 80) :: abort_message
+    CHARACTER (len = 20) :: modname = 'guide_init'
+    CHARACTER (len = 20) :: namedim
+
+    ! ---------------------------------------------
+    ! Lecture des parametres:
+    ! ---------------------------------------------
     CALL ini_getparam("nudging_parameters_out.txt")
-! Variables guidees
-    CALL getpar('guide_u',.TRUE.,guide_u,'guidage de u')
-    CALL getpar('guide_v',.TRUE.,guide_v,'guidage de v')
-    CALL getpar('guide_T',.TRUE.,guide_T,'guidage de T')
-    CALL getpar('guide_P',.TRUE.,guide_P,'guidage de P')
-    CALL getpar('guide_Q',.TRUE.,guide_Q,'guidage de Q')
-    CALL getpar('guide_hr',.TRUE.,guide_hr,'guidage de Q par H.R')
-    CALL getpar('guide_teta',.FALSE.,guide_teta,'guidage de T par Teta')
-
-    CALL getpar('guide_add',.FALSE.,guide_add,'foréage constant?')
-    CALL getpar('guide_zon',.FALSE.,guide_zon,'guidage moy zonale')
-    if (guide_zon .and. abs(grossismx - 1.) > 0.01) &
-         CALL abort_gcm("guide_init", &
-         "zonal nudging requires grid regular in longitude", 1)
-
-!   Constantes de rappel. Unite : fraction de jour
-    CALL getpar('tau_min_u',0.02,tau_min_u,'Cste de rappel min, u')
-    CALL getpar('tau_max_u', 10.,tau_max_u,'Cste de rappel max, u')
-    CALL getpar('tau_min_v',0.02,tau_min_v,'Cste de rappel min, v')
-    CALL getpar('tau_max_v', 10.,tau_max_v,'Cste de rappel max, v')
-    CALL getpar('tau_min_T',0.02,tau_min_T,'Cste de rappel min, T')
-    CALL getpar('tau_max_T', 10.,tau_max_T,'Cste de rappel max, T')
-    CALL getpar('tau_min_Q',0.02,tau_min_Q,'Cste de rappel min, Q')
-    CALL getpar('tau_max_Q', 10.,tau_max_Q,'Cste de rappel max, Q')
-    CALL getpar('tau_min_P',0.02,tau_min_P,'Cste de rappel min, P')
-    CALL getpar('tau_max_P', 10.,tau_max_P,'Cste de rappel max, P')
-    CALL getpar('gamma4',.FALSE.,gamma4,'Zone sans rappel elargie')
-    CALL getpar('guide_BL',.TRUE.,guide_BL,'guidage dans C.Lim')
-    CALL getpar('plim_guide_BL',85000.,plim_guide_BL,'BL top presnivs value')
-
-! Sauvegarde du forçage
-    CALL getpar('guide_sav',.FALSE.,guide_sav,'sauvegarde guidage')
-    CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
+    ! Variables guidees
+    CALL getpar('guide_u', .TRUE., guide_u, 'guidage de u')
+    CALL getpar('guide_v', .TRUE., guide_v, 'guidage de v')
+    CALL getpar('guide_T', .TRUE., guide_T, 'guidage de T')
+    CALL getpar('guide_P', .TRUE., guide_P, 'guidage de P')
+    CALL getpar('guide_Q', .TRUE., guide_Q, 'guidage de Q')
+    CALL getpar('guide_hr', .TRUE., guide_hr, 'guidage de Q par H.R')
+    CALL getpar('guide_teta', .FALSE., guide_teta, 'guidage de T par Teta')
+
+    CALL getpar('guide_add', .FALSE., guide_add, 'foréage constant?')
+    CALL getpar('guide_zon', .FALSE., guide_zon, 'guidage moy zonale')
+    IF (guide_zon .AND. abs(grossismx - 1.) > 0.01) &
+            CALL abort_gcm("guide_init", &
+                    "zonal nudging requires grid regular in longitude", 1)
+
+    !   Constantes de rappel. Unite : fraction de jour
+    CALL getpar('tau_min_u', 0.02, tau_min_u, 'Cste de rappel min, u')
+    CALL getpar('tau_max_u', 10., tau_max_u, 'Cste de rappel max, u')
+    CALL getpar('tau_min_v', 0.02, tau_min_v, 'Cste de rappel min, v')
+    CALL getpar('tau_max_v', 10., tau_max_v, 'Cste de rappel max, v')
+    CALL getpar('tau_min_T', 0.02, tau_min_T, 'Cste de rappel min, T')
+    CALL getpar('tau_max_T', 10., tau_max_T, 'Cste de rappel max, T')
+    CALL getpar('tau_min_Q', 0.02, tau_min_Q, 'Cste de rappel min, Q')
+    CALL getpar('tau_max_Q', 10., tau_max_Q, 'Cste de rappel max, Q')
+    CALL getpar('tau_min_P', 0.02, tau_min_P, 'Cste de rappel min, P')
+    CALL getpar('tau_max_P', 10., tau_max_P, 'Cste de rappel max, P')
+    CALL getpar('gamma4', .FALSE., gamma4, 'Zone sans rappel elargie')
+    CALL getpar('guide_BL', .TRUE., guide_BL, 'guidage dans C.Lim')
+    CALL getpar('plim_guide_BL', 85000., plim_guide_BL, 'BL top presnivs value')
+
+    ! Sauvegarde du forçage
+    CALL getpar('guide_sav', .FALSE., guide_sav, 'sauvegarde guidage')
+    CALL getpar('iguide_sav', 4, iguide_sav, 'freq. sauvegarde guidage')
     ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois.
     IF (iguide_sav>0) THEN
-       iguide_sav=day_step/iguide_sav
+      iguide_sav = day_step / iguide_sav
     ELSE if (iguide_sav == 0) THEN
-       iguide_sav = huge(0)
+      iguide_sav = huge(0)
     ELSE
-       iguide_sav=day_step*iguide_sav
-    ENDIF
-
-! Guidage regional seulement (sinon constant ou suivant le zoom)
-    CALL getpar('guide_reg',.FALSE.,guide_reg,'guidage regional')
-    CALL getpar('lat_min_g',-90.,lat_min_g,'Latitude mini guidage ')
-    CALL getpar('lat_max_g', 90.,lat_max_g,'Latitude maxi guidage ')
-    CALL getpar('lon_min_g',-180.,lon_min_g,'longitude mini guidage ')
-    CALL getpar('lon_max_g', 180.,lon_max_g,'longitude maxi guidage ')
-    CALL getpar('tau_lat', 5.,tau_lat,'raideur lat guide regional ')
-    CALL getpar('tau_lon', 5.,tau_lon,'raideur lon guide regional ')
-
-! Parametres pour lecture des fichiers
-    CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage')
-    CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert')
+      iguide_sav = day_step * iguide_sav
+    ENDIF
+
+    ! Guidage regional seulement (sinon constant ou suivant le zoom)
+    CALL getpar('guide_reg', .FALSE., guide_reg, 'guidage regional')
+    CALL getpar('lat_min_g', -90., lat_min_g, 'Latitude mini guidage ')
+    CALL getpar('lat_max_g', 90., lat_max_g, 'Latitude maxi guidage ')
+    CALL getpar('lon_min_g', -180., lon_min_g, 'longitude mini guidage ')
+    CALL getpar('lon_max_g', 180., lon_max_g, 'longitude maxi guidage ')
+    CALL getpar('tau_lat', 5., tau_lat, 'raideur lat guide regional ')
+    CALL getpar('tau_lon', 5., tau_lon, 'raideur lon guide regional ')
+
+    ! Parametres pour lecture des fichiers
+    CALL getpar('iguide_read', 4, iguide_read, 'freq. lecture guidage')
+    CALL getpar('iguide_int', 4, iguide_int, 'freq. interpolation vert')
     IF (iguide_int==0) THEN
-        iguide_int=1
+      iguide_int = 1
     ELSEIF (iguide_int>0) THEN
-        iguide_int=day_step/iguide_int
+      iguide_int = day_step / iguide_int
     ELSE
-        iguide_int=day_step*iguide_int
-    ENDIF
-    CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage')
+      iguide_int = day_step * iguide_int
+    ENDIF
+    CALL getpar('guide_plevs', 0, guide_plevs, 'niveaux pression fichiers guidage')
     ! Pour compatibilite avec ancienne version avec guide_modele
-    CALL getpar('guide_modele',.FALSE.,guide_modele,'niveaux pression ap+bp*psol')
+    CALL getpar('guide_modele', .FALSE., guide_modele, 'niveaux pression ap+bp*psol')
     IF (guide_modele) THEN
-        guide_plevs=1
-    ENDIF
-!FC
-    CALL getpar('convert_Pa',.TRUE.,convert_Pa,'Convert Pressure levels in Pa')
+      guide_plevs = 1
+    ENDIF
+    !FC
+    CALL getpar('convert_Pa', .TRUE., convert_Pa, 'Convert Pressure levels in Pa')
     ! Fin raccord
-    CALL getpar('ini_anal',.FALSE.,ini_anal,'Etat initial = analyse')
-    CALL getpar('guide_invertp',.TRUE.,invert_p,'niveaux p inverses')
-    CALL getpar('guide_inverty',.TRUE.,invert_y,'inversion N-S')
-    CALL getpar('guide_2D',.FALSE.,guide_2D,'fichier guidage lat-P')
+    CALL getpar('ini_anal', .FALSE., ini_anal, 'Etat initial = analyse')
+    CALL getpar('guide_invertp', .TRUE., invert_p, 'niveaux p inverses')
+    CALL getpar('guide_inverty', .TRUE., invert_y, 'inversion N-S')
+    CALL getpar('guide_2D', .FALSE., guide_2D, 'fichier guidage lat-P')
 
     CALL fin_getparam
-    
-! ---------------------------------------------
-! Determination du nombre de niveaux verticaux
-! des fichiers guidage
-! ---------------------------------------------
-    ncidpl=-99
-    if (guide_plevs==1) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('apbp.nc',nf90_nowrite, ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file apbp.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
+
+    ! ---------------------------------------------
+    ! Determination du nombre de niveaux verticaux
+    ! des fichiers guidage
+    ! ---------------------------------------------
+    ncidpl = -99
+    IF (guide_plevs==1) THEN
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
     elseif (guide_plevs==2) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('P.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file P.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('P.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
 
     elseif (guide_u) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('u.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file u.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-          
-       endif
-
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('u.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+
+      endif
 
     elseif (guide_v) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file v.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
-
-    
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('v.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
+
     elseif (guide_T) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file T.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
-
-
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('T.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
 
     elseif (guide_Q) THEN
-       if (ncidpl==-99) THEN
-          rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
-          if (rcod/=nf90_noerr) THEN
-             abort_message=' Nudging error -> no file hur.nc'
-             CALL abort_gcm(modname,abort_message,1)
-          endif
-       endif
-
-
-    endif 
-    error=nf90_inq_dimid(ncidpl,'LEVEL',rid)
-    IF (error/=nf90_noerr) error=nf90_inq_dimid(ncidpl,'PRESSURE',rid)
+      IF (ncidpl==-99) THEN
+        rcod = nf90_open('hur.nc', nf90_nowrite, ncidpl)
+        IF (rcod/=nf90_noerr) THEN
+          abort_message = ' Nudging error -> no file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        endif
+      endif
+
+    endif
+    error = nf90_inq_dimid(ncidpl, 'LEVEL', rid)
+    IF (error/=nf90_noerr) error = nf90_inq_dimid(ncidpl, 'PRESSURE', rid)
     IF (error/=nf90_noerr) THEN
-        abort_message='Nudging: error reading pressure levels'
-        CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    error=nf90_inquire_dimension(ncidpl,rid,len=nlevnc)
-    WRITE(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
+      abort_message = 'Nudging: error reading pressure levels'
+      CALL abort_gcm(modname, abort_message, 1)
+    ENDIF
+    error = nf90_inquire_dimension(ncidpl, rid, len = nlevnc)
+    WRITE(*, *)trim(modname) // ' : number of vertical levels nlevnc', nlevnc
     rcod = nf90_close(ncidpl)
 
-! ---------------------------------------------
-! Allocation des variables
-! ---------------------------------------------
-    abort_message='nudging allocation error'
+    ! ---------------------------------------------
+    ! Allocation des variables
+    ! ---------------------------------------------
+    abort_message = 'nudging allocation error'
 
     ALLOCATE(apnc(nlevnc), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(bpnc(nlevnc), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    apnc=0.;bpnc=0.
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+    apnc = 0.;bpnc = 0.
 
     ALLOCATE(alpha_pcor(llm), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_u(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_v(ijb_v:ije_v), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_T(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_Q(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
     ALLOCATE(alpha_P(ijb_u:ije_u), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    alpha_u=0.;alpha_v=0;alpha_T=0;alpha_Q=0;alpha_P=0
-    
+    IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+    alpha_u = 0.;alpha_v = 0;alpha_T = 0;alpha_Q = 0;alpha_P = 0
+
     IF (guide_u) THEN
-        ALLOCATE(unat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(ugui1(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(unat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(ugui2(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        unat1=0.;unat2=0.;ugui1=0.;ugui2=0.
+      ALLOCATE(unat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(ugui1(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(unat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(ugui2(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      unat1 = 0.;unat2 = 0.;ugui1 = 0.;ugui2 = 0.
     ENDIF
 
     IF (guide_T) THEN
-        ALLOCATE(tnat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tgui1(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tnat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tgui2(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        tnat1=0.;tnat2=0.;tgui1=0.;tgui2=0.
-    ENDIF
-     
+      ALLOCATE(tnat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(tgui1(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(tnat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(tgui2(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      tnat1 = 0.;tnat2 = 0.;tgui1 = 0.;tgui2 = 0.
+    ENDIF
+
     IF (guide_Q) THEN
-        ALLOCATE(qnat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qgui1(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qnat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qgui2(ijb_u:ije_u,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        qnat1=0.;qnat2=0.;qgui1=0.;qgui2=0.
+      ALLOCATE(qnat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(qgui1(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(qnat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(qgui2(ijb_u:ije_u, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      qnat1 = 0.;qnat2 = 0.;qgui1 = 0.;qgui2 = 0.
     ENDIF
 
     IF (guide_v) THEN
-        ALLOCATE(vnat1(iip1,jjb_v:jje_v,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vgui1(ijb_v:ije_v,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vnat2(iip1,jjb_v:jje_v,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vgui2(ijb_v:ije_v,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        vnat1=0.;vnat2=0.;vgui1=0.;vgui2=0.
+      ALLOCATE(vnat1(iip1, jjb_v:jje_v, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(vgui1(ijb_v:ije_v, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(vnat2(iip1, jjb_v:jje_v, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(vgui2(ijb_v:ije_v, llm), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      vnat1 = 0.;vnat2 = 0.;vgui1 = 0.;vgui2 = 0.
     ENDIF
 
     IF (guide_plevs==2) THEN
-        ALLOCATE(pnat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(pnat2(iip1,jjb_u:jje_u,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        pnat1=0.;pnat2=0.;
+      ALLOCATE(pnat1(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(pnat2(iip1, jjb_u:jje_u, nlevnc), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      pnat1 = 0.;pnat2 = 0.;
     ENDIF
 
     IF (guide_P.OR.guide_plevs==1) THEN
-        ALLOCATE(psnat1(iip1,jjb_u:jje_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(psnat2(iip1,jjb_u:jje_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        psnat1=0.;psnat2=0.;
+      ALLOCATE(psnat1(iip1, jjb_u:jje_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(psnat2(iip1, jjb_u:jje_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      psnat1 = 0.;psnat2 = 0.;
     ENDIF
     IF (guide_P) THEN
-        ALLOCATE(psgui2(ijb_u:ije_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(psgui1(ijb_u:ije_u), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        psgui1=0.;psgui2=0.
-    ENDIF
-
-! ---------------------------------------------
-!   Lecture du premier etat de guidage.
-! ---------------------------------------------
+      ALLOCATE(psgui2(ijb_u:ije_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      ALLOCATE(psgui1(ijb_u:ije_u), stat = error)
+      IF (error /= 0) CALL abort_gcm(modname, abort_message, 1)
+      psgui1 = 0.;psgui2 = 0.
+    ENDIF
+
+    ! ---------------------------------------------
+    !   Lecture du premier etat de guidage.
+    ! ---------------------------------------------
     IF (guide_2D) THEN
-        CALL guide_read2D(1)
+      CALL guide_read2D(1)
     ELSE
-        CALL guide_read(1)
-    ENDIF
-    IF (guide_v) vnat1=vnat2
-    IF (guide_u) unat1=unat2
-    IF (guide_T) tnat1=tnat2
-    IF (guide_Q) qnat1=qnat2
-    IF (guide_plevs==2) pnat1=pnat2
-    IF (guide_P.OR.guide_plevs==1) psnat1=psnat2
+      CALL guide_read(1)
+    ENDIF
+    IF (guide_v) vnat1 = vnat2
+    IF (guide_u) unat1 = unat2
+    IF (guide_T) tnat1 = tnat2
+    IF (guide_Q) qnat1 = qnat2
+    IF (guide_plevs==2) pnat1 = pnat2
+    IF (guide_P.OR.guide_plevs==1) psnat1 = psnat2
 
   END SUBROUTINE guide_init
 
-!=======================================================================
-  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
-    use exner_hyb_loc_m, ONLY: exner_hyb_loc
-    use exner_milieu_loc_m, ONLY: exner_milieu_loc
+  !=======================================================================
+  SUBROUTINE guide_main(itau, ucov, vcov, teta, q, masse, ps)
+    USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+    USE exner_milieu_loc_m, ONLY: exner_milieu_loc
     USE parallel_lmdz
     USE control_mod
@@ -365,357 +360,357 @@
     USE comconst_mod, ONLY: cpp, daysec, dtvr, kappa
     USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner
-    
+
     IMPLICIT NONE
-  
+
     INCLUDE "dimensions.h"
     INCLUDE "paramet.h"
 
     ! Variables entree
-    INTEGER,                           INTENT(IN)    :: itau !pas de temps
-    REAL, DIMENSION (ijb_u:ije_u,llm), INTENT(INOUT) :: ucov,teta,q,masse
-    REAL, DIMENSION (ijb_v:ije_v,llm), INTENT(INOUT) :: vcov
-    REAL, DIMENSION (ijb_u:ije_u),     INTENT(INOUT) :: ps
+    INTEGER, INTENT(IN) :: itau !pas de temps
+    REAL, DIMENSION (ijb_u:ije_u, llm), INTENT(INOUT) :: ucov, teta, q, masse
+    REAL, DIMENSION (ijb_v:ije_v, llm), INTENT(INOUT) :: vcov
+    REAL, DIMENSION (ijb_u:ije_u), INTENT(INOUT) :: ps
 
     ! Variables locales
-    LOGICAL, SAVE :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
-    LOGICAL       :: f_out ! sortie guidage
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addu ! var aux: champ de guidage
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:) :: f_addv ! var aux: champ de guidage
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
+    LOGICAL :: f_out ! sortie guidage
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: f_addu ! var aux: champ de guidage
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: f_addv ! var aux: champ de guidage
     ! Variables pour fonction Exner (P milieu couche)
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)    :: pk
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks    
-    REAL                               :: unskap
-    REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)    :: p ! besoin si guide_P
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pk
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: pks
+    REAL :: unskap
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: p ! besoin si guide_P
     ! Compteurs temps:
-    INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
-!$OMP THREADPRIVATE(step_rea,count_no_rea,itau_test)
-    REAL          :: ditau, dday_step
-    REAL          :: tau,reste ! position entre 2 etats de guidage
-    REAL, SAVE    :: factt ! pas de temps en fraction de jour
-!$OMP THREADPRIVATE(factt)
-    
-    INTEGER       :: i,j,l
-    CHARACTER(LEN=20) :: modname="guide_main"
-       
-!$OMP MASTER    
-    ijbu=ij_begin ; ijeu=ij_end
-    jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1 
-    ijbv=ij_begin ; ijev=ij_end
-    jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1 
+    INTEGER, SAVE :: step_rea, count_no_rea, itau_test ! lecture guidage
+    !$OMP THREADPRIVATE(step_rea,count_no_rea,itau_test)
+    REAL :: ditau, dday_step
+    REAL :: tau, reste ! position entre 2 etats de guidage
+    REAL, SAVE :: factt ! pas de temps en fraction de jour
+    !$OMP THREADPRIVATE(factt)
+
+    INTEGER :: i, j, l
+    CHARACTER(LEN = 20) :: modname = "guide_main"
+
+    !$OMP MASTER
+    ijbu = ij_begin ; ijeu = ij_end
+    jjbu = jj_begin ; jjeu = jj_end ; jjnu = jjeu - jjbu + 1
+    ijbv = ij_begin ; ijev = ij_end
+    jjbv = jj_begin ; jjev = jj_end ; jjnv = jjev - jjbv + 1
     IF (pole_sud) THEN
-      ijeu=ij_end-iip1
-      ijev=ij_end-iip1
-      jjev=jj_end-1
-      jjnv=jjev-jjbv+1 
+      ijeu = ij_end - iip1
+      ijev = ij_end - iip1
+      jjev = jj_end - 1
+      jjnv = jjev - jjbv + 1
     ENDIF
     IF (pole_nord) THEN
-      ijbu=ij_begin+iip1
-      ijbv=ij_begin
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-      
-!    PRINT *,'---> on rentre dans guide_main'
-!    CALL AllGather_Field(ucov,ip1jmp1,llm)
-!    CALL AllGather_Field(vcov,ip1jm,llm)
-!    CALL AllGather_Field(teta,ip1jmp1,llm)
-!    CALL AllGather_Field(ps,ip1jmp1,1)
-!    CALL AllGather_Field(q,ip1jmp1,llm)
-    
-!-----------------------------------------------------------------------
-! Initialisations au premier passage
-!-----------------------------------------------------------------------
+      ijbu = ij_begin + iip1
+      ijbv = ij_begin
+    ENDIF
+    !$OMP END MASTER
+    !$OMP BARRIER
+
+    !    PRINT *,'---> on rentre dans guide_main'
+    !    CALL AllGather_Field(ucov,ip1jmp1,llm)
+    !    CALL AllGather_Field(vcov,ip1jm,llm)
+    !    CALL AllGather_Field(teta,ip1jmp1,llm)
+    !    CALL AllGather_Field(ps,ip1jmp1,1)
+    !    CALL AllGather_Field(q,ip1jmp1,llm)
+
+    !-----------------------------------------------------------------------
+    ! Initialisations au premier passage
+    !-----------------------------------------------------------------------
 
     IF (first) THEN
-        first=.FALSE.
-!$OMP MASTER
-        ALLOCATE(f_addu(ijb_u:ije_u,llm) ) 
-        ALLOCATE(f_addv(ijb_v:ije_v,llm) ) 
-        ALLOCATE(pk(iip1,jjb_u:jje_u,llm)  ) 
-        ALLOCATE(pks(iip1,jjb_u:jje_u)  ) 
-        ALLOCATE(p(ijb_u:ije_u,llmp1) ) 
-        CALL guide_init 
-!$OMP END MASTER
-!$OMP BARRIER
-        itau_test=1001
-        step_rea=1
-        count_no_rea=0
-! Calcul des constantes de rappel
-        factt=dtvr*iperiod/daysec 
-!$OMP MASTER
-        CALL tau2alpha(3, iip1, jjb_v, jje_v, factt, tau_min_v, tau_max_v, alpha_v)
-        CALL tau2alpha(2, iip1, jjb_u, jje_u, factt, tau_min_u, tau_max_u, alpha_u)
-        CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_T, tau_max_T, alpha_T)
-        CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_P, tau_max_P, alpha_P)
-        CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_Q, tau_max_Q, alpha_Q)
-! correction de rappel dans couche limite
-        if (guide_BL) THEN
-             alpha_pcor(:)=1.
-        else
-            do l=1,llm
-                alpha_pcor(l)=(1.+tanh(((plim_guide_BL-presnivs(l))/preff)/0.05))/2.
-            enddo
-        endif
-!$OMP END MASTER
-!$OMP BARRIER
-! ini_anal: etat initial egal au guidage        
-        IF (ini_anal) THEN
-            CALL guide_interp(ps,teta)
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
-            DO l=1,llm
-              IF (guide_u) ucov(ijbu:ijeu,l)=ugui2(ijbu:ijeu,l)
-              IF (guide_v) vcov(ijbv:ijev,l)=ugui2(ijbv:ijev,l)
-              IF (guide_T) teta(ijbu:ijeu,l)=tgui2(ijbu:ijeu,l)
-              IF (guide_Q) q(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)
-            ENDDO
-            
-            IF (guide_P) THEN
-!$OMP MASTER
-                ps(ijbu:ijeu)=psgui2(ijbu:ijeu)
-!$OMP END MASTER
-!$OMP BARRIER
-                CALL pression_loc(ijnb_u,ap,bp,ps,p)
-                CALL massdair_loc(p,masse)
-!$OMP BARRIER
-            ENDIF
-            RETURN
-        ENDIF
+      first = .FALSE.
+      !$OMP MASTER
+      ALLOCATE(f_addu(ijb_u:ije_u, llm))
+      ALLOCATE(f_addv(ijb_v:ije_v, llm))
+      ALLOCATE(pk(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pks(iip1, jjb_u:jje_u))
+      ALLOCATE(p(ijb_u:ije_u, llmp1))
+      CALL guide_init
+      !$OMP END MASTER
+      !$OMP BARRIER
+      itau_test = 1001
+      step_rea = 1
+      count_no_rea = 0
+      ! Calcul des constantes de rappel
+      factt = dtvr * iperiod / daysec
+      !$OMP MASTER
+      CALL tau2alpha(3, iip1, jjb_v, jje_v, factt, tau_min_v, tau_max_v, alpha_v)
+      CALL tau2alpha(2, iip1, jjb_u, jje_u, factt, tau_min_u, tau_max_u, alpha_u)
+      CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_T, tau_max_T, alpha_T)
+      CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_P, tau_max_P, alpha_P)
+      CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_Q, tau_max_Q, alpha_Q)
+      ! correction de rappel dans couche limite
+      IF (guide_BL) THEN
+        alpha_pcor(:) = 1.
+      else
+        do l = 1, llm
+          alpha_pcor(l) = (1. + tanh(((plim_guide_BL - presnivs(l)) / preff) / 0.05)) / 2.
+        enddo
+      endif
+      !$OMP END MASTER
+      !$OMP BARRIER
+      ! ini_anal: etat initial egal au guidage
+      IF (ini_anal) THEN
+        CALL guide_interp(ps, teta)
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          IF (guide_u) ucov(ijbu:ijeu, l) = ugui2(ijbu:ijeu, l)
+          IF (guide_v) vcov(ijbv:ijev, l) = ugui2(ijbv:ijev, l)
+          IF (guide_T) teta(ijbu:ijeu, l) = tgui2(ijbu:ijeu, l)
+          IF (guide_Q) q(ijbu:ijeu, l) = qgui2(ijbu:ijeu, l)
+        ENDDO
+
+        IF (guide_P) THEN
+          !$OMP MASTER
+          ps(ijbu:ijeu) = psgui2(ijbu:ijeu)
+          !$OMP END MASTER
+          !$OMP BARRIER
+          CALL pression_loc(ijnb_u, ap, bp, ps, p)
+          CALL massdair_loc(p, masse)
+          !$OMP BARRIER
+        ENDIF
+        RETURN
+      ENDIF
 
     ENDIF !first
 
-!-----------------------------------------------------------------------
-! Lecture des fichiers de guidage ?
-!-----------------------------------------------------------------------
+    !-----------------------------------------------------------------------
+    ! Lecture des fichiers de guidage ?
+    !-----------------------------------------------------------------------
     IF (iguide_read/=0) THEN
-      ditau=real(itau)
-      dday_step=real(day_step)
+      ditau = real(itau)
+      dday_step = real(day_step)
       IF (iguide_read<0) THEN
-          tau=ditau/dday_step/REAL(iguide_read)
+        tau = ditau / dday_step / REAL(iguide_read)
       ELSE
-          tau=REAL(iguide_read)*ditau/dday_step
-      ENDIF
-      reste=tau-AINT(tau)
+        tau = REAL(iguide_read) * ditau / dday_step
+      ENDIF
+      reste = tau - AINT(tau)
       IF (reste==0.) THEN
-          IF (itau_test==itau) THEN
-            WRITE(*,*)trim(modname)//' second pass in advreel at itau=',&
-            itau
-            CALL abort_gcm("guide_loc_lod","stopped",1)
+        IF (itau_test==itau) THEN
+          WRITE(*, *)trim(modname) // ' second pass in advreel at itau=', &
+                  itau
+          CALL abort_gcm("guide_loc_lod", "stopped", 1)
+        ELSE
+          !$OMP MASTER
+          IF (guide_v) vnat1(:, jjbv:jjev, :) = vnat2(:, jjbv:jjev, :)
+          IF (guide_u) unat1(:, jjbu:jjeu, :) = unat2(:, jjbu:jjeu, :)
+          IF (guide_T) tnat1(:, jjbu:jjeu, :) = tnat2(:, jjbu:jjeu, :)
+          IF (guide_Q) qnat1(:, jjbu:jjeu, :) = qnat2(:, jjbu:jjeu, :)
+          IF (guide_plevs==2) pnat1(:, jjbu:jjeu, :) = pnat2(:, jjbu:jjeu, :)
+          IF (guide_P.OR.guide_plevs==1) psnat1(:, jjbu:jjeu) = psnat2(:, jjbu:jjeu)
+          !$OMP END MASTER
+          !$OMP BARRIER
+          step_rea = step_rea + 1
+          itau_test = itau
+          IF (is_master) THEN
+            WRITE(*, *)trim(modname) // ' Reading nudging files, step ', &
+                    step_rea, 'after ', count_no_rea, ' skips'
+          endif
+          IF (guide_2D) THEN
+            !$OMP MASTER
+            CALL guide_read2D(step_rea)
+            !$OMP END MASTER
+            !$OMP BARRIER
           ELSE
-!$OMP MASTER
-              IF (guide_v) vnat1(:,jjbv:jjev,:)=vnat2(:,jjbv:jjev,:)
-              IF (guide_u) unat1(:,jjbu:jjeu,:)=unat2(:,jjbu:jjeu,:)
-              IF (guide_T) tnat1(:,jjbu:jjeu,:)=tnat2(:,jjbu:jjeu,:)
-              IF (guide_Q) qnat1(:,jjbu:jjeu,:)=qnat2(:,jjbu:jjeu,:)
-              IF (guide_plevs==2) pnat1(:,jjbu:jjeu,:)=pnat2(:,jjbu:jjeu,:)
-              IF (guide_P.OR.guide_plevs==1) psnat1(:,jjbu:jjeu)=psnat2(:,jjbu:jjeu)
-!$OMP END MASTER
-!$OMP BARRIER
-              step_rea=step_rea+1
-              itau_test=itau
-              if (is_master) THEN
-                WRITE(*,*)trim(modname)//' Reading nudging files, step ',&
-                    step_rea,'after ',count_no_rea,' skips'
-              endif
-              IF (guide_2D) THEN
-!$OMP MASTER
-                  CALL guide_read2D(step_rea)
-!$OMP END MASTER
-!$OMP BARRIER
-              ELSE
-!$OMP MASTER
-                  CALL guide_read(step_rea)
-!$OMP END MASTER
-!$OMP BARRIER
-              ENDIF
-              count_no_rea=0
+            !$OMP MASTER
+            CALL guide_read(step_rea)
+            !$OMP END MASTER
+            !$OMP BARRIER
           ENDIF
+          count_no_rea = 0
+        ENDIF
       ELSE
-        count_no_rea=count_no_rea+1
+        count_no_rea = count_no_rea + 1
 
       ENDIF
     ENDIF !iguide_read=0
 
-!-----------------------------------------------------------------------
-! Interpolation et conversion des champs de guidage
-!-----------------------------------------------------------------------
-    IF (MOD(itau,iguide_int)==0) THEN
-        CALL guide_interp(ps,teta)
-    ENDIF
-! Repartition entre 2 etats de guidage
+    !-----------------------------------------------------------------------
+    ! Interpolation et conversion des champs de guidage
+    !-----------------------------------------------------------------------
+    IF (MOD(itau, iguide_int)==0) THEN
+      CALL guide_interp(ps, teta)
+    ENDIF
+    ! Repartition entre 2 etats de guidage
     IF (iguide_read/=0) THEN
-        tau=reste
+      tau = reste
     ELSE
-        tau=1.
-    ENDIF
-
-!    CALL WriteField_u('ucov_guide',ucov)
-!    CALL WriteField_v('vcov_guide',vcov)
-!    CALL WriteField_u('teta_guide',teta)
-!    CALL WriteField_u('masse_guide',masse)
-    
-    
-!-----------------------------------------------------------------------
-!   Ajout des champs de guidage 
-!-----------------------------------------------------------------------
-! Sauvegarde du guidage?
-    f_out=((MOD(itau,iguide_sav)==0).AND.guide_sav)
+      tau = 1.
+    ENDIF
+
+    !    CALL WriteField_u('ucov_guide',ucov)
+    !    CALL WriteField_v('vcov_guide',vcov)
+    !    CALL WriteField_u('teta_guide',teta)
+    !    CALL WriteField_u('masse_guide',masse)
+
+
+    !-----------------------------------------------------------------------
+    !   Ajout des champs de guidage
+    !-----------------------------------------------------------------------
+    ! Sauvegarde du guidage?
+    f_out = ((MOD(itau, iguide_sav)==0).AND.guide_sav)
     IF (f_out) THEN
 
-!$OMP BARRIER
-      CALL pression_loc(ijnb_u,ap,bp,ps,p)
-
-!$OMP BARRIER
-      if (pressure_exner) THEN
-      CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk)
+      !$OMP BARRIER
+      CALL pression_loc(ijnb_u, ap, bp, ps, p)
+
+      !$OMP BARRIER
+      IF (pressure_exner) THEN
+        CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk)
       else
-        CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk )
-      endif
-
-!$OMP BARRIER
-
-        unskap=1./kappa
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk)
+      endif
+
+      !$OMP BARRIER
+
+      unskap = 1. / kappa
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            p(i + (j - 1) * iip1, l) = preff * (pk(i, j, l) / cpp) ** unskap
+          ENDDO
+        ENDDO
+      ENDDO
+
+      CALL guide_out("SP", jjp1, llm, p(ijb_u:ije_u, 1:llm), 1.)
+    ENDIF
+
+    IF (guide_u) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
         DO l = 1, llm
-            DO j=jjbu,jjeu
-                DO i =1, iip1
-                    p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
-                ENDDO
-            ENDDO
-        ENDDO
-
-        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
-    ENDIF
-    
-    if (guide_u) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)
-          ENDDO
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-           f_addu(ijbu:ijeu,l)=(1.-tau)*ugui1(ijbu:ijeu,l)+tau*ugui2(ijbu:ijeu,l)-ucov(ijbu:ijeu,l)
-          ENDDO
-        endif 
-    
-!        CALL WriteField_u('f_addu',f_addu)
-
-        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
-        CALL guide_addfield_u(llm,f_addu,alpha_u)
-        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
-        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
-        IF (f_out) THEN
-         ! Ehouarn: fill the gaps adequately...
-         IF (ijbu>ijb_u) f_addu(ijb_u:ijbu-1,:)=0
-         IF (ijeu<ije_u) f_addu(ijeu+1:ije_u,:)=0
-         CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:)/factt,factt)
-        ENDIF
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          ucov(ijbu:ijeu,l)=ucov(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
-        ENDDO
+          f_addu(ijbu:ijeu, l) = (1. - tau) * ugui1(ijbu:ijeu, l) + tau * ugui2(ijbu:ijeu, l)
+        ENDDO
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * ugui1(ijbu:ijeu, l) + tau * ugui2(ijbu:ijeu, l) - ucov(ijbu:ijeu, l)
+        ENDDO
+      endif
+
+      !        CALL WriteField_u('f_addu',f_addu)
+
+      IF (guide_zon) CALL guide_zonave_u(1, llm, f_addu)
+      CALL guide_addfield_u(llm, f_addu, alpha_u)
+      IF (f_out) CALL guide_out("ua", jjp1, llm, (1. - tau) * ugui1(ijb_u:ije_u, :) + tau * ugui2(ijb_u:ije_u, :), factt)
+      IF (f_out) CALL guide_out("u", jjp1, llm, ucov(ijb_u:ije_u, :), factt)
+      IF (f_out) THEN
+        ! Ehouarn: fill the gaps adequately...
+        IF (ijbu>ijb_u) f_addu(ijb_u:ijbu - 1, :) = 0
+        IF (ijeu<ije_u) f_addu(ijeu + 1:ije_u, :) = 0
+        CALL guide_out("ucov", jjp1, llm, f_addu(ijb_u:ije_u, :) / factt, factt)
+      ENDIF
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        ucov(ijbu:ijeu, l) = ucov(ijbu:ijeu, l) + f_addu(ijbu:ijeu, l)
+      ENDDO
 
     endif
 
-    if (guide_T) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)
-          ENDDO
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-           f_addu(ijbu:ijeu,l)=(1.-tau)*tgui1(ijbu:ijeu,l)+tau*tgui2(ijbu:ijeu,l)-teta(ijbu:ijeu,l)
-          ENDDO
-        endif 
-        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
-        CALL guide_addfield_u(llm,f_addu,alpha_T)
-        IF (f_out) CALL guide_out("teta",jjp1,llm,f_addu(:,:)/factt,factt)
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          teta(ijbu:ijeu,l)=teta(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
-        ENDDO
+    IF (guide_T) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * tgui1(ijbu:ijeu, l) + tau * tgui2(ijbu:ijeu, l)
+        ENDDO
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * tgui1(ijbu:ijeu, l) + tau * tgui2(ijbu:ijeu, l) - teta(ijbu:ijeu, l)
+        ENDDO
+      endif
+      IF (guide_zon) CALL guide_zonave_u(2, llm, f_addu)
+      CALL guide_addfield_u(llm, f_addu, alpha_T)
+      IF (f_out) CALL guide_out("teta", jjp1, llm, f_addu(:, :) / factt, factt)
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        teta(ijbu:ijeu, l) = teta(ijbu:ijeu, l) + f_addu(ijbu:ijeu, l)
+      ENDDO
     endif
 
-    if (guide_P) THEN
-        if (guide_add) THEN
-!$OMP MASTER
-            f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)
-!$OMP END MASTER
-!$OMP BARRIER
-        else
-!$OMP MASTER
-            f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu)-ps(ijbu:ijeu)
-!$OMP END MASTER
-!$OMP BARRIER
-        endif 
-        if (guide_zon) CALL guide_zonave_u(2,1,f_addu(ijb_u:ije_u,1))
-        CALL guide_addfield_u(1,f_addu(ijb_u:ije_u,1),alpha_P)
-!       IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(ijb_u:ije_u,1)/factt,factt)
-!$OMP MASTER
-        ps(ijbu:ijeu)=ps(ijbu:ijeu)+f_addu(ijbu:ijeu,1)
-!$OMP END MASTER
-!$OMP BARRIER
-        CALL pression_loc(ijnb_u,ap,bp,ps,p)
-        CALL massdair_loc(p,masse)
-!$OMP BARRIER
+    IF (guide_P) THEN
+      IF (guide_add) THEN
+        !$OMP MASTER
+        f_addu(ijbu:ijeu, 1) = (1. - tau) * psgui1(ijbu:ijeu) + tau * psgui2(ijbu:ijeu)
+        !$OMP END MASTER
+        !$OMP BARRIER
+      else
+        !$OMP MASTER
+        f_addu(ijbu:ijeu, 1) = (1. - tau) * psgui1(ijbu:ijeu) + tau * psgui2(ijbu:ijeu) - ps(ijbu:ijeu)
+        !$OMP END MASTER
+        !$OMP BARRIER
+      endif
+      IF (guide_zon) CALL guide_zonave_u(2, 1, f_addu(ijb_u:ije_u, 1))
+      CALL guide_addfield_u(1, f_addu(ijb_u:ije_u, 1), alpha_P)
+      !       IF (f_out) CALL guide_out("ps",jjp1,1,f_addu(ijb_u:ije_u,1)/factt,factt)
+      !$OMP MASTER
+      ps(ijbu:ijeu) = ps(ijbu:ijeu) + f_addu(ijbu:ijeu, 1)
+      !$OMP END MASTER
+      !$OMP BARRIER
+      CALL pression_loc(ijnb_u, ap, bp, ps, p)
+      CALL massdair_loc(p, masse)
+      !$OMP BARRIER
     endif
 
-    if (guide_Q) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)
-          ENDDO
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addu(ijbu:ijeu,l)=(1.-tau)*qgui1(ijbu:ijeu,l)+tau*qgui2(ijbu:ijeu,l)-q(ijbu:ijeu,l)
-          ENDDO
-        endif 
-        if (guide_zon) CALL guide_zonave_u(2,llm,f_addu)
-        CALL guide_addfield_u(llm,f_addu,alpha_Q)
-        IF (f_out) CALL guide_out("q",jjp1,llm,f_addu(:,:)/factt,factt)
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          q(ijbu:ijeu,l)=q(ijbu:ijeu,l)+f_addu(ijbu:ijeu,l)
-        ENDDO
+    IF (guide_Q) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * qgui1(ijbu:ijeu, l) + tau * qgui2(ijbu:ijeu, l)
+        ENDDO
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addu(ijbu:ijeu, l) = (1. - tau) * qgui1(ijbu:ijeu, l) + tau * qgui2(ijbu:ijeu, l) - q(ijbu:ijeu, l)
+        ENDDO
+      endif
+      IF (guide_zon) CALL guide_zonave_u(2, llm, f_addu)
+      CALL guide_addfield_u(llm, f_addu, alpha_Q)
+      IF (f_out) CALL guide_out("q", jjp1, llm, f_addu(:, :) / factt, factt)
+
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        q(ijbu:ijeu, l) = q(ijbu:ijeu, l) + f_addu(ijbu:ijeu, l)
+      ENDDO
     endif
 
-    if (guide_v) THEN
-        if (guide_add) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-             f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)
-          ENDDO
-
-        else
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO l=1,llm
-            f_addv(ijbv:ijev,l)=(1.-tau)*vgui1(ijbv:ijev,l)+tau*vgui2(ijbv:ijev,l)-vcov(ijbv:ijev,l)
-          ENDDO
-
-        endif 
-    
-        if (guide_zon) CALL guide_zonave_v(2,jjm,llm,f_addv(ijb_v:ije_v,:))
-        
-        CALL guide_addfield_v(llm,f_addv(ijb_v:ije_v,:),alpha_v)
-        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
-        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
-        IF (f_out) THEN
-          ! Ehouarn: Fill in the gaps adequately
-          IF (ijbv>ijb_v) f_addv(ijb_v:ijbv-1,:)=0 
-          IF (ijev<ije_v) f_addv(ijev+1:ije_v,:)=0
-          CALL guide_out("vcov",jjm,llm,f_addv(ijb_v:ije_v,:)/factt,factt)
-        ENDIF
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-          vcov(ijbv:ijev,l)=vcov(ijbv:ijev,l)+f_addv(ijbv:ijev,l)
-        ENDDO
+    IF (guide_v) THEN
+      IF (guide_add) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addv(ijbv:ijev, l) = (1. - tau) * vgui1(ijbv:ijev, l) + tau * vgui2(ijbv:ijev, l)
+        ENDDO
+
+      else
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        DO l = 1, llm
+          f_addv(ijbv:ijev, l) = (1. - tau) * vgui1(ijbv:ijev, l) + tau * vgui2(ijbv:ijev, l) - vcov(ijbv:ijev, l)
+        ENDDO
+
+      endif
+
+      IF (guide_zon) CALL guide_zonave_v(2, jjm, llm, f_addv(ijb_v:ije_v, :))
+
+      CALL guide_addfield_v(llm, f_addv(ijb_v:ije_v, :), alpha_v)
+      IF (f_out) CALL guide_out("v", jjm, llm, vcov(ijb_v:ije_v, :), factt)
+      IF (f_out) CALL guide_out("va", jjm, llm, (1. - tau) * vgui1(ijb_v:ije_v, :) + tau * vgui2(ijb_v:ije_v, :), factt)
+      IF (f_out) THEN
+        ! Ehouarn: Fill in the gaps adequately
+        IF (ijbv>ijb_v) f_addv(ijb_v:ijbv - 1, :) = 0
+        IF (ijev<ije_v) f_addv(ijev + 1:ije_v, :) = 0
+        CALL guide_out("vcov", jjm, llm, f_addv(ijb_v:ije_v, :) / factt, factt)
+      ENDIF
+
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        vcov(ijbv:ijev, l) = vcov(ijbv:ijev, l) + f_addv(ijbv:ijev, l)
+      ENDDO
     endif
 
@@ -723,6 +718,6 @@
 
 
-  SUBROUTINE guide_addfield_u(vsize,field,alpha)
-! field1=a*field1+alpha*field2
+  SUBROUTINE guide_addfield_u(vsize, field, alpha)
+    ! field1=a*field1+alpha*field2
 
     IMPLICIT NONE
@@ -731,14 +726,14 @@
 
     ! input variables
-    INTEGER,                      INTENT(IN)    :: vsize
-    REAL, DIMENSION(ijb_u:ije_u),       INTENT(IN)    :: alpha 
-    REAL, DIMENSION(ijb_u:ije_u,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: vsize
+    REAL, DIMENSION(ijb_u:ije_u), INTENT(IN) :: alpha
+    REAL, DIMENSION(ijb_u:ije_u, vsize), INTENT(INOUT) :: field
 
     ! Local variables
     INTEGER :: l
 
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    DO l=1,vsize
-      field(ijbu:ijeu,l)=alpha(ijbu:ijeu)*field(ijbu:ijeu,l)*alpha_pcor(l)
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
+      field(ijbu:ijeu, l) = alpha(ijbu:ijeu) * field(ijbu:ijeu, l) * alpha_pcor(l)
     ENDDO
 
@@ -746,6 +741,6 @@
 
 
-  SUBROUTINE guide_addfield_v(vsize,field,alpha)
-! field1=a*field1+alpha*field2
+  SUBROUTINE guide_addfield_v(vsize, field, alpha)
+    ! field1=a*field1+alpha*field2
 
     IMPLICIT NONE
@@ -754,24 +749,24 @@
 
     ! input variables
-    INTEGER,                      INTENT(IN)    :: vsize
-    REAL, DIMENSION(ijb_v:ije_v),       INTENT(IN)    :: alpha 
-    REAL, DIMENSION(ijb_v:ije_v,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: vsize
+    REAL, DIMENSION(ijb_v:ije_v), INTENT(IN) :: alpha
+    REAL, DIMENSION(ijb_v:ije_v, vsize), INTENT(INOUT) :: field
 
     ! Local variables
     INTEGER :: l
 
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    DO l=1,vsize
-      field(ijbv:ijev,l)=alpha(ijbv:ijev)*field(ijbv:ijev,l)*alpha_pcor(l)
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
+      field(ijbv:ijev, l) = alpha(ijbv:ijev) * field(ijbv:ijev, l) * alpha_pcor(l)
     ENDDO
 
   END SUBROUTINE guide_addfield_v
-  
-!=======================================================================
-
-  SUBROUTINE guide_zonave_u(typ,vsize,field)
+
+  !=======================================================================
+
+  SUBROUTINE guide_zonave_u(typ, vsize, field)
 
     USE comconst_mod, ONLY: pi
-    
+
     IMPLICIT NONE
 
@@ -779,71 +774,71 @@
     INCLUDE "paramet.h"
     INCLUDE "comgeom.h"
-    
+
     ! input/output variables
-    INTEGER,                           INTENT(IN)    :: typ
-    INTEGER,                           INTENT(IN)    :: vsize
-    REAL, DIMENSION(ijb_u:ije_u,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: typ
+    INTEGER, INTENT(IN) :: vsize
+    REAL, DIMENSION(ijb_u:ije_u, vsize), INTENT(INOUT) :: field
 
     ! Local variables
-    LOGICAL, SAVE                :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
 
     INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
-!$OMP THREADPRIVATE(imin,imax)    
-    INTEGER                      :: i,j,l,ij
-    REAL, DIMENSION (iip1)       :: lond       ! longitude in Deg.
-    REAL, DIMENSION (jjb_u:jje_u,vsize):: fieldm     ! zon-averaged field
+    !$OMP THREADPRIVATE(imin,imax)
+    INTEGER :: i, j, l, ij
+    REAL, DIMENSION (iip1) :: lond       ! longitude in Deg.
+    REAL, DIMENSION (jjb_u:jje_u, vsize) :: fieldm     ! zon-averaged field
 
     IF (first) THEN
-        first=.FALSE.
-!Compute domain for averaging
-        lond=rlonu*180./pi
-        imin(1)=1;imax(1)=iip1;
-        imin(2)=1;imax(2)=iip1;
-        IF (guide_reg) THEN
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(1)=i
-                IF (lond(i)<=lon_max_g) imax(1)=i
-            ENDDO
-            lond=rlonv*180./pi
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(2)=i
-                IF (lond(i)<=lon_max_g) imax(2)=i
-            ENDDO
-        ENDIF
-    ENDIF
-
-    
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,vsize
-        fieldm(:,l)=0.
+      first = .FALSE.
+      !Compute domain for averaging
+      lond = rlonu * 180. / pi
+      imin(1) = 1;imax(1) = iip1;
+      imin(2) = 1;imax(2) = iip1;
+      IF (guide_reg) THEN
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(1) = i
+          IF (lond(i)<=lon_max_g) imax(1) = i
+        ENDDO
+        lond = rlonv * 180. / pi
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(2) = i
+          IF (lond(i)<=lon_max_g) imax(2) = i
+        ENDDO
+      ENDIF
+    ENDIF
+
+
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
+      fieldm(:, l) = 0.
       ! Compute zonal average
 
-!correction bug ici
-! ---> a verifier
-! ym         DO j=jjbv,jjev
-         DO j=jjbu,jjeu
-              DO i=imin(typ),imax(typ)
-                  ij=(j-1)*iip1+i
-                  fieldm(j,l)=fieldm(j,l)+field(ij,l)
-              ENDDO
-          ENDDO 
-          fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
-    ! Compute forcing
-          DO j=jjbu,jjeu
-              DO i=1,iip1
-                  ij=(j-1)*iip1+i
-                  field(ij,l)=fieldm(j,l)
-              ENDDO
-          ENDDO
+      !correction bug ici
+      ! ---> a verifier
+      ! ym         DO j=jjbv,jjev
+      DO j = jjbu, jjeu
+        DO i = imin(typ), imax(typ)
+          ij = (j - 1) * iip1 + i
+          fieldm(j, l) = fieldm(j, l) + field(ij, l)
+        ENDDO
       ENDDO
+      fieldm(:, l) = fieldm(:, l) / REAL(imax(typ) - imin(typ) + 1)
+      ! Compute forcing
+      DO j = jjbu, jjeu
+        DO i = 1, iip1
+          ij = (j - 1) * iip1 + i
+          field(ij, l) = fieldm(j, l)
+        ENDDO
+      ENDDO
+    ENDDO
 
   END SUBROUTINE guide_zonave_u
 
 
-  SUBROUTINE guide_zonave_v(typ,hsize,vsize,field)
+  SUBROUTINE guide_zonave_v(typ, hsize, vsize, field)
 
     USE comconst_mod, ONLY: pi
-    
+
     IMPLICIT NONE
 
@@ -851,559 +846,71 @@
     INCLUDE "paramet.h"
     INCLUDE "comgeom.h"
-    
+
     ! input/output variables
-    INTEGER,                           INTENT(IN)    :: typ
-    INTEGER,                           INTENT(IN)    :: vsize
-    INTEGER,                           INTENT(IN)    :: hsize
-    REAL, DIMENSION(ijb_v:ije_v,vsize), INTENT(INOUT) :: field
+    INTEGER, INTENT(IN) :: typ
+    INTEGER, INTENT(IN) :: vsize
+    INTEGER, INTENT(IN) :: hsize
+    REAL, DIMENSION(ijb_v:ije_v, vsize), INTENT(INOUT) :: field
 
     ! Local variables
-    LOGICAL, SAVE                :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
     INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
-!$OMP THREADPRIVATE(imin, imax)
-    INTEGER                      :: i,j,l,ij
-    REAL, DIMENSION (iip1)       :: lond       ! longitude in Deg.
-    REAL, DIMENSION (jjb_v:jjev,vsize):: fieldm     ! zon-averaged field
+    !$OMP THREADPRIVATE(imin, imax)
+    INTEGER :: i, j, l, ij
+    REAL, DIMENSION (iip1) :: lond       ! longitude in Deg.
+    REAL, DIMENSION (jjb_v:jjev, vsize) :: fieldm     ! zon-averaged field
 
     IF (first) THEN
-        first=.FALSE.
-!Compute domain for averaging
-        lond=rlonu*180./pi
-        imin(1)=1;imax(1)=iip1;
-        imin(2)=1;imax(2)=iip1;
-        IF (guide_reg) THEN
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(1)=i
-                IF (lond(i)<=lon_max_g) imax(1)=i
-            ENDDO
-            lond=rlonv*180./pi
-            DO i=1,iim
-                IF (lond(i)<lon_min_g) imin(2)=i
-                IF (lond(i)<=lon_max_g) imax(2)=i
-            ENDDO
-        ENDIF
-    ENDIF
-
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,vsize
+      first = .FALSE.
+      !Compute domain for averaging
+      lond = rlonu * 180. / pi
+      imin(1) = 1;imax(1) = iip1;
+      imin(2) = 1;imax(2) = iip1;
+      IF (guide_reg) THEN
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(1) = i
+          IF (lond(i)<=lon_max_g) imax(1) = i
+        ENDDO
+        lond = rlonv * 180. / pi
+        DO i = 1, iim
+          IF (lond(i)<lon_min_g) imin(2) = i
+          IF (lond(i)<=lon_max_g) imax(2) = i
+        ENDDO
+      ENDIF
+    ENDIF
+
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    DO l = 1, vsize
       ! Compute zonal average
-          fieldm(:,l)=0.
-          DO j=jjbv,jjev
-              DO i=imin(typ),imax(typ)
-                  ij=(j-1)*iip1+i
-                  fieldm(j,l)=fieldm(j,l)+field(ij,l)
-              ENDDO
-          ENDDO 
-          fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
-    ! Compute forcing
-          DO j=jjbv,jjev
-              DO i=1,iip1
-                  ij=(j-1)*iip1+i
-                  field(ij,l)=fieldm(j,l)
-              ENDDO
-          ENDDO
+      fieldm(:, l) = 0.
+      DO j = jjbv, jjev
+        DO i = imin(typ), imax(typ)
+          ij = (j - 1) * iip1 + i
+          fieldm(j, l) = fieldm(j, l) + field(ij, l)
+        ENDDO
       ENDDO
-
+      fieldm(:, l) = fieldm(:, l) / REAL(imax(typ) - imin(typ) + 1)
+      ! Compute forcing
+      DO j = jjbv, jjev
+        DO i = 1, iip1
+          ij = (j - 1) * iip1 + i
+          field(ij, l) = fieldm(j, l)
+        ENDDO
+      ENDDO
+    ENDDO
 
   END SUBROUTINE guide_zonave_v
-  
-!=======================================================================
-  SUBROUTINE guide_interp(psi,teta)
-    use exner_hyb_loc_m, ONLY: exner_hyb_loc
-    use exner_milieu_loc_m, ONLY: exner_milieu_loc
-  USE parallel_lmdz
-  USE mod_hallo
-  USE Bands
-  USE comconst_mod, ONLY: cpp, kappa
-  USE comvert_mod, ONLY: preff, pressure_exner, bp, ap, disvert_type
-  IMPLICIT NONE
-
-  include "dimensions.h"
-  include "paramet.h"
-  include "comgeom2.h"
-
-  REAL, DIMENSION (iip1,jjb_u:jje_u),     INTENT(IN) :: psi ! Psol gcm
-  REAL, DIMENSION (iip1,jjb_u:jje_u,llm), INTENT(IN) :: teta ! Temp. Pot. gcm
-
-  LOGICAL, SAVE                      :: first=.TRUE.
-!$OMP THREADPRIVATE(first)
-  ! Variables pour niveaux pression:
-  REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: plnc1,plnc2 !niveaux pression guidage
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: plunc,plsnc !niveaux pression modele
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: plvnc       !niveaux pression modele
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)  :: p           ! pression intercouches 
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pls, pext   ! var intermediaire
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pbarx 
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: pbary 
-  ! Variables pour fonction Exner (P milieu couche)
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: pk
-  REAL ,ALLOCATABLE, SAVE, DIMENSION (:,:)        :: pks    
-  REAL                               :: unskap
-  ! Pression de vapeur saturante
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:)      :: qsat
-  !Variables intermediaires interpolation
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)    :: zu1,zu2 
-  REAL, ALLOCATABLE, SAVE,DIMENSION (:,:,:)     :: zv1,zv2
-  
-  INTEGER                            :: i,j,l,ij
-  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
-  TYPE(Request),SAVE :: Req  
-!$OMP THREADPRIVATE(Req)
-    
-    if (is_master) WRITE(*,*)trim(modname)//': interpolate nudging variables'
-! -----------------------------------------------------------------
-! Calcul des niveaux de pression champs guidage (pour T et Q)
-! -----------------------------------------------------------------
-    IF (first) THEN
-!$OMP MASTER
-      ALLOCATE(plnc1(iip1,jjb_u:jje_u,nlevnc) )    
-      ALLOCATE(plnc2(iip1,jjb_u:jje_u,nlevnc) )    
-      ALLOCATE(plunc(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(plsnc(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(plvnc(iip1,jjb_v:jje_v,llm) )    
-      ALLOCATE(p(iip1,jjb_u:jje_u,llmp1) )    
-      ALLOCATE(pls(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pext(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pbarx(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pbary(iip1,jjb_v:jje_v,llm) )    
-      ALLOCATE(pk(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(pks (iip1,jjb_u:jje_u) )    
-      ALLOCATE(qsat(ijb_u:ije_u,llm) )    
-      ALLOCATE(zu1(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(zu2(iip1,jjb_u:jje_u,llm) )    
-      ALLOCATE(zv1(iip1,jjb_v:jje_v,llm) )    
-      ALLOCATE(zv2(iip1,jjb_v:jje_v,llm) )
-!$OMP END MASTER
-!$OMP BARRIER
-    ENDIF        
-
-    
-    
-    
-    IF (guide_plevs==0) THEN
-!$OMP DO
-        DO l=1,nlevnc
-            DO j=jjbu,jjeu
-                DO i=1,iip1
-                    plnc2(i,j,l)=apnc(l)
-                    plnc1(i,j,l)=apnc(l)
-               ENDDO
-            ENDDO
-        ENDDO
-    ENDIF   
-
-    if (first) THEN
-        first=.FALSE.
-!$OMP MASTER
-        WRITE(*,*)trim(modname)//' : check vertical level order'
-        WRITE(*,*)trim(modname)//' LMDZ :'
-        do l=1,llm
-          WRITE(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
-                  +psi(1,jjeu)*(bp(l)+bp(l+1))/2.
-        enddo
-        WRITE(*,*)trim(modname)//' nudging file :'
-        SELECT CASE (guide_plevs)
-        CASE (0) 
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)
-            enddo
-        CASE (1)
-            DO l=1,nlevnc
-              WRITE(*,*)trim(modname)//' PL(',l,')=',&
-                        apnc(l)+bpnc(l)*psnat2(1,jjbu)
-            ENDDO
-        CASE (2)
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l)
-            enddo
-        END SELECT
-        WRITE(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
-        if (guide_u) THEN
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l)
-            enddo
-        endif
-        if (guide_T) THEN
-            do l=1,nlevnc
-              WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)
-            enddo
-        endif
-!$OMP END MASTER
-    endif ! of if (first)
-
-    if (guide_plevs /= 1 .or. guide_t .and. .not. guide_teta &
-         .or. guide_q .and. guide_hr) THEN
-       CALL pression_loc( ijnb_u, ap, bp, psi, p )
-       if (disvert_type==1) THEN
-          CALL exner_hyb_loc(ijnb_u,psi,p,pks,pk)
-       else ! we assume that we are in the disvert_type==2 case
-          CALL exner_milieu_loc(ijnb_u,psi,p,pks,pk)
-       endif
-    end if
-
-! -----------------------------------------------------------------
-! Calcul niveaux pression modele 
-! -----------------------------------------------------------------
-
-!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
-    IF (guide_plevs==1) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-            DO j=jjbu,jjeu
-                DO i =1, iip1
-                    pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
-                ENDDO
-            ENDDO
-        ENDDO
-    ELSE
-        unskap=1./kappa
-!$OMP BARRIER
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-   DO l = 1, llm
-       DO j=jjbu,jjeu
-           DO i =1, iip1
-               pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
-           ENDDO
-       ENDDO
-   ENDDO
-    ENDIF
-
-!   calcul des pressions pour les grilles u et v
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    do l=1,llm
-        do j=jjbu,jjeu
-            do i=1,iip1
-                pext(i,j,l)=pls(i,j,l)*aire(i,j)
-            enddo
-        enddo
-    enddo
-
-     CALL Register_Hallo_u(pext,llm,1,2,2,1,Req)
-     CALL SendRequest(Req)
-!$OMP BARRIER
-     CALL WaitRequest(Req)
-!$OMP BARRIER
-
-    CALL massbar_loc(pext, pbarx, pbary )
-!$OMP BARRIER
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    do l=1,llm
-        do j=jjbu,jjeu
-            do i=1,iip1
-                plunc(i,j,l)=pbarx(i,j,l)/aireu(i,j)
-                plsnc(i,j,l)=pls(i,j,l)
-            enddo
-        enddo
-    enddo
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-    do l=1,llm
-        do j=jjbv,jjev
-            do i=1,iip1
-                plvnc(i,j,l)=pbary(i,j,l)/airev(i,j)
-            enddo
-        enddo
-    enddo
-
-! -----------------------------------------------------------------
-! Interpolation verticale champs guidage sur niveaux modele
-! Conversion en variables gcm (ucov, vcov...)
-! -----------------------------------------------------------------
-    if (guide_P) THEN
-!$OMP MASTER
-        do j=jjbu,jjeu
-            do i=1,iim
-                ij=(j-1)*iip1+i
-                psgui1(ij)=psnat1(i,j)
-                psgui2(ij)=psnat2(i,j)
-            enddo
-            psgui1(iip1*j)=psnat1(1,j)
-            psgui2(iip1*j)=psnat2(1,j)
-        enddo
-!$OMP END MASTER
-!$OMP BARRIER
-    endif
-
-    IF (guide_T) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=pnat2(i,j,l)
-                        plnc1(i,j,l)=pnat1(i,j,l)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ENDIF
-
-        ! Interpolation verticale
-!$OMP MASTER
-        CALL pres2lev(tnat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,           &
-                    plnc1(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-        CALL pres2lev(tnat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,           &
-                    plnc2(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-        ! Conversion en variables GCM
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbu,jjeu
-                IF (guide_teta) THEN
-                    do i=1,iim
-                        ij=(j-1)*iip1+i
-                        tgui1(ij,l)=zu1(i,j,l)
-                        tgui2(ij,l)=zu2(i,j,l)
-                    enddo
-                ELSE
-                    do i=1,iim
-                        ij=(j-1)*iip1+i
-                        tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
-                        tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
-                    enddo
-                ENDIF
-                tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l)    
-                tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l)    
-            enddo
-            if (pole_nord) THEN
-              do i=1,iip1
-                tgui1(i,l)=tgui1(1,l)
-                tgui2(i,l)=tgui2(1,l)
-              enddo
-            endif
-            if (pole_sud) THEN
-              do i=1,iip1
-                tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l) 
-                tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l) 
-              enddo
-           endif
-        enddo
-    ENDIF
-
-    IF (guide_Q) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iip1
-                        plnc2(i,j,l)=pnat2(i,j,l)
-                        plnc1(i,j,l)=pnat1(i,j,l)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ENDIF
-
-        ! Interpolation verticale
-!$OMP MASTER
-        CALL pres2lev(qnat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,             &
-                      plnc1(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-        CALL pres2lev(qnat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,             &
-                      plnc2(:,jjbu:jjeu,:),plsnc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-
-        ! Conversion en variables GCM
-        ! On suppose qu'on a la bonne variable dans le fichier de guidage:
-        ! Hum.Rel si guide_hr, Hum.Spec. sinon.
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbu,jjeu
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    qgui1(ij,l)=zu1(i,j,l)
-                    qgui2(ij,l)=zu2(i,j,l)
-                enddo
-                qgui1(j*iip1,l)=qgui1((j-1)*iip1+1,l)    
-                qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l)    
-            enddo
-            if (pole_nord) THEN
-              do i=1,iip1
-                qgui1(i,l)=qgui1(1,l)
-                qgui2(i,l)=qgui2(1,l)
-              enddo
-            endif
-            if (pole_sud) THEN
-              do i=1,iip1
-                qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l) 
-                qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l) 
-              enddo
-            endif
-        enddo
-        IF (guide_hr) THEN
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          do l=1,llm
-            CALL q_sat(iip1*jjnu,teta(:,jjbu:jjeu,l)*pk(:,jjbu:jjeu,l)/cpp,       &
-                       plsnc(:,jjbu:jjeu,l),qsat(ijbu:ijeu,l))
-            qgui1(ijbu:ijeu,l)=qgui1(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 !hum. rel. en %
-            qgui2(ijbu:ijeu,l)=qgui2(ijbu:ijeu,l)*qsat(ijbu:ijeu,l)*0.01 
-          enddo
-
-        ENDIF
-    ENDIF
-
-    IF (guide_u) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iim
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*(psnat2(i,j)*aire(i,j)*alpha1p2(i,j) &
-             +psnat2(i+1,j)*aire(i+1,j)*alpha3p4(i+1,j))/aireu(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*(psnat1(i,j)*aire(i,j)*alpha1p2(i,j) &
-             +psnat1(i+1,j)*aire(i+1,j)*alpha3p4(i+1,j))/aireu(i,j)
-                    ENDDO
-                    plnc2(iip1,j,l)=plnc2(1,j,l)
-                    plnc1(iip1,j,l)=plnc1(1,j,l)
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbu,jjeu
-                    DO i=1,iim
-                        plnc2(i,j,l)=(pnat2(i,j,l)*aire(i,j)*alpha1p2(i,j) &
-   +pnat2(i+1,j,l)*aire(i,j)*alpha3p4(i+1,j))/aireu(i,j)
-                        plnc1(i,j,l)=(pnat1(i,j,l)*aire(i,j)*alpha1p2(i,j) &
-   +pnat1(i+1,j,l)*aire(i,j)*alpha3p4(i+1,j))/aireu(i,j)
-                    ENDDO
-                    plnc2(iip1,j,l)=plnc2(1,j,l)
-                    plnc1(iip1,j,l)=plnc1(1,j,l)
-                ENDDO
-            ENDDO
-        ENDIF
-        
-        ! Interpolation verticale
-!$OMP MASTER
-        CALL pres2lev(unat1(:,jjbu:jjeu,:),zu1(:,jjbu:jjeu,:),nlevnc,llm,            &
-                      plnc1(:,jjbu:jjeu,:),plunc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-        CALL pres2lev(unat2(:,jjbu:jjeu,:),zu2(:,jjbu:jjeu,:),nlevnc,llm,            &
-                      plnc2(:,jjbu:jjeu,:),plunc(:,jjbu:jjeu,:),iip1,jjnu,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-
-        ! Conversion en variables GCM
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbu,jjeu
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    ugui1(ij,l)=zu1(i,j,l)*cu(i,j)
-                    ugui2(ij,l)=zu2(i,j,l)*cu(i,j)
-                enddo
-                ugui1(j*iip1,l)=ugui1((j-1)*iip1+1,l)    
-                ugui2(j*iip1,l)=ugui2((j-1)*iip1+1,l)    
-            enddo
-            if (pole_nord) THEN
-              do i=1,iip1
-                ugui1(i,l)=0.
-                ugui2(i,l)=0.
-              enddo
-            endif
-            if (pole_sud) THEN
-              do i=1,iip1
-                ugui1(ip1jm+i,l)=0.
-                ugui2(ip1jm+i,l)=0.
-              enddo
-            endif
-        enddo
-    ENDIF
-    
-    IF (guide_v) THEN
-        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
-        IF (guide_plevs==1) THEN
-         CALL Register_Hallo_u(psnat1,1,1,2,2,1,Req)
-         CALL Register_Hallo_u(psnat2,1,1,2,2,1,Req)
-         CALL SendRequest(Req)
-!$OMP BARRIER
-         CALL WaitRequest(Req)
-!$OMP BARRIER
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbv,jjev
-                    DO i=1,iip1
-                        plnc2(i,j,l)=apnc(l)+bpnc(l)*(psnat2(i,j)*aire(i,j)*alpha2p3(i,j) &
-             +psnat2(i,j+1)*aire(i,j+1)*alpha1p4(i,j+1))/airev(i,j)
-                        plnc1(i,j,l)=apnc(l)+bpnc(l)*(psnat1(i,j)*aire(i,j)*alpha2p3(i,j) &
-             +psnat1(i,j+1)*aire(i,j+1)*alpha1p4(i,j+1))/airev(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ELSE IF (guide_plevs==2) THEN
-         CALL Register_Hallo_u(pnat1,llm,1,2,2,1,Req)
-         CALL Register_Hallo_u(pnat2,llm,1,2,2,1,Req)
-         CALL SendRequest(Req)
-!$OMP BARRIER
-         CALL WaitRequest(Req)
-!$OMP BARRIER
-!$OMP DO
-            DO l=1,nlevnc
-                DO j=jjbv,jjev
-                    DO i=1,iip1
-                        plnc2(i,j,l)=(pnat2(i,j,l)*aire(i,j)*alpha2p3(i,j) &
-   +pnat2(i,j+1,l)*aire(i,j)*alpha1p4(i,j+1))/airev(i,j)
-                        plnc1(i,j,l)=(pnat1(i,j,l)*aire(i,j)*alpha2p3(i,j) &
-   +pnat1(i,j+1,l)*aire(i,j)*alpha1p4(i,j+1))/airev(i,j)
-                    ENDDO
-                ENDDO
-            ENDDO
-        ENDIF
-        ! Interpolation verticale
-
-!$OMP MASTER
-        CALL pres2lev(vnat1(:,jjbv:jjev,:),zv1(:,jjbv:jjev,:),nlevnc,llm,             &
-                      plnc1(:,jjbv:jjev,:),plvnc(:,jjbv:jjev,:),iip1,jjnv,invert_p)
-        CALL pres2lev(vnat2(:,jjbv:jjev,:),zv2(:,jjbv:jjev,:),nlevnc,llm,             &
-                      plnc2(:,jjbv:jjev,:),plvnc(:,jjbv:jjev,:),iip1,jjnv,invert_p)
-!$OMP END MASTER
-!$OMP BARRIER
-        ! Conversion en variables GCM
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        do l=1,llm
-            do j=jjbv,jjev
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    vgui1(ij,l)=zv1(i,j,l)*cv(i,j)
-                    vgui2(ij,l)=zv2(i,j,l)*cv(i,j)
-                enddo
-                vgui1(j*iip1,l)=vgui1((j-1)*iip1+1,l)    
-                vgui2(j*iip1,l)=vgui2((j-1)*iip1+1,l)    
-            enddo
-        enddo
-    ENDIF
-    
-
-  END SUBROUTINE guide_interp
-
-!=======================================================================
-  SUBROUTINE tau2alpha(typ,pim,jjb,jje,factt,taumin,taumax,alpha)
-
-! Calcul des constantes de rappel alpha (=1/tau)
-
-    use comconst_mod, ONLY: pi
-    use serre_mod, ONLY: clat, clon, grossismx, grossismy
-    
+
+  !=======================================================================
+  SUBROUTINE guide_interp(psi, teta)
+    USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+    USE exner_milieu_loc_m, ONLY: exner_milieu_loc
+    USE parallel_lmdz
+    USE mod_hallo
+    USE Bands
+    USE comconst_mod, ONLY: cpp, kappa
+    USE comvert_mod, ONLY: preff, pressure_exner, bp, ap, disvert_type
+    USE lmdz_q_sat, ONLY: q_sat
     IMPLICIT NONE
 
@@ -1412,163 +919,646 @@
     include "comgeom2.h"
 
-! input arguments :
+    REAL, DIMENSION (iip1, jjb_u:jje_u), INTENT(IN) :: psi ! Psol gcm
+    REAL, DIMENSION (iip1, jjb_u:jje_u, llm), INTENT(IN) :: teta ! Temp. Pot. gcm
+
+    LOGICAL, SAVE :: first = .TRUE.
+    !$OMP THREADPRIVATE(first)
+    ! Variables pour niveaux pression:
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: plnc1, plnc2 !niveaux pression guidage
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: plunc, plsnc !niveaux pression modele
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: plvnc       !niveaux pression modele
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: p           ! pression intercouches
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pls, pext   ! var intermediaire
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pbarx
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pbary
+    ! Variables pour fonction Exner (P milieu couche)
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: pk
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: pks
+    REAL :: unskap
+    ! Pression de vapeur saturante
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: qsat
+    !Variables intermediaires interpolation
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: zu1, zu2
+    REAL, ALLOCATABLE, SAVE, DIMENSION (:, :, :) :: zv1, zv2
+
+    INTEGER :: i, j, l, ij
+    CHARACTER(LEN = 20), PARAMETER :: modname = "guide_interp"
+    TYPE(Request), SAVE :: Req
+    !$OMP THREADPRIVATE(Req)
+
+    IF (is_master) WRITE(*, *)trim(modname) // ': interpolate nudging variables'
+    ! -----------------------------------------------------------------
+    ! Calcul des niveaux de pression champs guidage (pour T et Q)
+    ! -----------------------------------------------------------------
+    IF (first) THEN
+      !$OMP MASTER
+      ALLOCATE(plnc1(iip1, jjb_u:jje_u, nlevnc))
+      ALLOCATE(plnc2(iip1, jjb_u:jje_u, nlevnc))
+      ALLOCATE(plunc(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(plsnc(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(plvnc(iip1, jjb_v:jje_v, llm))
+      ALLOCATE(p(iip1, jjb_u:jje_u, llmp1))
+      ALLOCATE(pls(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pext(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pbarx(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pbary(iip1, jjb_v:jje_v, llm))
+      ALLOCATE(pk(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(pks (iip1, jjb_u:jje_u))
+      ALLOCATE(qsat(ijb_u:ije_u, llm))
+      ALLOCATE(zu1(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(zu2(iip1, jjb_u:jje_u, llm))
+      ALLOCATE(zv1(iip1, jjb_v:jje_v, llm))
+      ALLOCATE(zv2(iip1, jjb_v:jje_v, llm))
+      !$OMP END MASTER
+      !$OMP BARRIER
+    ENDIF
+
+    IF (guide_plevs==0) THEN
+      !$OMP DO
+      DO l = 1, nlevnc
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            plnc2(i, j, l) = apnc(l)
+            plnc1(i, j, l) = apnc(l)
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+
+    IF (first) THEN
+      first = .FALSE.
+      !$OMP MASTER
+      WRITE(*, *)trim(modname) // ' : check vertical level order'
+      WRITE(*, *)trim(modname) // ' LMDZ :'
+      do l = 1, llm
+        WRITE(*, *)trim(modname) // ' PL(', l, ')=', (ap(l) + ap(l + 1)) / 2. &
+                + psi(1, jjeu) * (bp(l) + bp(l + 1)) / 2.
+      enddo
+      WRITE(*, *)trim(modname) // ' nudging file :'
+      SELECT CASE (guide_plevs)
+      CASE (0)
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' PL(', l, ')=', plnc2(1, jjbu, l)
+        enddo
+      CASE (1)
+        DO l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' PL(', l, ')=', &
+                  apnc(l) + bpnc(l) * psnat2(1, jjbu)
+        ENDDO
+      CASE (2)
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' PL(', l, ')=', pnat2(1, jjbu, l)
+        enddo
+      END SELECT
+      WRITE(*, *)trim(modname) // ' invert ordering: invert_p=', invert_p
+      IF (guide_u) THEN
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' U(', l, ')=', unat2(1, jjbu, l)
+        enddo
+      endif
+      IF (guide_T) THEN
+        do l = 1, nlevnc
+          WRITE(*, *)trim(modname) // ' T(', l, ')=', tnat2(1, jjbu, l)
+        enddo
+      endif
+      !$OMP END MASTER
+    endif ! of if (first)
+
+    IF (guide_plevs /= 1 .OR. guide_t .AND. .NOT. guide_teta &
+            .OR. guide_q .AND. guide_hr) THEN
+      CALL pression_loc(ijnb_u, ap, bp, psi, p)
+      IF (disvert_type==1) THEN
+        CALL exner_hyb_loc(ijnb_u, psi, p, pks, pk)
+      else ! we assume that we are in the disvert_type==2 case
+        CALL exner_milieu_loc(ijnb_u, psi, p, pks, pk)
+      endif
+    end if
+
+    ! -----------------------------------------------------------------
+    ! Calcul niveaux pression modele
+    ! -----------------------------------------------------------------
+
+    !    ....  Calcul de pls , pression au milieu des couches ,en Pascals
+    IF (guide_plevs==1) THEN
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            pls(i, j, l) = (ap(l) + ap(l + 1)) / 2. + psi(i, j) * (bp(l) + bp(l + 1)) / 2.
+          ENDDO
+        ENDDO
+      ENDDO
+    ELSE
+      unskap = 1. / kappa
+      !$OMP BARRIER
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        DO j = jjbu, jjeu
+          DO i = 1, iip1
+            pls(i, j, l) = preff * (pk(i, j, l) / cpp) ** unskap
+          ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+
+    !   calcul des pressions pour les grilles u et v
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    do l = 1, llm
+      do j = jjbu, jjeu
+        do i = 1, iip1
+          pext(i, j, l) = pls(i, j, l) * aire(i, j)
+        enddo
+      enddo
+    enddo
+
+    CALL Register_Hallo_u(pext, llm, 1, 2, 2, 1, Req)
+    CALL SendRequest(Req)
+    !$OMP BARRIER
+    CALL WaitRequest(Req)
+    !$OMP BARRIER
+
+    CALL massbar_loc(pext, pbarx, pbary)
+    !$OMP BARRIER
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    do l = 1, llm
+      do j = jjbu, jjeu
+        do i = 1, iip1
+          plunc(i, j, l) = pbarx(i, j, l) / aireu(i, j)
+          plsnc(i, j, l) = pls(i, j, l)
+        enddo
+      enddo
+    enddo
+    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+    do l = 1, llm
+      do j = jjbv, jjev
+        do i = 1, iip1
+          plvnc(i, j, l) = pbary(i, j, l) / airev(i, j)
+        enddo
+      enddo
+    enddo
+
+    ! -----------------------------------------------------------------
+    ! Interpolation verticale champs guidage sur niveaux modele
+    ! Conversion en variables gcm (ucov, vcov...)
+    ! -----------------------------------------------------------------
+    IF (guide_P) THEN
+      !$OMP MASTER
+      do j = jjbu, jjeu
+        do i = 1, iim
+          ij = (j - 1) * iip1 + i
+          psgui1(ij) = psnat1(i, j)
+          psgui2(ij) = psnat2(i, j)
+        enddo
+        psgui1(iip1 * j) = psnat1(1, j)
+        psgui2(iip1 * j) = psnat2(1, j)
+      enddo
+      !$OMP END MASTER
+      !$OMP BARRIER
+    endif
+
+    IF (guide_T) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * psnat2(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * psnat1(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = pnat2(i, j, l)
+              plnc1(i, j, l) = pnat1(i, j, l)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+      ! Interpolation verticale
+      !$OMP MASTER
+      CALL pres2lev(tnat1(:, jjbu:jjeu, :), zu1(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc1(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      CALL pres2lev(tnat2(:, jjbu:jjeu, :), zu2(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc2(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+      ! Conversion en variables GCM
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbu, jjeu
+          IF (guide_teta) THEN
+            do i = 1, iim
+              ij = (j - 1) * iip1 + i
+              tgui1(ij, l) = zu1(i, j, l)
+              tgui2(ij, l) = zu2(i, j, l)
+            enddo
+          ELSE
+            do i = 1, iim
+              ij = (j - 1) * iip1 + i
+              tgui1(ij, l) = zu1(i, j, l) * cpp / pk(i, j, l)
+              tgui2(ij, l) = zu2(i, j, l) * cpp / pk(i, j, l)
+            enddo
+          ENDIF
+          tgui1(j * iip1, l) = tgui1((j - 1) * iip1 + 1, l)
+          tgui2(j * iip1, l) = tgui2((j - 1) * iip1 + 1, l)
+        enddo
+        IF (pole_nord) THEN
+          do i = 1, iip1
+            tgui1(i, l) = tgui1(1, l)
+            tgui2(i, l) = tgui2(1, l)
+          enddo
+        endif
+        IF (pole_sud) THEN
+          do i = 1, iip1
+            tgui1(ip1jm + i, l) = tgui1(ip1jm + 1, l)
+            tgui2(ip1jm + i, l) = tgui2(ip1jm + 1, l)
+          enddo
+        endif
+      enddo
+    ENDIF
+
+    IF (guide_Q) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * psnat2(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * psnat1(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iip1
+              plnc2(i, j, l) = pnat2(i, j, l)
+              plnc1(i, j, l) = pnat1(i, j, l)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+
+      ! Interpolation verticale
+      !$OMP MASTER
+      CALL pres2lev(qnat1(:, jjbu:jjeu, :), zu1(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc1(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      CALL pres2lev(qnat2(:, jjbu:jjeu, :), zu2(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc2(:, jjbu:jjeu, :), plsnc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+
+      ! Conversion en variables GCM
+      ! On suppose qu'on a la bonne variable dans le fichier de guidage:
+      ! Hum.Rel si guide_hr, Hum.Spec. sinon.
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbu, jjeu
+          do i = 1, iim
+            ij = (j - 1) * iip1 + i
+            qgui1(ij, l) = zu1(i, j, l)
+            qgui2(ij, l) = zu2(i, j, l)
+          enddo
+          qgui1(j * iip1, l) = qgui1((j - 1) * iip1 + 1, l)
+          qgui2(j * iip1, l) = qgui2((j - 1) * iip1 + 1, l)
+        enddo
+        IF (pole_nord) THEN
+          do i = 1, iip1
+            qgui1(i, l) = qgui1(1, l)
+            qgui2(i, l) = qgui2(1, l)
+          enddo
+        endif
+        IF (pole_sud) THEN
+          do i = 1, iip1
+            qgui1(ip1jm + i, l) = qgui1(ip1jm + 1, l)
+            qgui2(ip1jm + i, l) = qgui2(ip1jm + 1, l)
+          enddo
+        endif
+      enddo
+      IF (guide_hr) THEN
+        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        do l = 1, llm
+          CALL q_sat(iip1 * jjnu, teta(:, jjbu:jjeu, l) * pk(:, jjbu:jjeu, l) / cpp, &
+                  plsnc(:, jjbu:jjeu, l), qsat(ijbu:ijeu, l))
+          qgui1(ijbu:ijeu, l) = qgui1(ijbu:ijeu, l) * qsat(ijbu:ijeu, l) * 0.01 !hum. rel. en %
+          qgui2(ijbu:ijeu, l) = qgui2(ijbu:ijeu, l) * qsat(ijbu:ijeu, l) * 0.01
+        enddo
+
+      ENDIF
+    ENDIF
+
+    IF (guide_u) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iim
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * (psnat2(i, j) * aire(i, j) * alpha1p2(i, j) &
+                      + psnat2(i + 1, j) * aire(i + 1, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * (psnat1(i, j) * aire(i, j) * alpha1p2(i, j) &
+                      + psnat1(i + 1, j) * aire(i + 1, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+            ENDDO
+            plnc2(iip1, j, l) = plnc2(1, j, l)
+            plnc1(iip1, j, l) = plnc1(1, j, l)
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbu, jjeu
+            DO i = 1, iim
+              plnc2(i, j, l) = (pnat2(i, j, l) * aire(i, j) * alpha1p2(i, j) &
+                      + pnat2(i + 1, j, l) * aire(i, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+              plnc1(i, j, l) = (pnat1(i, j, l) * aire(i, j) * alpha1p2(i, j) &
+                      + pnat1(i + 1, j, l) * aire(i, j) * alpha3p4(i + 1, j)) / aireu(i, j)
+            ENDDO
+            plnc2(iip1, j, l) = plnc2(1, j, l)
+            plnc1(iip1, j, l) = plnc1(1, j, l)
+          ENDDO
+        ENDDO
+      ENDIF
+
+      ! Interpolation verticale
+      !$OMP MASTER
+      CALL pres2lev(unat1(:, jjbu:jjeu, :), zu1(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc1(:, jjbu:jjeu, :), plunc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      CALL pres2lev(unat2(:, jjbu:jjeu, :), zu2(:, jjbu:jjeu, :), nlevnc, llm, &
+              plnc2(:, jjbu:jjeu, :), plunc(:, jjbu:jjeu, :), iip1, jjnu, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+
+      ! Conversion en variables GCM
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbu, jjeu
+          do i = 1, iim
+            ij = (j - 1) * iip1 + i
+            ugui1(ij, l) = zu1(i, j, l) * cu(i, j)
+            ugui2(ij, l) = zu2(i, j, l) * cu(i, j)
+          enddo
+          ugui1(j * iip1, l) = ugui1((j - 1) * iip1 + 1, l)
+          ugui2(j * iip1, l) = ugui2((j - 1) * iip1 + 1, l)
+        enddo
+        IF (pole_nord) THEN
+          do i = 1, iip1
+            ugui1(i, l) = 0.
+            ugui2(i, l) = 0.
+          enddo
+        endif
+        IF (pole_sud) THEN
+          do i = 1, iip1
+            ugui1(ip1jm + i, l) = 0.
+            ugui2(ip1jm + i, l) = 0.
+          enddo
+        endif
+      enddo
+    ENDIF
+
+    IF (guide_v) THEN
+      ! Calcul des nouvelles valeurs des niveaux de pression du guidage
+      IF (guide_plevs==1) THEN
+        CALL Register_Hallo_u(psnat1, 1, 1, 2, 2, 1, Req)
+        CALL Register_Hallo_u(psnat2, 1, 1, 2, 2, 1, Req)
+        CALL SendRequest(Req)
+        !$OMP BARRIER
+        CALL WaitRequest(Req)
+        !$OMP BARRIER
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbv, jjev
+            DO i = 1, iip1
+              plnc2(i, j, l) = apnc(l) + bpnc(l) * (psnat2(i, j) * aire(i, j) * alpha2p3(i, j) &
+                      + psnat2(i, j + 1) * aire(i, j + 1) * alpha1p4(i, j + 1)) / airev(i, j)
+              plnc1(i, j, l) = apnc(l) + bpnc(l) * (psnat1(i, j) * aire(i, j) * alpha2p3(i, j) &
+                      + psnat1(i, j + 1) * aire(i, j + 1) * alpha1p4(i, j + 1)) / airev(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSE IF (guide_plevs==2) THEN
+        CALL Register_Hallo_u(pnat1, llm, 1, 2, 2, 1, Req)
+        CALL Register_Hallo_u(pnat2, llm, 1, 2, 2, 1, Req)
+        CALL SendRequest(Req)
+        !$OMP BARRIER
+        CALL WaitRequest(Req)
+        !$OMP BARRIER
+        !$OMP DO
+        DO l = 1, nlevnc
+          DO j = jjbv, jjev
+            DO i = 1, iip1
+              plnc2(i, j, l) = (pnat2(i, j, l) * aire(i, j) * alpha2p3(i, j) &
+                      + pnat2(i, j + 1, l) * aire(i, j) * alpha1p4(i, j + 1)) / airev(i, j)
+              plnc1(i, j, l) = (pnat1(i, j, l) * aire(i, j) * alpha2p3(i, j) &
+                      + pnat1(i, j + 1, l) * aire(i, j) * alpha1p4(i, j + 1)) / airev(i, j)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+      ! Interpolation verticale
+
+      !$OMP MASTER
+      CALL pres2lev(vnat1(:, jjbv:jjev, :), zv1(:, jjbv:jjev, :), nlevnc, llm, &
+              plnc1(:, jjbv:jjev, :), plvnc(:, jjbv:jjev, :), iip1, jjnv, invert_p)
+      CALL pres2lev(vnat2(:, jjbv:jjev, :), zv2(:, jjbv:jjev, :), nlevnc, llm, &
+              plnc2(:, jjbv:jjev, :), plvnc(:, jjbv:jjev, :), iip1, jjnv, invert_p)
+      !$OMP END MASTER
+      !$OMP BARRIER
+      ! Conversion en variables GCM
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l = 1, llm
+        do j = jjbv, jjev
+          do i = 1, iim
+            ij = (j - 1) * iip1 + i
+            vgui1(ij, l) = zv1(i, j, l) * cv(i, j)
+            vgui2(ij, l) = zv2(i, j, l) * cv(i, j)
+          enddo
+          vgui1(j * iip1, l) = vgui1((j - 1) * iip1 + 1, l)
+          vgui2(j * iip1, l) = vgui2((j - 1) * iip1 + 1, l)
+        enddo
+      enddo
+    ENDIF
+
+  END SUBROUTINE guide_interp
+
+  !=======================================================================
+  SUBROUTINE tau2alpha(typ, pim, jjb, jje, factt, taumin, taumax, alpha)
+
+    ! Calcul des constantes de rappel alpha (=1/tau)
+
+    USE comconst_mod, ONLY: pi
+    USE serre_mod, ONLY: clat, clon, grossismx, grossismy
+
+    IMPLICIT NONE
+
+    include "dimensions.h"
+    include "paramet.h"
+    include "comgeom2.h"
+
+    ! input arguments :
     INTEGER, INTENT(IN) :: typ    ! u(2),v(3), ou scalaire(1)
     INTEGER, INTENT(IN) :: pim ! dimensions en lon
-    INTEGER, INTENT(IN) :: jjb,jje ! dimensions en lat
-    REAL, INTENT(IN)    :: factt   ! pas de temps en fraction de jour
-    REAL, INTENT(IN)    :: taumin,taumax
-! output arguments:
-    REAL, DIMENSION(pim,jjb:jje), INTENT(OUT) :: alpha 
-  
-!  local variables:
-    LOGICAL, SAVE               :: first=.TRUE.
-    REAL, SAVE                  :: gamma,dxdy_min,dxdy_max
-    REAL, DIMENSION (iip1,jjp1) :: zdx,zdy
-    REAL, DIMENSION (iip1,jjp1) :: dxdys,dxdyu
-    REAL, DIMENSION (iip1,jjm)  :: dxdyv
-    real dxdy_
-    real zlat,zlon
-    real alphamin,alphamax,xi
-    integer i,j,ilon,ilat
-    CHARACTER(LEN=20),parameter :: modname="tau2alpha"
-
-
-    alphamin=factt/taumax
-    alphamax=factt/taumin
+    INTEGER, INTENT(IN) :: jjb, jje ! dimensions en lat
+    REAL, INTENT(IN) :: factt   ! pas de temps en fraction de jour
+    REAL, INTENT(IN) :: taumin, taumax
+    ! output arguments:
+    REAL, DIMENSION(pim, jjb:jje), INTENT(OUT) :: alpha
+
+    !  local variables:
+    LOGICAL, SAVE :: first = .TRUE.
+    REAL, SAVE :: gamma, dxdy_min, dxdy_max
+    REAL, DIMENSION (iip1, jjp1) :: zdx, zdy
+    REAL, DIMENSION (iip1, jjp1) :: dxdys, dxdyu
+    REAL, DIMENSION (iip1, jjm) :: dxdyv
+    REAL dxdy_
+    REAL zlat, zlon
+    REAL alphamin, alphamax, xi
+    INTEGER i, j, ilon, ilat
+    CHARACTER(LEN = 20), parameter :: modname = "tau2alpha"
+
+    alphamin = factt / taumax
+    alphamax = factt / taumin
     IF (guide_reg.OR.guide_add) THEN
-        alpha=alphamax
-!-----------------------------------------------------------------------
-! guide_reg: alpha=alpha_min dans region, 0. sinon.
-!-----------------------------------------------------------------------
-        IF (guide_reg) THEN
-            do j=jjb,jje
-                do i=1,pim
-                    if (typ==2) THEN
-                       zlat=rlatu(j)*180./pi
-                       zlon=rlonu(i)*180./pi
-                    elseif (typ==1) THEN
-                       zlat=rlatu(j)*180./pi
-                       zlon=rlonv(i)*180./pi
-                    elseif (typ==3) THEN
-                       zlat=rlatv(j)*180./pi
-                       zlon=rlonv(i)*180./pi
-                    endif
-                    alpha(i,j)=alphamax/16.* &
-                              (1.+tanh((zlat-lat_min_g)/tau_lat))* &
-                              (1.+tanh((lat_max_g-zlat)/tau_lat))* &
-                              (1.+tanh((zlon-lon_min_g)/tau_lon))* &
-                              (1.+tanh((lon_max_g-zlon)/tau_lon))
-                enddo
-            enddo
-        ENDIF
+      alpha = alphamax
+      !-----------------------------------------------------------------------
+      ! guide_reg: alpha=alpha_min dans region, 0. sinon.
+      !-----------------------------------------------------------------------
+      IF (guide_reg) THEN
+        do j = jjb, jje
+          do i = 1, pim
+            IF (typ==2) THEN
+              zlat = rlatu(j) * 180. / pi
+              zlon = rlonu(i) * 180. / pi
+            elseif (typ==1) THEN
+              zlat = rlatu(j) * 180. / pi
+              zlon = rlonv(i) * 180. / pi
+            elseif (typ==3) THEN
+              zlat = rlatv(j) * 180. / pi
+              zlon = rlonv(i) * 180. / pi
+            endif
+            alpha(i, j) = alphamax / 16. * &
+                    (1. + tanh((zlat - lat_min_g) / tau_lat)) * &
+                    (1. + tanh((lat_max_g - zlat) / tau_lat)) * &
+                    (1. + tanh((zlon - lon_min_g) / tau_lon)) * &
+                    (1. + tanh((lon_max_g - zlon) / tau_lon))
+          enddo
+        enddo
+      ENDIF
     ELSE
-!-----------------------------------------------------------------------
-! Sinon, alpha varie entre alpha_min et alpha_max suivant le zoom.
-!-----------------------------------------------------------------------
-!Calcul de l'aire des mailles
-        do j=2,jjm
-            do i=2,iip1
-               zdx(i,j)=0.5*(cu(i-1,j)+cu(i,j))/cos(rlatu(j))
-            enddo
-            zdx(1,j)=zdx(iip1,j)
+      !-----------------------------------------------------------------------
+      ! Sinon, alpha varie entre alpha_min et alpha_max suivant le zoom.
+      !-----------------------------------------------------------------------
+      !Calcul de l'aire des mailles
+      do j = 2, jjm
+        do i = 2, iip1
+          zdx(i, j) = 0.5 * (cu(i - 1, j) + cu(i, j)) / cos(rlatu(j))
         enddo
-        do j=2,jjm
-            do i=1,iip1
-               zdy(i,j)=0.5*(cv(i,j-1)+cv(i,j))
-            enddo
+        zdx(1, j) = zdx(iip1, j)
+      enddo
+      do j = 2, jjm
+        do i = 1, iip1
+          zdy(i, j) = 0.5 * (cv(i, j - 1) + cv(i, j))
         enddo
-        do i=1,iip1
-            zdx(i,1)=zdx(i,2)
-            zdx(i,jjp1)=zdx(i,jjm)
-            zdy(i,1)=zdy(i,2)
-            zdy(i,jjp1)=zdy(i,jjm)
+      enddo
+      do i = 1, iip1
+        zdx(i, 1) = zdx(i, 2)
+        zdx(i, jjp1) = zdx(i, jjm)
+        zdy(i, 1) = zdy(i, 2)
+        zdy(i, jjp1) = zdy(i, jjm)
+      enddo
+      do j = 1, jjp1
+        do i = 1, iip1
+          dxdys(i, j) = sqrt(zdx(i, j) * zdx(i, j) + zdy(i, j) * zdy(i, j))
         enddo
-        do j=1,jjp1
-            do i=1,iip1
-               dxdys(i,j)=sqrt(zdx(i,j)*zdx(i,j)+zdy(i,j)*zdy(i,j))
-            enddo
+      enddo
+      IF (typ==2) THEN
+        do j = 1, jjp1
+          do i = 1, iim
+            dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
+          enddo
+          dxdyu(iip1, j) = dxdyu(1, j)
         enddo
-        IF (typ==2) THEN
-            do j=1,jjp1
-                do i=1,iim
-                   dxdyu(i,j)=0.5*(dxdys(i,j)+dxdys(i+1,j))
-                enddo
-                dxdyu(iip1,j)=dxdyu(1,j)
-            enddo
-        ENDIF
-        IF (typ==3) THEN
-            do j=1,jjm
-                do i=1,iip1
-                   dxdyv(i,j)=0.5*(dxdys(i,j)+dxdys(i,j+1))
-                enddo
-            enddo
-        ENDIF
-! Premier appel: calcul des aires min et max et de gamma.
-        IF (first) THEN 
-            first=.FALSE.
-            ! coordonnees du centre du zoom
-            CALL coordij(clon,clat,ilon,ilat) 
-            ! aire de la maille au centre du zoom
-            dxdy_min=dxdys(ilon,ilat)
-            ! dxdy maximale de la maille
-            dxdy_max=0.
-            do j=1,jjp1
-                do i=1,iip1
-                     dxdy_max=max(dxdy_max,dxdys(i,j))
-                enddo
-            enddo
-            ! Calcul de gamma
-            if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
-              WRITE(*,*)trim(modname)//' ATTENTION modele peu zoome'
-              WRITE(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
-              gamma=0.
+      ENDIF
+      IF (typ==3) THEN
+        do j = 1, jjm
+          do i = 1, iip1
+            dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
+          enddo
+        enddo
+      ENDIF
+      ! Premier appel: calcul des aires min et max et de gamma.
+      IF (first) THEN
+        first = .FALSE.
+        ! coordonnees du centre du zoom
+        CALL coordij(clon, clat, ilon, ilat)
+        ! aire de la maille au centre du zoom
+        dxdy_min = dxdys(ilon, ilat)
+        ! dxdy maximale de la maille
+        dxdy_max = 0.
+        do j = 1, jjp1
+          do i = 1, iip1
+            dxdy_max = max(dxdy_max, dxdys(i, j))
+          enddo
+        enddo
+        ! Calcul de gamma
+        IF (abs(grossismx - 1.)<0.1.OR.abs(grossismy - 1.)<0.1) THEN
+          WRITE(*, *)trim(modname) // ' ATTENTION modele peu zoome'
+          WRITE(*, *)trim(modname) // ' ATTENTION on prend une constante de guidage cste'
+          gamma = 0.
+        else
+          gamma = (dxdy_max - 2. * dxdy_min) / (dxdy_max - dxdy_min)
+          WRITE(*, *)trim(modname) // ' gamma=', gamma
+          IF (gamma<1.e-5) THEN
+            WRITE(*, *)trim(modname) // ' gamma =', gamma, '<1e-5'
+            CALL abort_gcm("guide_loc_mod", "stopped", 1)
+          endif
+          gamma = log(0.5) / log(gamma)
+          IF (gamma4) THEN
+            gamma = min(gamma, 4.)
+          endif
+          WRITE(*, *)trim(modname) // ' gamma=', gamma
+        endif
+      ENDIF !first
+
+      do j = jjb, jje
+        do i = 1, pim
+          IF (typ==1) THEN
+            dxdy_ = dxdys(i, j)
+            zlat = rlatu(j) * 180. / pi
+          elseif (typ==2) THEN
+            dxdy_ = dxdyu(i, j)
+            zlat = rlatu(j) * 180. / pi
+          elseif (typ==3) THEN
+            dxdy_ = dxdyv(i, j)
+            zlat = rlatv(j) * 180. / pi
+          endif
+          IF (abs(grossismx - 1.)<0.1.OR.abs(grossismy - 1.)<0.1) THEN
+            ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
+            alpha(i, j) = alphamin
+          else
+            xi = ((dxdy_max - dxdy_) / (dxdy_max - dxdy_min))**gamma
+            xi = min(xi, 1.)
+            IF(lat_min_g<=zlat .AND. zlat<=lat_max_g) THEN
+              alpha(i, j) = xi * alphamin + (1. - xi) * alphamax
             else
-              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
-              WRITE(*,*)trim(modname)//' gamma=',gamma
-              if (gamma<1.e-5) THEN
-                WRITE(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
-                CALL abort_gcm("guide_loc_mod","stopped",1)
-              endif
-              gamma=log(0.5)/log(gamma)
-              if (gamma4) THEN
-                gamma=min(gamma,4.)
-              endif
-              WRITE(*,*)trim(modname)//' gamma=',gamma
+              alpha(i, j) = 0.
             endif
-        ENDIF !first
-
-        do j=jjb,jje
-            do i=1,pim
-                if (typ==1) THEN
-                   dxdy_=dxdys(i,j)
-                   zlat=rlatu(j)*180./pi
-                elseif (typ==2) THEN
-                   dxdy_=dxdyu(i,j)
-                   zlat=rlatu(j)*180./pi
-                elseif (typ==3) THEN
-                   dxdy_=dxdyv(i,j)
-                   zlat=rlatv(j)*180./pi
-                endif
-                if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
-                ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
-                    alpha(i,j)=alphamin
-                else
-                    xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
-                    xi=min(xi,1.)
-                    IF(lat_min_g<=zlat .and. zlat<=lat_max_g) THEN
-                        alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
-                    else
-                        alpha(i,j)=0.
-                    endif
-                endif
-            enddo
+          endif
         enddo
+      enddo
     ENDIF ! guide_reg
 
-    if (.not. guide_add) alpha = 1. - exp(- alpha)
+    IF (.NOT. guide_add) alpha = 1. - exp(- alpha)
 
   END SUBROUTINE tau2alpha
 
-!=======================================================================
+  !=======================================================================
   SUBROUTINE guide_read(timestep)
 
@@ -1578,316 +1568,312 @@
     include "paramet.h"
 
-    INTEGER, INTENT(IN)   :: timestep
-
-    LOGICAL, SAVE         :: first=.TRUE.
-! Identification fichiers et variables NetCDF:
-    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
-    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
-    INTEGER               :: ncidpl,varidpl,varidap,varidbp,dimid,lendim
-! Variables auxiliaires NetCDF:
-    INTEGER, DIMENSION(4) :: start,count
-    INTEGER               :: status,rcode
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'guide_read'
-    CHARACTER (len = 20)   :: namedim
-    abort_message='pb in guide_read'
-
-! -----------------------------------------------------------------
-! Premier appel: initialisation de la lecture des fichiers
-! -----------------------------------------------------------------
-    if (first) THEN
-         ncidpl=-99
-         WRITE(*,*) trim(modname)//': opening nudging files '
-! Ap et Bp si Niveaux de pression hybrides
-         if (guide_plevs==1) THEN
-             WRITE(*,*) trim(modname)//' Reading nudging on model levels'
-             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file apbp.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no AP variable in file apbp.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no BP variable in file apbp.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
-         endif
-         
-! Pression si guidage sur niveaux P variables
-         if (guide_plevs==2) THEN
-             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file P.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no PRES variable in file P.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
-             if (ncidpl==-99) ncidpl=ncidp
-         endif
-
-! Vent zonal
-         if (guide_u) THEN
-             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file u.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no UWND variable in file u.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
-             if (ncidpl==-99) ncidpl=ncidu
-
-    
-             status=nf90_inq_dimid(ncidu, "LONU", dimid)
-             status=nf90_inquire_dimension(ncidu,dimid,namedim,lendim)
-             IF (lendim /= iip1) THEN
-                abort_message='dimension LONU different from iip1 in u.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-             status=nf90_inq_dimid(ncidu, "LATU", dimid)
-             status=nf90_inquire_dimension(ncidu,dimid,namedim,lendim)
-             IF (lendim /= jjp1) THEN
-                abort_message='dimension LATU different from jjp1 in u.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-  
-         endif
-
-! Vent meridien
-         if (guide_v) THEN
-             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file v.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no VWND variable in file v.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
-             if (ncidpl==-99) ncidpl=ncidv
-             
-             status=nf90_inq_dimid(ncidv, "LONV", dimid)
-             status=nf90_inquire_dimension(ncidv,dimid,namedim,lendim)
-             
-                IF (lendim /= iip1) THEN
-                abort_message='dimension LONV different from iip1 in v.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-
-             status=nf90_inq_dimid(ncidv, "LATV", dimid)
-             status=nf90_inquire_dimension(ncidv,dimid,namedim,lendim)
-             IF (lendim /= jjm) THEN
-                abort_message='dimension LATV different from jjm in v.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-        
-        endif
-
-! Temperature
-         if (guide_T) THEN
-             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file T.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no AIR variable in file T.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
-             if (ncidpl==-99) ncidpl=ncidt
-
-             status=nf90_inq_dimid(ncidt, "LONV", dimid)
-             status=nf90_inquire_dimension(ncidt,dimid,namedim,lendim)
-             IF (lendim /= iip1) THEN
-                abort_message='dimension LONV different from iip1 in T.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-             status=nf90_inq_dimid(ncidt, "LATU", dimid)
-             status=nf90_inquire_dimension(ncidt,dimid,namedim,lendim)
-             IF (lendim /= jjp1) THEN
-                abort_message='dimension LATU different from jjp1 in T.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-         endif
-
-! Humidite
-         if (guide_Q) THEN
-             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file hur.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no RH variable in file hur.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
-             if (ncidpl==-99) ncidpl=ncidQ
-
-
-             status=nf90_inq_dimid(ncidQ, "LONV", dimid)
-             status=nf90_inquire_dimension(ncidQ,dimid,namedim,lendim)
-             IF (lendim /= iip1) THEN
-                abort_message='dimension LONV different from iip1 in hur.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-             status=nf90_inq_dimid(ncidQ, "LATU", dimid)
-             status=nf90_inquire_dimension(ncidQ,dimid,namedim,lendim)
-             IF (lendim /= jjp1) THEN
-                abort_message='dimension LATU different from jjp1 in hur.nc'
-                CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-
-
-         endif
-! Pression de surface
-         if ((guide_P).OR.(guide_plevs==1)) THEN
-             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no file ps.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
-             IF (rcode/=nf90_noerr) THEN
-              abort_message='Nudging: error -> no SP variable in file ps.nc'
-              CALL abort_gcm(modname,abort_message,1)
-             ENDIF
-             WRITE(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
-         endif
-! Coordonnee verticale
-         if (guide_plevs==0) THEN
-              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
-              IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
-              WRITE(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
-         endif
-! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         IF (guide_plevs==1) THEN
-             status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc])
-             status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
-         ELSEIF (guide_plevs==0) THEN
-             status=nf90_put_var(ncidpl,varidpl,apnc,[1],[nlevnc])
-!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
-             IF(convert_Pa) apnc=apnc*100.! conversion en Pascals
-             bpnc(:)=0.
-         ENDIF
-         first=.FALSE.
-     ENDIF ! (first)
-
-! -----------------------------------------------------------------
-!   lecture des champs u, v, T, Q, ps
-! -----------------------------------------------------------------
-
-!  dimensions pour les champs scalaires et le vent zonal
-     start(1)=1
-     start(2)=jjb_u
-     start(3)=1
-     start(4)=timestep
-
-     count(1)=iip1
-     count(2)=jjnb_u
-     count(3)=nlevnc
-     count(4)=1
-
-     IF (invert_y) start(2)=jjp1-jje_u+1
-! Pression 
-     if (guide_plevs==2) THEN
-         status=nf90_put_var(ncidp,varidp,pnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,pnat2)
-         ENDIF
-     endif
-
-!  Vent zonal
-     if (guide_u) THEN
-         status=nf90_put_var(ncidu,varidu,unat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,unat2)
-         ENDIF
-
-     endif
-
-
-!  Temperature
-     if (guide_T) THEN
-         status=nf90_put_var(ncidt,varidt,tnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,tnat2)
-         ENDIF
-     endif
-
-!  Humidite
-     if (guide_Q) THEN
-         status=nf90_put_var(ncidQ,varidQ,qnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,qnat2)
-         ENDIF
-
-     endif
-
-!  Vent meridien
-     if (guide_v) THEN
-         start(2)=jjb_v
-         count(2)=jjnb_v
-         IF (invert_y) start(2)=jjm-jje_v+1
-
-         status=nf90_put_var(ncidv,varidv,vnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_v,nlevnc,vnat2)
-         ENDIF
-     endif
-
-!  Pression de surface
-     if ((guide_P).OR.(guide_plevs==1))  THEN
-         start(2)=jjb_u
-         start(3)=timestep
-         start(4)=0
-         count(2)=jjnb_u
-         count(3)=1
-         count(4)=0
-         IF (invert_y) start(2)=jjp1-jje_u+1
-         status=nf90_put_var(ncidps,varidps,psnat2,start,count)
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,1,psnat2)
-         ENDIF
-     endif
+    INTEGER, INTENT(IN) :: timestep
+
+    LOGICAL, SAVE :: first = .TRUE.
+    ! Identification fichiers et variables NetCDF:
+    INTEGER, SAVE :: ncidu, varidu, ncidv, varidv, ncidp, varidp
+    INTEGER, SAVE :: ncidQ, varidQ, ncidt, varidt, ncidps, varidps
+    INTEGER :: ncidpl, varidpl, varidap, varidbp, dimid, lendim
+    ! Variables auxiliaires NetCDF:
+    INTEGER, DIMENSION(4) :: start, count
+    INTEGER :: status, rcode
+    CHARACTER (len = 80) :: abort_message
+    CHARACTER (len = 20) :: modname = 'guide_read'
+    CHARACTER (len = 20) :: namedim
+    abort_message = 'pb in guide_read'
+
+    ! -----------------------------------------------------------------
+    ! Premier appel: initialisation de la lecture des fichiers
+    ! -----------------------------------------------------------------
+    IF (first) THEN
+      ncidpl = -99
+      WRITE(*, *) trim(modname) // ': opening nudging files '
+      ! Ap et Bp si Niveaux de pression hybrides
+      IF (guide_plevs==1) THEN
+        WRITE(*, *) trim(modname) // ' Reading nudging on model levels'
+        rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no BP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidpl,varidap', ncidpl, varidap
+      endif
+
+      ! Pression si guidage sur niveaux P variables
+      IF (guide_plevs==2) THEN
+        rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no PRES variable in file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidp,varidp', ncidp, varidp
+        IF (ncidpl==-99) ncidpl = ncidp
+      endif
+
+      ! Vent zonal
+      IF (guide_u) THEN
+        rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no UWND variable in file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidu,varidu', ncidu, varidu
+        IF (ncidpl==-99) ncidpl = ncidu
+
+        status = nf90_inq_dimid(ncidu, "LONU", dimid)
+        status = nf90_inquire_dimension(ncidu, dimid, namedim, lendim)
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONU different from iip1 in u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidu, "LATU", dimid)
+        status = nf90_inquire_dimension(ncidu, dimid, namedim, lendim)
+        IF (lendim /= jjp1) THEN
+          abort_message = 'dimension LATU different from jjp1 in u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+
+      ! Vent meridien
+      IF (guide_v) THEN
+        rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no VWND variable in file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidv,varidv', ncidv, varidv
+        IF (ncidpl==-99) ncidpl = ncidv
+
+        status = nf90_inq_dimid(ncidv, "LONV", dimid)
+        status = nf90_inquire_dimension(ncidv, dimid, namedim, lendim)
+
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONV different from iip1 in v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidv, "LATV", dimid)
+        status = nf90_inquire_dimension(ncidv, dimid, namedim, lendim)
+        IF (lendim /= jjm) THEN
+          abort_message = 'dimension LATV different from jjm in v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+
+      ! Temperature
+      IF (guide_T) THEN
+        rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AIR variable in file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidT,varidT', ncidt, varidt
+        IF (ncidpl==-99) ncidpl = ncidt
+
+        status = nf90_inq_dimid(ncidt, "LONV", dimid)
+        status = nf90_inquire_dimension(ncidt, dimid, namedim, lendim)
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONV different from iip1 in T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidt, "LATU", dimid)
+        status = nf90_inquire_dimension(ncidt, dimid, namedim, lendim)
+        IF (lendim /= jjp1) THEN
+          abort_message = 'dimension LATU different from jjp1 in T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+
+      ! Humidite
+      IF (guide_Q) THEN
+        rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no RH variable in file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidQ,varidQ', ncidQ, varidQ
+        IF (ncidpl==-99) ncidpl = ncidQ
+
+        status = nf90_inq_dimid(ncidQ, "LONV", dimid)
+        status = nf90_inquire_dimension(ncidQ, dimid, namedim, lendim)
+        IF (lendim /= iip1) THEN
+          abort_message = 'dimension LONV different from iip1 in hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+        status = nf90_inq_dimid(ncidQ, "LATU", dimid)
+        status = nf90_inquire_dimension(ncidQ, dimid, namedim, lendim)
+        IF (lendim /= jjp1) THEN
+          abort_message = 'dimension LATU different from jjp1 in hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+
+      endif
+      ! Pression de surface
+      IF ((guide_P).OR.(guide_plevs==1)) THEN
+        rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidps, 'SP', varidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no SP variable in file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *) trim(modname) // ' ncidps,varidps', ncidps, varidps
+      endif
+      ! Coordonnee verticale
+      IF (guide_plevs==0) THEN
+        rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
+        IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
+        WRITE(*, *) trim(modname) // ' ncidpl,varidpl', ncidpl, varidpl
+      endif
+      ! Coefs ap, bp pour calcul de la pression aux differents niveaux
+      IF (guide_plevs==1) THEN
+        status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc])
+        status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
+      ELSEIF (guide_plevs==0) THEN
+        status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc])
+        !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
+        IF(convert_Pa) apnc = apnc * 100.! conversion en Pascals
+        bpnc(:) = 0.
+      ENDIF
+      first = .FALSE.
+    ENDIF ! (first)
+
+    ! -----------------------------------------------------------------
+    !   lecture des champs u, v, T, Q, ps
+    ! -----------------------------------------------------------------
+
+    !  dimensions pour les champs scalaires et le vent zonal
+    start(1) = 1
+    start(2) = jjb_u
+    start(3) = 1
+    start(4) = timestep
+
+    count(1) = iip1
+    count(2) = jjnb_u
+    count(3) = nlevnc
+    count(4) = 1
+
+    IF (invert_y) start(2) = jjp1 - jje_u + 1
+    ! Pression
+    IF (guide_plevs==2) THEN
+      status = nf90_put_var(ncidp, varidp, pnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, pnat2)
+      ENDIF
+    endif
+
+    !  Vent zonal
+    IF (guide_u) THEN
+      status = nf90_put_var(ncidu, varidu, unat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, unat2)
+      ENDIF
+
+    endif
+
+
+    !  Temperature
+    IF (guide_T) THEN
+      status = nf90_put_var(ncidt, varidt, tnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, tnat2)
+      ENDIF
+    endif
+
+    !  Humidite
+    IF (guide_Q) THEN
+      status = nf90_put_var(ncidQ, varidQ, qnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, qnat2)
+      ENDIF
+
+    endif
+
+    !  Vent meridien
+    IF (guide_v) THEN
+      start(2) = jjb_v
+      count(2) = jjnb_v
+      IF (invert_y) start(2) = jjm - jje_v + 1
+
+      status = nf90_put_var(ncidv, varidv, vnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_v, nlevnc, vnat2)
+      ENDIF
+    endif
+
+    !  Pression de surface
+    IF ((guide_P).OR.(guide_plevs==1))  THEN
+      start(2) = jjb_u
+      start(3) = timestep
+      start(4) = 0
+      count(2) = jjnb_u
+      count(3) = 1
+      count(4) = 0
+      IF (invert_y) start(2) = jjp1 - jje_u + 1
+      status = nf90_put_var(ncidps, varidps, psnat2, start, count)
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, 1, psnat2)
+      ENDIF
+    endif
 
   END SUBROUTINE guide_read
 
-!=======================================================================
+  !=======================================================================
   SUBROUTINE guide_read2D(timestep)
 
@@ -1897,276 +1883,276 @@
     include "paramet.h"
 
-    INTEGER, INTENT(IN)   :: timestep
-
-    LOGICAL, SAVE         :: first=.TRUE.
-! Identification fichiers et variables NetCDF:
-    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
-    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
-    INTEGER               :: ncidpl,varidpl,varidap,varidbp
-! Variables auxiliaires NetCDF:
-    INTEGER, DIMENSION(4) :: start,count
-    INTEGER               :: status,rcode
-! Variables for 3D extension:
-    REAL, DIMENSION (jjb_u:jje_u,llm)  :: zu
-    REAL, DIMENSION (jjb_v:jje_v,llm)  :: zv
-    INTEGER               :: i
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'guide_read2D'
-    abort_message='pb in guide_read2D'
-
-! -----------------------------------------------------------------
-! Premier appel: initialisation de la lecture des fichiers
-! -----------------------------------------------------------------
-    if (first) THEN
-         ncidpl=-99
-         WRITE(*,*)trim(modname)//' : opening nudging files '
-! Ap et Bp si niveaux de pression hybrides
-         if (guide_plevs==1) THEN
-           WRITE(*,*)trim(modname)//' Reading nudging on model levels'
-           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file apbp.nc'
-           CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no AP variable in file apbp.nc'
-           CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no BP variable in file apbp.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
-         endif
-! Pression
-         if (guide_plevs==2) THEN
-           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file P.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no PRES variable in file P.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
-           if (ncidpl==-99) ncidpl=ncidp
-         endif
-! Vent zonal
-         if (guide_u) THEN
-           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file u.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no UWND variable in file u.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
-           if (ncidpl==-99) ncidpl=ncidu
-         endif
-
-! Vent meridien
-         if (guide_v) THEN
-           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file v.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no VWND variable in file v.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
-           if (ncidpl==-99) ncidpl=ncidv
-        endif
-! Temperature
-         if (guide_T) THEN
-           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file T.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no AIR variable in file T.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
-           if (ncidpl==-99) ncidpl=ncidt
-         endif
-! Humidite
-         if (guide_Q) THEN
-           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file hur.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no RH,variable in file hur.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
-           if (ncidpl==-99) ncidpl=ncidQ
-         endif
-! Pression de surface
-         if ((guide_P).OR.(guide_plevs==1)) THEN
-           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no file ps.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
-           IF (rcode/=nf90_noerr) THEN
-             abort_message='Nudging: error -> no SP variable in file ps.nc'
-             CALL abort_gcm(modname,abort_message,1)
-           ENDIF
-           WRITE(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
-         endif
-! Coordonnee verticale
-         if (guide_plevs==0) THEN
-           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
-           IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
-           WRITE(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
-         endif
-! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         if (guide_plevs==1) THEN
-             status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc])
-             status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
-         elseif (guide_plevs==0) THEN
-             status=nf90_put_var(ncidpl,varidpl,apnc,[1],[nlevnc])
-             apnc=apnc*100.! conversion en Pascals
-             bpnc(:)=0.
-         endif
-         first=.FALSE.
-     endif ! (first)
-
-! -----------------------------------------------------------------
-!   lecture des champs u, v, T, Q, ps
-! -----------------------------------------------------------------
-
-!  dimensions pour les champs scalaires et le vent zonal
-     start(1)=1
-     start(2)=jjb_u
-     start(3)=1
-     start(4)=timestep
-
-     count(1)=1
-     count(2)=jjnb_u
-     count(3)=nlevnc
-     count(4)=1
-
-     IF (invert_y) start(2)=jjp1-jje_u+1
-!  Pression
-     if (guide_plevs==2) THEN
-         status=nf90_put_var(ncidp,varidp,zu,start,count)
-         DO i=1,iip1
-             pnat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,pnat2)
-         ENDIF
-     endif
-!  Vent zonal
-     if (guide_u) THEN
-         status=nf90_put_var(ncidu,varidu,zu,start,count)
-         DO i=1,iip1
-             unat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,unat2)
-         ENDIF
-     endif
-
-
-!  Temperature
-     if (guide_T) THEN
-         status=nf90_put_var(ncidt,varidt,zu,start,count)
-         DO i=1,iip1
-             tnat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,tnat2)
-         ENDIF
-     endif
-
-!  Humidite
-     if (guide_Q) THEN
-         status=nf90_put_var(ncidQ,varidQ,zu,start,count)
-         DO i=1,iip1
-             qnat2(i,:,:)=zu(:,:)
-         ENDDO
-         
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,nlevnc,qnat2)
-         ENDIF
-     endif
-
-!  Vent meridien
-     if (guide_v) THEN
-         start(2)=jjb_v
-         count(2)=jjnb_v
-         IF (invert_y) start(2)=jjm-jje_v+1
-         status=nf90_put_var(ncidv,varidv,zv,start,count)
-         DO i=1,iip1
-             vnat2(i,:,:)=zv(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
- 
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_v,nlevnc,vnat2)
-         ENDIF
-     endif
-
-!  Pression de surface
-     if ((guide_P).OR.(guide_plevs==1))  THEN
-         start(2)=jjb_u
-         start(3)=timestep
-         start(4)=0
-         count(2)=jjnb_u
-         count(3)=1
-         count(4)=0
-         IF (invert_y) start(2)=jjp1-jje_u+1
-         status=nf90_put_var(ncidps,varidps,zu(:,1),start,count)
-         DO i=1,iip1
-             psnat2(i,:)=zu(:,1)
-         ENDDO
-
-         IF (invert_y) THEN
-!           PRINT*,"Invertion impossible actuellement"
-!           CALL abort_gcm(modname,abort_message,1)
-           CALL invert_lat(iip1,jjnb_u,1,psnat2)
-         ENDIF
-     endif
+    INTEGER, INTENT(IN) :: timestep
+
+    LOGICAL, SAVE :: first = .TRUE.
+    ! Identification fichiers et variables NetCDF:
+    INTEGER, SAVE :: ncidu, varidu, ncidv, varidv, ncidp, varidp
+    INTEGER, SAVE :: ncidQ, varidQ, ncidt, varidt, ncidps, varidps
+    INTEGER :: ncidpl, varidpl, varidap, varidbp
+    ! Variables auxiliaires NetCDF:
+    INTEGER, DIMENSION(4) :: start, count
+    INTEGER :: status, rcode
+    ! Variables for 3D extension:
+    REAL, DIMENSION (jjb_u:jje_u, llm) :: zu
+    REAL, DIMENSION (jjb_v:jje_v, llm) :: zv
+    INTEGER :: i
+    CHARACTER (len = 80) :: abort_message
+    CHARACTER (len = 20) :: modname = 'guide_read2D'
+    abort_message = 'pb in guide_read2D'
+
+    ! -----------------------------------------------------------------
+    ! Premier appel: initialisation de la lecture des fichiers
+    ! -----------------------------------------------------------------
+    IF (first) THEN
+      ncidpl = -99
+      WRITE(*, *)trim(modname) // ' : opening nudging files '
+      ! Ap et Bp si niveaux de pression hybrides
+      IF (guide_plevs==1) THEN
+        WRITE(*, *)trim(modname) // ' Reading nudging on model levels'
+        rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no BP variable in file apbp.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // 'ncidpl,varidap', ncidpl, varidap
+      endif
+      ! Pression
+      IF (guide_plevs==2) THEN
+        rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no PRES variable in file P.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidp,varidp', ncidp, varidp
+        IF (ncidpl==-99) ncidpl = ncidp
+      endif
+      ! Vent zonal
+      IF (guide_u) THEN
+        rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no UWND variable in file u.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidu,varidu', ncidu, varidu
+        IF (ncidpl==-99) ncidpl = ncidu
+      endif
+
+      ! Vent meridien
+      IF (guide_v) THEN
+        rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no VWND variable in file v.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidv,varidv', ncidv, varidv
+        IF (ncidpl==-99) ncidpl = ncidv
+      endif
+      ! Temperature
+      IF (guide_T) THEN
+        rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no AIR variable in file T.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidT,varidT', ncidt, varidt
+        IF (ncidpl==-99) ncidpl = ncidt
+      endif
+      ! Humidite
+      IF (guide_Q) THEN
+        rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no RH,variable in file hur.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidQ,varidQ', ncidQ, varidQ
+        IF (ncidpl==-99) ncidpl = ncidQ
+      endif
+      ! Pression de surface
+      IF ((guide_P).OR.(guide_plevs==1)) THEN
+        rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        rcode = nf90_inq_varid(ncidps, 'SP', varidps)
+        IF (rcode/=nf90_noerr) THEN
+          abort_message = 'Nudging: error -> no SP variable in file ps.nc'
+          CALL abort_gcm(modname, abort_message, 1)
+        ENDIF
+        WRITE(*, *)trim(modname) // ' ncidps,varidps', ncidps, varidps
+      endif
+      ! Coordonnee verticale
+      IF (guide_plevs==0) THEN
+        rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
+        IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
+        WRITE(*, *)trim(modname) // ' ncidpl,varidpl', ncidpl, varidpl
+      endif
+      ! Coefs ap, bp pour calcul de la pression aux differents niveaux
+      IF (guide_plevs==1) THEN
+        status = nf90_put_var(ncidpl, varidap, apnc, [1], [nlevnc])
+        status = nf90_put_var(ncidpl, varidbp, bpnc, [1], [nlevnc])
+      elseif (guide_plevs==0) THEN
+        status = nf90_put_var(ncidpl, varidpl, apnc, [1], [nlevnc])
+        apnc = apnc * 100.! conversion en Pascals
+        bpnc(:) = 0.
+      endif
+      first = .FALSE.
+    endif ! (first)
+
+    ! -----------------------------------------------------------------
+    !   lecture des champs u, v, T, Q, ps
+    ! -----------------------------------------------------------------
+
+    !  dimensions pour les champs scalaires et le vent zonal
+    start(1) = 1
+    start(2) = jjb_u
+    start(3) = 1
+    start(4) = timestep
+
+    count(1) = 1
+    count(2) = jjnb_u
+    count(3) = nlevnc
+    count(4) = 1
+
+    IF (invert_y) start(2) = jjp1 - jje_u + 1
+    !  Pression
+    IF (guide_plevs==2) THEN
+      status = nf90_put_var(ncidp, varidp, zu, start, count)
+      DO i = 1, iip1
+        pnat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, pnat2)
+      ENDIF
+    endif
+    !  Vent zonal
+    IF (guide_u) THEN
+      status = nf90_put_var(ncidu, varidu, zu, start, count)
+      DO i = 1, iip1
+        unat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, unat2)
+      ENDIF
+    endif
+
+
+    !  Temperature
+    IF (guide_T) THEN
+      status = nf90_put_var(ncidt, varidt, zu, start, count)
+      DO i = 1, iip1
+        tnat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, tnat2)
+      ENDIF
+    endif
+
+    !  Humidite
+    IF (guide_Q) THEN
+      status = nf90_put_var(ncidQ, varidQ, zu, start, count)
+      DO i = 1, iip1
+        qnat2(i, :, :) = zu(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, nlevnc, qnat2)
+      ENDIF
+    endif
+
+    !  Vent meridien
+    IF (guide_v) THEN
+      start(2) = jjb_v
+      count(2) = jjnb_v
+      IF (invert_y) start(2) = jjm - jje_v + 1
+      status = nf90_put_var(ncidv, varidv, zv, start, count)
+      DO i = 1, iip1
+        vnat2(i, :, :) = zv(:, :)
+      ENDDO
+
+      IF (invert_y) THEN
+
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_v, nlevnc, vnat2)
+      ENDIF
+    endif
+
+    !  Pression de surface
+    IF ((guide_P).OR.(guide_plevs==1))  THEN
+      start(2) = jjb_u
+      start(3) = timestep
+      start(4) = 0
+      count(2) = jjnb_u
+      count(3) = 1
+      count(4) = 0
+      IF (invert_y) start(2) = jjp1 - jje_u + 1
+      status = nf90_put_var(ncidps, varidps, zu(:, 1), start, count)
+      DO i = 1, iip1
+        psnat2(i, :) = zu(:, 1)
+      ENDDO
+
+      IF (invert_y) THEN
+        !           PRINT*,"Invertion impossible actuellement"
+        !           CALL abort_gcm(modname,abort_message,1)
+        CALL invert_lat(iip1, jjnb_u, 1, psnat2)
+      ENDIF
+    endif
 
   END SUBROUTINE guide_read2D
-  
-!=======================================================================
-  SUBROUTINE guide_out(varname,hsize,vsize,field_loc,factt)
+
+  !=======================================================================
+  SUBROUTINE guide_out(varname, hsize, vsize, field_loc, factt)
     USE parallel_lmdz
     USE mod_hallo, ONLY: gather_field_u, gather_field_v
     USE comconst_mod, ONLY: pi
     USE comvert_mod, ONLY: presnivs
-    use netcdf95, ONLY: nf95_def_var, nf95_put_var
+    USE netcdf95, ONLY: nf95_def_var, nf95_put_var
 
     IMPLICIT NONE
@@ -2175,262 +2161,260 @@
     INCLUDE "paramet.h"
     INCLUDE "comgeom2.h"
-    
+
     ! Variables entree
-    CHARACTER*(*), INTENT(IN)                      :: varname
-    INTEGER,   INTENT (IN)                         :: hsize,vsize
-!   REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
-    REAL, DIMENSION (:,:), INTENT(IN) :: field_loc
+    CHARACTER*(*), INTENT(IN) :: varname
+    INTEGER, INTENT (IN) :: hsize, vsize
+    !   REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field_loc
+    REAL, DIMENSION (:, :), INTENT(IN) :: field_loc
     REAL factt
 
     ! Variables locales
-    INTEGER, SAVE :: timestep=0
+    INTEGER, SAVE :: timestep = 0
     ! Identites fichier netcdf
-    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
-    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
-    INTEGER       :: vid_au,vid_av, varid_alpha_t, varid_alpha_q
+    INTEGER :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
+    INTEGER :: vid_lonu, vid_lonv, vid_latu, vid_latv, vid_cu, vid_cv, vid_lev
+    INTEGER :: vid_au, vid_av, varid_alpha_t, varid_alpha_q
     INTEGER, DIMENSION (3) :: dim3
-    INTEGER, DIMENSION (4) :: dim4,count,start
-    INTEGER                :: ierr, varid,l
-    REAL zu(ip1jmp1),zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1)
-    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
-    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
-    
-!$OMP MASTER
-    ALLOCATE(field_glo(iip1,hsize,vsize))
-!$OMP END MASTER
-!$OMP BARRIER
-
-!    WRITE(*,*)trim(modname)//' after allocation ',hsize,vsize
+    INTEGER, DIMENSION (4) :: dim4, count, start
+    INTEGER :: ierr, varid, l
+    REAL zu(ip1jmp1), zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1)
+    REAL, ALLOCATABLE, SAVE, DIMENSION(:, :, :) :: field_glo
+    CHARACTER(LEN = 20), PARAMETER :: modname = "guide_out"
+
+    !$OMP MASTER
+    ALLOCATE(field_glo(iip1, hsize, vsize))
+    !$OMP END MASTER
+    !$OMP BARRIER
+
+    !    WRITE(*,*)trim(modname)//' after allocation ',hsize,vsize
 
     IF (hsize==jjp1) THEN
-        CALL gather_field_u(field_loc,field_glo,vsize)
+      CALL gather_field_u(field_loc, field_glo, vsize)
     ELSE IF (hsize==jjm) THEN
-       CALL gather_field_v(field_loc,field_glo, vsize)
-    ENDIF
-
-!    WRITE(*,*)trim(modname)//' after gather '
-    CALL Gather_field_u(alpha_u,zu,1)
-    CALL Gather_field_u(alpha_t,zt,1)
-    CALL Gather_field_u(alpha_q,zq,1)
-    CALL Gather_field_v(alpha_v,zv,1)
+      CALL gather_field_v(field_loc, field_glo, vsize)
+    ENDIF
+
+    !    WRITE(*,*)trim(modname)//' after gather '
+    CALL Gather_field_u(alpha_u, zu, 1)
+    CALL Gather_field_u(alpha_t, zt, 1)
+    CALL Gather_field_u(alpha_q, zq, 1)
+    CALL Gather_field_v(alpha_v, zv, 1)
 
     IF (mpi_rank >  0) THEN
-!$OMP MASTER
-       DEALLOCATE(field_glo)
-!$OMP END MASTER
-!$OMP BARRIER
-
-       RETURN
-    ENDIF
-    
-!$OMP MASTER
+      !$OMP MASTER
+      DEALLOCATE(field_glo)
+      !$OMP END MASTER
+      !$OMP BARRIER
+
+      RETURN
+    ENDIF
+
+    !$OMP MASTER
     IF (timestep==0) THEN
-! ----------------------------------------------
-! initialisation fichier de sortie
-! ----------------------------------------------
-! Ouverture du fichier
-        ierr=nf90_create("guide_ins.nc",IOR(nf90_clobber,nf90_64bit_offset),nid)
-! Definition des dimensions
-        ierr=nf90_def_dim(nid,"LONU",iip1,id_lonu)
-        ierr=nf90_def_dim(nid,"LONV",iip1,id_lonv)
-        ierr=nf90_def_dim(nid,"LATU",jjp1,id_latu)
-        ierr=nf90_def_dim(nid,"LATV",jjm,id_latv)
-        ierr=nf90_def_dim(nid,"LEVEL",llm,id_lev)
-        ierr=nf90_def_dim(nid,"TIME",nf90_unlimited,id_tim)
-
-! Creation des variables dimensions
-        ierr=nf90_def_var(nid,"LONU",nf90_float,id_lonu,vid_lonu)
-        ierr=nf90_def_var(nid,"LONV",nf90_float,id_lonv,vid_lonv)
-        ierr=nf90_def_var(nid,"LATU",nf90_float,id_latu,vid_latu)
-        ierr=nf90_def_var(nid,"LATV",nf90_float,id_latv,vid_latv)
-        ierr=nf90_def_var(nid,"LEVEL",nf90_float,id_lev,vid_lev)
-        ierr=nf90_def_var(nid,"cu",nf90_float,(/id_lonu,id_latu/),vid_cu)
-        ierr=nf90_def_var(nid,"cv",nf90_float,(/id_lonv,id_latv/),vid_cv)
-        ierr=nf90_def_var(nid,"au",nf90_float,(/id_lonu,id_latu/),vid_au)
-        ierr=nf90_def_var(nid,"av",nf90_float,(/id_lonv,id_latv/),vid_av)
-        CALL nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), &
-             varid_alpha_t)
-        CALL nf95_def_var(nid, "alpha_q", nf90_float, (/id_lonv, id_latu/), &
-             varid_alpha_q)
-        
-        ierr=nf90_enddef(nid)
-
-! Enregistrement des variables dimensions
-        ierr = nf90_put_var(nid,vid_lonu,rlonu*180./pi)
-        ierr = nf90_put_var(nid,vid_lonv,rlonv*180./pi)
-        ierr = nf90_put_var(nid,vid_latu,rlatu*180./pi)
-        ierr = nf90_put_var(nid,vid_latv,rlatv*180./pi)
-        ierr = nf90_put_var(nid,vid_lev,presnivs)
-        ierr = nf90_put_var(nid,vid_cu,cu)
-        ierr = nf90_put_var(nid,vid_cv,cv)
-        ierr = nf90_put_var(nid,vid_au,zu)
-        ierr = nf90_put_var(nid,vid_av,zv)
-        CALL nf95_put_var(nid, varid_alpha_t, zt)
-        CALL nf95_put_var(nid, varid_alpha_q, zq)
-! --------------------------------------------------------------------
-! Création des variables sauvegardées
-! --------------------------------------------------------------------
-        ierr = nf90_redef(nid)
-! Pressure (GCM)
-        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-        ierr = nf90_def_var(nid,"SP",nf90_float,dim4,varid)
-! Surface pressure (guidage)
-        IF (guide_P) THEN
-            dim3=(/id_lonv,id_latu,id_tim/)
-            ierr = nf90_def_var(nid,"ps",nf90_float,dim3,varid)
-        ENDIF
-! Zonal wind
-        IF (guide_u) THEN
-            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"u",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"ua",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"ucov",nf90_float,dim4,varid)
-        ENDIF
-! Merid. wind
-        IF (guide_v) THEN
-            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"v",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"va",nf90_float,dim4,varid)
-            ierr = nf90_def_var(nid,"vcov",nf90_float,dim4,varid)
-        ENDIF
-! Pot. Temperature
-        IF (guide_T) THEN
-            dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"teta",nf90_float,dim4,varid)
-        ENDIF
-! Specific Humidity
-        IF (guide_Q) THEN
-            dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-            ierr = nf90_def_var(nid,"q",nf90_float,dim4,varid)
-        ENDIF
-        
-        ierr = nf90_enddef(nid)
-        ierr = nf90_close(nid)
+      ! ----------------------------------------------
+      ! initialisation fichier de sortie
+      ! ----------------------------------------------
+      ! Ouverture du fichier
+      ierr = nf90_create("guide_ins.nc", IOR(nf90_clobber, nf90_64bit_offset), nid)
+      ! Definition des dimensions
+      ierr = nf90_def_dim(nid, "LONU", iip1, id_lonu)
+      ierr = nf90_def_dim(nid, "LONV", iip1, id_lonv)
+      ierr = nf90_def_dim(nid, "LATU", jjp1, id_latu)
+      ierr = nf90_def_dim(nid, "LATV", jjm, id_latv)
+      ierr = nf90_def_dim(nid, "LEVEL", llm, id_lev)
+      ierr = nf90_def_dim(nid, "TIME", nf90_unlimited, id_tim)
+
+      ! Creation des variables dimensions
+      ierr = nf90_def_var(nid, "LONU", nf90_float, id_lonu, vid_lonu)
+      ierr = nf90_def_var(nid, "LONV", nf90_float, id_lonv, vid_lonv)
+      ierr = nf90_def_var(nid, "LATU", nf90_float, id_latu, vid_latu)
+      ierr = nf90_def_var(nid, "LATV", nf90_float, id_latv, vid_latv)
+      ierr = nf90_def_var(nid, "LEVEL", nf90_float, id_lev, vid_lev)
+      ierr = nf90_def_var(nid, "cu", nf90_float, (/id_lonu, id_latu/), vid_cu)
+      ierr = nf90_def_var(nid, "cv", nf90_float, (/id_lonv, id_latv/), vid_cv)
+      ierr = nf90_def_var(nid, "au", nf90_float, (/id_lonu, id_latu/), vid_au)
+      ierr = nf90_def_var(nid, "av", nf90_float, (/id_lonv, id_latv/), vid_av)
+      CALL nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), &
+              varid_alpha_t)
+      CALL nf95_def_var(nid, "alpha_q", nf90_float, (/id_lonv, id_latu/), &
+              varid_alpha_q)
+
+      ierr = nf90_enddef(nid)
+
+      ! Enregistrement des variables dimensions
+      ierr = nf90_put_var(nid, vid_lonu, rlonu * 180. / pi)
+      ierr = nf90_put_var(nid, vid_lonv, rlonv * 180. / pi)
+      ierr = nf90_put_var(nid, vid_latu, rlatu * 180. / pi)
+      ierr = nf90_put_var(nid, vid_latv, rlatv * 180. / pi)
+      ierr = nf90_put_var(nid, vid_lev, presnivs)
+      ierr = nf90_put_var(nid, vid_cu, cu)
+      ierr = nf90_put_var(nid, vid_cv, cv)
+      ierr = nf90_put_var(nid, vid_au, zu)
+      ierr = nf90_put_var(nid, vid_av, zv)
+      CALL nf95_put_var(nid, varid_alpha_t, zt)
+      CALL nf95_put_var(nid, varid_alpha_q, zq)
+      ! --------------------------------------------------------------------
+      ! Création des variables sauvegardées
+      ! --------------------------------------------------------------------
+      ierr = nf90_redef(nid)
+      ! Pressure (GCM)
+      dim4 = (/id_lonv, id_latu, id_lev, id_tim/)
+      ierr = nf90_def_var(nid, "SP", nf90_float, dim4, varid)
+      ! Surface pressure (guidage)
+      IF (guide_P) THEN
+        dim3 = (/id_lonv, id_latu, id_tim/)
+        ierr = nf90_def_var(nid, "ps", nf90_float, dim3, varid)
+      ENDIF
+      ! Zonal wind
+      IF (guide_u) THEN
+        dim4 = (/id_lonu, id_latu, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "u", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "ua", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "ucov", nf90_float, dim4, varid)
+      ENDIF
+      ! Merid. wind
+      IF (guide_v) THEN
+        dim4 = (/id_lonv, id_latv, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "v", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "va", nf90_float, dim4, varid)
+        ierr = nf90_def_var(nid, "vcov", nf90_float, dim4, varid)
+      ENDIF
+      ! Pot. Temperature
+      IF (guide_T) THEN
+        dim4 = (/id_lonv, id_latu, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "teta", nf90_float, dim4, varid)
+      ENDIF
+      ! Specific Humidity
+      IF (guide_Q) THEN
+        dim4 = (/id_lonv, id_latu, id_lev, id_tim/)
+        ierr = nf90_def_var(nid, "q", nf90_float, dim4, varid)
+      ENDIF
+
+      ierr = nf90_enddef(nid)
+      ierr = nf90_close(nid)
     ENDIF ! timestep=0
 
-! --------------------------------------------------------------------
-! Enregistrement du champ
-! --------------------------------------------------------------------
- 
-    ierr=nf90_open("guide_ins.nc",nf90_write,nid)
-
-    IF (varname=="SP") timestep=timestep+1
-
-    ierr = nf90_inq_varid(nid,varname,varid)
+    ! --------------------------------------------------------------------
+    ! Enregistrement du champ
+    ! --------------------------------------------------------------------
+
+    ierr = nf90_open("guide_ins.nc", nf90_write, nid)
+
+    IF (varname=="SP") timestep = timestep + 1
+
+    ierr = nf90_inq_varid(nid, varname, varid)
     SELECT CASE (varname)
-    CASE ("SP","ps")
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjp1,llm,1/)
-    CASE ("v","va","vcov")
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjm,llm,1/)
+    CASE ("SP", "ps")
+      start = (/1, 1, 1, timestep/)
+      count = (/iip1, jjp1, llm, 1/)
+    CASE ("v", "va", "vcov")
+      start = (/1, 1, 1, timestep/)
+      count = (/iip1, jjm, llm, 1/)
     CASE DEFAULT
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjp1,llm,1/)
+      start = (/1, 1, 1, timestep/)
+      count = (/iip1, jjp1, llm, 1/)
     END SELECT
 
-!$OMP END MASTER
-!$OMP BARRIER
+    !$OMP END MASTER
+    !$OMP BARRIER
 
     SELECT CASE (varname)
 
-    CASE("u","ua")
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm 
-            field_glo(:,2:jjm,l)=field_glo(:,2:jjm,l)/cu(:,2:jjm)
-            field_glo(:,1,l)=0. ; field_glo(:,jjp1,l)=0.
-        ENDDO
-    CASE("v","va")
-!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l=1,llm
-           field_glo(:,:,l)=field_glo(:,:,l)/cv(:,:)
-        ENDDO
+    CASE("u", "ua")
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        field_glo(:, 2:jjm, l) = field_glo(:, 2:jjm, l) / cu(:, 2:jjm)
+        field_glo(:, 1, l) = 0. ; field_glo(:, jjp1, l) = 0.
+      ENDDO
+    CASE("v", "va")
+      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llm
+        field_glo(:, :, l) = field_glo(:, :, l) / cv(:, :)
+      ENDDO
     END SELECT
 
-!    if (varname=="ua") THEN
-!    CALL dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
-!    CALL dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
-!    endif
-
-!$OMP MASTER
-
-    ierr = nf90_put_var(nid,varid,field_glo,start,count)
+    !    if (varname=="ua") THEN
+    !    CALL dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ')
+    !    CALL dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ')
+    !    endif
+
+    !$OMP MASTER
+
+    ierr = nf90_put_var(nid, varid, field_glo, start, count)
     ierr = nf90_close(nid)
 
-       DEALLOCATE(field_glo)
-!$OMP END MASTER
-!$OMP BARRIER
+    DEALLOCATE(field_glo)
+    !$OMP END MASTER
+    !$OMP BARRIER
 
   END SUBROUTINE guide_out
-    
-  
-!===========================================================================
-  SUBROUTINE correctbid(iim,nl,x)
-    integer iim,nl
-    real x(iim+1,nl)
-    integer i,l
-    real zz
-
-    do l=1,nl
-        do i=2,iim-1
-            IF(abs(x(i,l))>1.e10) THEN
-               zz=0.5*(x(i-1,l)+x(i+1,l))
-              PRINT*,'correction ',i,l,x(i,l),zz
-               x(i,l)=zz
-            endif
-         enddo
-     enddo
+
+
+  !===========================================================================
+  SUBROUTINE correctbid(iim, nl, x)
+    INTEGER iim, nl
+    REAL x(iim + 1, nl)
+    INTEGER i, l
+    REAL zz
+
+    do l = 1, nl
+      do i = 2, iim - 1
+        IF(abs(x(i, l))>1.e10) THEN
+          zz = 0.5 * (x(i - 1, l) + x(i + 1, l))
+          PRINT*, 'correction ', i, l, x(i, l), zz
+          x(i, l) = zz
+        endif
+      enddo
+    enddo
 
   END SUBROUTINE  correctbid
 
 
-!====================================================================
-! Ascii debug output. Could be reactivated
-!====================================================================
-
-SUBROUTINE dump2du(var,varname)
-use parallel_lmdz
-use mod_hallo
-IMPLICIT NONE
-include 'dimensions.h'
-include 'paramet.h'
-
-      CHARACTER (len=*) :: varname
-
-
-real, dimension(ijb_u:ije_u) :: var
-
-real, dimension(ip1jmp1) :: var_glob
+  !====================================================================
+  ! Ascii debug output. Could be reactivated
+  !====================================================================
+
+  SUBROUTINE dump2du(var, varname)
+    USE parallel_lmdz
+    USE mod_hallo
+    IMPLICIT NONE
+    include 'dimensions.h'
+    include 'paramet.h'
+
+    CHARACTER (len = *) :: varname
+
+    REAL, DIMENSION(ijb_u:ije_u) :: var
+
+    REAL, DIMENSION(ip1jmp1) :: var_glob
 
     RETURN
 
     CALL barrier
-    CALL Gather_field_u(var,var_glob,1)
+    CALL Gather_field_u(var, var_glob, 1)
     CALL barrier
 
-    if (mpi_rank==0) THEN
-       CALL dump2d(iip1,jjp1,var_glob,varname)
+    IF (mpi_rank==0) THEN
+      CALL dump2d(iip1, jjp1, var_glob, varname)
     endif
 
     CALL barrier
 
-
-    END SUBROUTINE  dump2du
-
-!====================================================================
-! Ascii debug output. Could be reactivated
-!====================================================================
-SUBROUTINE dumpall
-     IMPLICIT NONE
-     include "dimensions.h"
-     include "paramet.h"
-     include "comgeom.h"
-     CALL barrier
-     CALL dump2du(alpha_u(ijb_u:ije_u),'  alpha_u couche 1')
-     CALL dump2du(unat2(:,jjbu:jjeu,nlevnc),'  unat2 couche nlevnc')
-     CALL dump2du(ugui1(ijb_u:ije_u,1)*sqrt(unscu2(ijb_u:ije_u)),'  ugui1 couche 1')
-
-END SUBROUTINE  dumpall
-
-!===========================================================================
+  END SUBROUTINE  dump2du
+
+  !====================================================================
+  ! Ascii debug output. Could be reactivated
+  !====================================================================
+  SUBROUTINE dumpall
+    IMPLICIT NONE
+    include "dimensions.h"
+    include "paramet.h"
+    include "comgeom.h"
+    CALL barrier
+    CALL dump2du(alpha_u(ijb_u:ije_u), '  alpha_u couche 1')
+    CALL dump2du(unat2(:, jjbu:jjeu, nlevnc), '  unat2 couche nlevnc')
+    CALL dump2du(ugui1(ijb_u:ije_u, 1) * sqrt(unscu2(ijb_u:ije_u)), '  ugui1 couche 1')
+
+  END SUBROUTINE  dumpall
+
+  !===========================================================================
 END MODULE guide_loc_mod
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90	(revision 5117)
@@ -7,9 +7,9 @@
   USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
   USE control_mod, ONLY: day_step,planet_type
-  use exner_hyb_m, ONLY: exner_hyb
-  use exner_milieu_m, ONLY: exner_milieu
+  USE exner_hyb_m, ONLY: exner_hyb
+  USE exner_milieu_m, ONLY: exner_milieu
   USE parallel_lmdz, ONLY: ijb_u, ije_u, ijb_v, ije_v
   USE IOIPSL, ONLY: getin
-  USE Write_Field
+  USE lmdz_write_field
   USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm
   USE logic_mod, ONLY: iflag_phys, read_start
@@ -17,6 +17,7 @@
   USE temps_mod, ONLY: annee_ref, day_ini, day_ref
   USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
-  USE readTracFiles_mod, ONLY: addPhase
-  use netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close, nf90_get_var
+  USE lmdz_readTracFiles, ONLY: addPhase
+  USE netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close, nf90_get_var
+  USE lmdz_ran1, ONLY: ran1
 
   !   Author:    Frederic Hourdin      original: 15/01/93
@@ -60,11 +61,10 @@
   REAL phi(ip1jmp1,llm)                  ! geopotentiel
   REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
-  real tetastrat ! potential temperature in the stratosphere, in K
-  real tetajl(jjp1,llm)
+  REAL tetastrat ! potential temperature in the stratosphere, in K
+  REAL tetajl(jjp1,llm)
   INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
 
   INTEGER :: nid_relief,varid,ierr
-  real, dimension(iip1,jjp1) :: relief
-
+  REAL, DIMENSION(iip1,jjp1) :: relief
 
   REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
@@ -74,6 +74,6 @@
   REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex 
 
-  real zz,ran1
-  integer idum
+  REAL zz
+  INTEGER idum
 
   REAL zdtvr, tnat, alpha_ideal
@@ -84,5 +84,5 @@
 
   ! Sanity check: verify that options selected by user are not incompatible
-  if ((iflag_phys==1).and. .not. read_start) THEN
+  IF ((iflag_phys==1).AND. .NOT. read_start) THEN
     WRITE(lunout,*) trim(modname)," error: if read_start is set to ", &
     " false then iflag_phys should not be 1"
@@ -90,5 +90,5 @@
     " (iflag_phys >= 100)"
     CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1)
-  endif
+  ENDIF
   
   !-----------------------------------------------------------------------
@@ -114,8 +114,8 @@
   ang0       = 0.
 
-  if (llm == 1) THEN
+  IF (llm == 1) THEN
      ! specific initializations for the shallow water case
      kappa=1
-  endif
+  ENDIF
 
   CALL iniconst
@@ -148,7 +148,7 @@
      relief=0.
      ierr = nf90_open ('relief_in.nc', nf90_nowrite,nid_relief)
-     if (ierr==nf90_noerr) THEN
+     IF (ierr==nf90_noerr) THEN
          ierr=nf90_inq_varid(nid_relief,'RELIEF',varid)
-         if (ierr==nf90_noerr) THEN
+         IF (ierr==nf90_noerr) THEN
               ierr=nf90_get_var(nid_relief,varid,relief(1:iim,1:jjp1))
               relief(iip1,:)=relief(1,:)
@@ -173,5 +173,5 @@
 
      CALL pression ( ip1jmp1, ap, bp, ps_glo, p       )
-     if (pressure_exner) THEN
+     IF (pressure_exner) THEN
        CALL exner_hyb( ip1jmp1, ps_glo, p, pks, pk )
      else
@@ -181,12 +181,12 @@
   ENDIF
 
-  if (llm == 1) THEN
+  IF (llm == 1) THEN
      ! initialize fields for the shallow water case, if required
-     if (.not.read_start) THEN
+     IF (.NOT.read_start) THEN
         phis(ijb_u:ije_u)=0.
         q(ijb_u:ije_u,1:llm,1:nqtot)=0
         CALL sw_case_williamson91_6_loc(vcov,ucov,teta,masse,ps)
      endif
-  endif
+  ENDIF
 
   academic_case: if (iflag_phys >= 2) THEN
@@ -258,5 +258,5 @@
            tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
                 -delt_z*(1.-ddsin*ddsin)*log(zsig)
-           if (planet_type=="giant") THEN
+           IF (planet_type=="giant") THEN
              tetajl(j,l)=teta0+(delt_y*                   &
                 ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
@@ -295,5 +295,5 @@
 
         ! winds
-        if (ok_geost) THEN
+        IF (ok_geost) THEN
            CALL ugeostr(phi,ucov_glo)
         else
@@ -303,5 +303,5 @@
 
         ! bulk initialization of tracers
-        if (planet_type=="earth") THEN
+        IF (planet_type=="earth") THEN
            ! Earth: first two tracers will be water
            do iq=1,nqtot
@@ -313,9 +313,9 @@
               ! distill de Rayleigh très simplifiée
               iName    = tracers(iq)%iso_iName
-              if (niso <= 0 .OR. iName <= 0) CYCLE
+              IF (niso <= 0 .OR. iName <= 0) CYCLE
               iPhase   = tracers(iq)%iso_iPhase
               iqParent = tracers(iq)%iqParent
               IF(tracers(iq)%iso_iZone == 0) THEN
-                 if (tnat1) THEN
+                 IF (tnat1) THEN
                          tnat=1.0
                          alpha_ideal=1.0
@@ -374,5 +374,5 @@
         deallocate(phis_glo)
      ENDIF ! of IF (.NOT. read_start)
-  endif academic_case
+  ENDIF academic_case
 
 END SUBROUTINE iniacademic_loc
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90	(revision 5117)
@@ -7,8 +7,8 @@
    USE IOIPSL
    USE parallel_lmdz
-   use Write_field
-   use misc_mod
+   USE lmdz_write_field
+   USE misc_mod
     ! USE infotrac
-   use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid,       &
+   USE com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid,       &
          dynhistave_file,dynhistvave_file,dynhistuave_file
    USE comconst_mod, ONLY: pi
@@ -51,5 +51,5 @@
   !   Arguments
   !
-  integer(kind=4) day0, anne0
+  INTEGER(kind=4) day0, anne0
   REAL :: tstep, t_ops, t_wrt
 
@@ -81,5 +81,5 @@
   INTEGER :: dynhistuave_domain_id
 
-  if (adjust) return
+  IF (adjust) return
 
   !
@@ -219,5 +219,5 @@
   !  Vents V
   !
-  if (pole_sud) jjn=jj_nb-1
+  IF (pole_sud) jjn=jj_nb-1
   CALL histdef(histvaveid, 'v', 'vent v moyen', &
         'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90	(revision 5117)
@@ -4,6 +4,6 @@
   USE IOIPSL
   USE parallel_lmdz
-  use Write_field
-  use misc_mod
+  USE lmdz_write_field
+  USE misc_mod
   USE comconst_mod, ONLY: pi
   USE comvert_mod, ONLY: nivsigs
@@ -64,5 +64,5 @@
   INTEGER :: ii, jj
   INTEGER :: zan, idayref
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   INTEGER :: jjb, jje, jjn
 
@@ -136,6 +136,6 @@
   jje = jj_end
   jjn = jj_nb
-  if (pole_sud) jje = jj_end - 1
-  if (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) jje = jj_end - 1
+  IF (pole_sud) jjn = jj_nb - 1
 
   ddid = (/ 1, 2 /)
@@ -156,10 +156,10 @@
   rl(1, 1) = 1.
 
-  if (mpi_rank==0) THEN
+  IF (mpi_rank==0) THEN
     CALL histbeg('defstoke.nc', 1, rl, 1, rl, &
             1, 1, 1, 1, &
             tau0, zjulian, tstep, dhoriid, filedid)
 
-  endif
+  ENDIF
   !
   !  Appel a histhori pour rajouter les autres grilles horizontales
@@ -190,10 +190,10 @@
           llm, nivsigs, zvertiid)
   ! pour le fichier def
-  if (mpi_rank==0) THEN
+  IF (mpi_rank==0) THEN
     nivd(1) = 1
     CALL histvert(filedid, 'sig_s', 'Niveaux sigma', &
             'sigma_level', &
             1, nivd, dvertiid)
-  endif
+  ENDIF
   !
   !  Appels a histdef pour la definition des variables a sauvegarder
@@ -207,5 +207,5 @@
           "once", t_ops, t_wrt)
 
-  if (mpi_rank==0) THEN
+  IF (mpi_rank==0) THEN
     CALL histdef(filedid, "dtvr", "tps dyn", "s", &
             1, 1, dhoriid, 1, 1, 1, -99, 32, &
@@ -220,5 +220,5 @@
             "once", t_ops, t_wrt)
 
-  endif
+  ENDIF
   !
   ! Masse
@@ -237,5 +237,5 @@
   !  Pbarv
   !
-  if (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) jjn = jj_nb - 1
 
   CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', &
@@ -245,5 +245,5 @@
   !  w
   !
-  if (pole_sud) jjn = jj_nb
+  IF (pole_sud) jjn = jj_nb
   CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', &
           iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
@@ -269,10 +269,10 @@
   CALL histend(fileid)
   CALL histend(filevid)
-  if (mpi_rank==0) CALL histend(filedid)
-  if (ok_sync) THEN
+  IF (mpi_rank==0) CALL histend(filedid)
+  IF (ok_sync) THEN
     CALL histsync(fileid)
     CALL histsync(filevid)
-    if (mpi_rank==0) CALL histsync(filedid)
-  endif
+    IF (mpi_rank==0) CALL histsync(filedid)
+  ENDIF
 
 END SUBROUTINE initfluxsto_p
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90	(revision 5117)
@@ -6,5 +6,5 @@
   USE IOIPSL
   USE parallel_lmdz
-  USE Write_field
+  USE lmdz_write_field
   USE misc_mod
   USE com_io_dyn_mod, ONLY: histid, histvid, histuid, &
@@ -78,5 +78,5 @@
   INTEGER :: dynhistu_domain_id
 
-  if (adjust) return
+  IF (adjust) return
 
   !
@@ -215,5 +215,5 @@
   !  Vents V
   !
-  if (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) jjn = jj_nb - 1
   CALL histdef(histvid, 'v', 'vent v', &
           'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90	(revision 5117)
@@ -9,5 +9,5 @@
   USE lmdz_filtreg_p
   USE write_field_loc
-  USE write_field
+  USE lmdz_write_field
   USE integrd_mod
   USE comconst_mod, ONLY: pi
@@ -15,5 +15,5 @@
   USE comvert_mod, ONLY: ap, bp
   USE temps_mod, ONLY: dt
-  USE strings_mod, ONLY: int2str
+  USE lmdz_strings, ONLY: int2str
 
   IMPLICIT NONE
@@ -43,5 +43,5 @@
   !   ----------
 
-  INTEGER,intent(in) :: nq ! number of tracers to handle in this routine
+  INTEGER,INTENT(IN) :: nq ! number of tracers to handle in this routine
 
   REAL,INTENT(INOUT) :: vcov(ijb_v:ije_v,llm) ! covariant meridional wind
@@ -90,5 +90,5 @@
 
 !$OMP BARRIER
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  l = 1,llm
@@ -101,5 +101,5 @@
   ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO  l = 1,llm
@@ -195,5 +195,5 @@
   !   !WRITE(*,*) 'integrd 200'
 !$OMP MASTER
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 
     DO  ij    = 1, iim
@@ -207,5 +207,5 @@
   ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
 
     DO  ij    = 1, iim
@@ -255,6 +255,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
@@ -265,5 +265,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
@@ -320,5 +320,5 @@
     ucovm1(ijb:ije,l)=uscr(ijb:ije)
     tetam1(ijb:ije,l)=hscr(ijb:ije)
-    if (pole_sud) ije=ij_end-iip1
+    IF (pole_sud) ije=ij_end-iip1
     vcovm1(ijb:ije,l)=vscr(ijb:ije)
 
@@ -334,5 +334,5 @@
   ije=ij_end
 
-     if (planet_type=="earth") THEN
+     IF (planet_type=="earth") THEN
   ! Earth-specific treatment of first 2 tracers (water)
 !$OMP BARRIER
@@ -415,5 +415,5 @@
   !c$OMP END DO NOWAIT
 
-  endif ! of if (planet_type.eq."earth")
+  ENDIF ! of if (planet_type.EQ."earth")
 
   !
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_gam_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_gam_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_gam_loc.f90	(revision 5117)
@@ -45,6 +45,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud ) ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud ) ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_loc.f90	(revision 5117)
@@ -36,6 +36,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud ) ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud ) ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -47,6 +47,6 @@
   jjb=jj_begin-1
   jje=jj_end+1
-  if (pole_nord) jjb=jj_begin
-  if (pole_sud ) jje=jj_end
+  IF (pole_nord) jjb=jj_begin
+  IF (pole_sud ) jje=jj_end
 
   CALL filtreg_p( divgra,jjb_u,jje_u,jjb,jje,jjp1, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rot_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rot_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rot_loc.f90	(revision 5117)
@@ -35,6 +35,6 @@
   jje=jj_end+1
 
-  if (pole_nord) jjb=jj_begin
-  if (pole_sud) jje=jj_end-1
+  IF (pole_nord) jjb=jj_begin
+  IF (pole_sud) jje=jj_end-1
 
   CALL  filtreg_p ( rotin ,jjb_v,jje_v,jjb,jje,jjm, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90	(revision 5117)
@@ -9,7 +9,7 @@
   USE mod_hallo
   USE Bands
-  USE strings_mod, ONLY: int2str
+  USE lmdz_strings, ONLY: int2str
   USE Write_Field_p
-  USE vampir
+  USE lmdz_vampir
   USE lmdz_timer_filtre, ONLY: print_filtre_timer
   USE infotrac
@@ -27,6 +27,6 @@
           , leapfrog_allocate, leapfrog_switch_caldyn, leapfrog_switch_dissip
 
-  use exner_hyb_loc_m, ONLY: exner_hyb_loc
-  use exner_milieu_loc_m, ONLY: exner_milieu_loc
+  USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+  USE exner_milieu_loc_m, ONLY: exner_milieu_loc
   USE comconst_mod, ONLY: cpp, dtvr, ihf
   USE comvert_mod, ONLY: ap, bp, pressure_exner
@@ -150,5 +150,5 @@
   REAL :: secondes
 
-  logical :: physic
+  LOGICAL :: physic
   LOGICAL :: first, callinigrads
 
@@ -213,9 +213,9 @@
   lafin = .FALSE.
 
-  if (nday>=0) THEN
+  IF (nday>=0) THEN
     itaufin = nday * day_step
   else
     itaufin = -nday
-  endif
+  ENDIF
 
   itaufinp1 = itaufin + 1
@@ -225,5 +225,5 @@
   itau = 0
   physic = .TRUE.
-  if (iflag_phys==0.or.iflag_phys==2) physic = .FALSE.
+  IF (iflag_phys==0.OR.iflag_phys==2) physic = .FALSE.
   CALL init_nan
   CALL leapfrog_allocate
@@ -247,5 +247,5 @@
   ! Allocate variables depending on dynamic variable nqtot
   !$OMP MASTER
-  if (firstcall) THEN
+  IF (firstcall) THEN
     ! ALLOCATE(p(ijb_u:ije_u,llmp1))
     !      ALLOCATE(pks(ijb_u:ije_u))
@@ -274,5 +274,5 @@
     ! ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm))
     ! ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm))
-  endif
+  ENDIF
   !$OMP END MASTER
   !$OMP BARRIER
@@ -290,9 +290,9 @@
   CALL pression (ijnb_u, ap, bp, ps, p)
   !$OMP END MASTER
-  if (pressure_exner) THEN
+  IF (pressure_exner) THEN
     CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
   else
     CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk, pkf)
-  endif
+  ENDIF
   !-----------------------------------------------------------------------
   !   Debut de l'integration temporelle:
@@ -309,15 +309,15 @@
   jH_cur = jH_ref + start_time + &
           mod(itau + 1, day_step) / float(day_step)
-  if (jH_cur > 1.0) THEN
+  IF (jH_cur > 1.0) THEN
     jD_cur = jD_cur + 1.
     jH_cur = jH_cur - 1.
-  endif
+  ENDIF
 
   CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 321')
 
-  if (ok_guide) THEN
+  IF (ok_guide) THEN
     CALL guide_main(itau,ucov,vcov,teta,q,masse,ps)
 !$OMP BARRIER
-  endif
+  ENDIF
 
 
@@ -334,5 +334,5 @@
   !ym      CALL SCOPY( ip1jmp1, ps  , 1,   psm1 , 1 )
 
-  if (FirstCaldyn) THEN
+  IF (FirstCaldyn) THEN
     !$OMP MASTER
     ucovm1 = ucov
@@ -365,5 +365,5 @@
       ! finvmaold(ijb:ije,l)=masse(ijb:ije,l)
 
-      if (pole_sud) ije = ij_end - iip1
+      IF (pole_sud) ije = ij_end - iip1
       vcovm1(ijb:ije, l) = vcov  (ijb:ije, l)
 
@@ -376,5 +376,5 @@
     ! .                    llm, -2,2, .TRUE., 1 )
 
-  endif ! of if (FirstCaldyn)
+  ENDIF ! of if (FirstCaldyn)
 
   forward = .TRUE.
@@ -398,9 +398,9 @@
   !$OMP MASTER
   ItCount = ItCount + 1
-  if (MOD(ItCount, 1)==1) THEN
+  IF (MOD(ItCount, 1)==1) THEN
     debug = .TRUE.
   else
     debug = .FALSE.
-  endif
+  ENDIF
   !$OMP END MASTER
   !-----------------------------------------------------------------------
@@ -414,5 +414,5 @@
     jH_cur = jH_ref + start_time + &
             mod(itau + 1, day_step) / float(day_step)
-    if (jH_cur > 1.0) THEN
+    IF (jH_cur > 1.0) THEN
       jD_cur = jD_cur + 1.
       jH_cur = jH_cur - 1.
@@ -436,5 +436,5 @@
             apdiss = .TRUE.
     IF(MOD(itau, iphysiq)==0.AND..NOT.forward &
-            .and. physic) apphys = .TRUE.
+            .AND. physic) apphys = .TRUE.
   ELSE
     ! Leapfrog/Matsuno time stepping
@@ -447,7 +447,7 @@
   ! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
   ! supress dissipation step
-  if (llm==1) THEN
+  IF (llm==1) THEN
     apdiss = .FALSE.
-  endif
+  ENDIF
 
   !ym    ---> Pour le moment
@@ -456,5 +456,5 @@
   ! conser = .FALSE. ! ie: no output of control variables to stdout in //
 
-  if (firstCaldyn) THEN
+  IF (firstCaldyn) THEN
     !$OMP MASTER
     CALL Set_Distrib(distrib_caldyn)
@@ -466,5 +466,5 @@
     CALL Init_timer
     !$OMP END MASTER
-  endif
+  ENDIF
 
   !$OMP MASTER
@@ -478,14 +478,14 @@
 
   !ym  PAS D'AJUSTEMENT POUR LE MOMENT
-  if (Adjust) THEN
+  IF (Adjust) THEN
     AdjustCount = AdjustCount + 1
-    ! if (iapptrac==iapp_tracvl .and. (forward .OR.  leapf)
-    ! &         .and. itau/iphysiq>2 .and. Adjustcount>30) THEN
-    if (Adjustcount>1) THEN
+    ! if (iapptrac==iapp_tracvl .AND. (forward .OR.  leapf)
+    ! &         .AND. itau/iphysiq>2 .AND. Adjustcount>30) THEN
+    IF (Adjustcount>1) THEN
       AdjustCount = 0
       !$OMP MASTER
       CALL allgather_timer_average
 
-      if (prt_level > 9) THEN
+      IF (prt_level > 9) THEN
         print *, '*********************************'
         print *, '******    TIMER CALDYN     ******'
@@ -586,9 +586,9 @@
 
       !$OMP MASTER
-      if (mpi_rank==0) CALL WriteBands
+      IF (mpi_rank==0) CALL WriteBands
       !$OMP END MASTER
 
     endif
-  endif
+  ENDIF
 
   CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 589')
@@ -625,5 +625,5 @@
   !$OMP BARRIER
 
-  if (debug) THEN
+  IF (debug) THEN
     CALL WriteField_u('ucov', ucov)
     CALL WriteField_v('vcov', vcov)
@@ -639,5 +639,5 @@
               q(:, :, iq))
     enddo
-  endif
+  ENDIF
 
   True_itau = True_itau + 1
@@ -670,5 +670,5 @@
 
   !$OMP MASTER
-  if (mpi_rank==0.AND.conser) THEN
+  IF (mpi_rank==0.AND.conser) THEN
     WRITE(lunout, *) 'leapfrog_loc, Time step: ', itau, ' Day:', time
   ENDIF
@@ -728,5 +728,5 @@
   !$OMP END MASTER
   IF (CPPKEY_DEBUGIO) THEN
-    if (true_itau>20) THEN
+    IF (true_itau>20) THEN
       CALL WriteField_u('ucovm1', ucovm1)
       CALL WriteField_v('vcovm1', vcovm1)
@@ -802,5 +802,5 @@
     ! c-jld
     !$OMP MASTER
-    if (FirstPhysic) THEN
+    IF (FirstPhysic) THEN
       ok_start_timer = .TRUE.
       FirstPhysic = .FALSE.
@@ -814,5 +814,5 @@
   IF(iflag_phys==2) THEN ! "Newtonian" case
     !$OMP MASTER
-    if (FirstPhysic) THEN
+    IF (FirstPhysic) THEN
       ok_start_timer = .TRUE.
       FirstPhysic = .FALSE.
@@ -838,5 +838,5 @@
 
     !$OMP MASTER
-    if (planet_type=="giant") THEN
+    IF (planet_type=="giant") THEN
       ! add an intrinsic heat flux at the base of the atmosphere
       teta(ijb:ije, 1) = teta(ijb:ije, 1) &
@@ -864,9 +864,9 @@
   CALL pression_loc (ip1jmp1, ap, bp, ps, p)
   !$OMP BARRIER
-  if (pressure_exner) THEN
+  IF (pressure_exner) THEN
     CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
   else
     CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk, pkf)
-  endif
+  ENDIF
   !$OMP BARRIER
   CALL massdair_loc(p, masse)
@@ -897,5 +897,5 @@
     CALL allgather_timer_average
     CALL barrier
-    if (mpi_rank==0) THEN
+    IF (mpi_rank==0) THEN
       print *, '*********************************'
       print *, '******    TIMER CALDYN     ******'
@@ -944,5 +944,5 @@
     !$OMP END MASTER
 
-    if (ok_guide) THEN
+    IF (ok_guide) THEN
       ! set ok_guide to false to avoid extra output
       ! in following forward step
@@ -960,5 +960,5 @@
       ENDIF
 #ifdef REPROBUS
-     if (type_trac == 'repr') CALL finalize_reprobus
+     IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
@@ -988,5 +988,5 @@
 
     IF(itau == itaufinp1) THEN
-      if (flag_verif) THEN
+      IF (flag_verif) THEN
         WRITE(79, *) 'ucov', ucov
         WRITE(80, *) 'vcov', vcov
@@ -1013,5 +1013,5 @@
         ENDIF
 #ifdef REPROBUS
-          if (type_trac == 'repr') CALL finalize_reprobus
+          IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
@@ -1064,5 +1064,5 @@
     IF(MOD(itau, iecri)==0) THEN
       ! Ehouarn: output only during LF or Backward Matsuno
-      if (leapf.or.(.not.leapf.and.(.not.forward))) THEN
+      IF (leapf.OR.(.NOT.leapf.AND.(.NOT.forward))) THEN
         !$OMP BARRIER
         !$OMP MASTER
@@ -1071,5 +1071,5 @@
         !$OMP BARRIER
 
-         if (ok_dyn_ins) THEN
+         IF (ok_dyn_ins) THEN
              CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
                    masse,ps,phis)
@@ -1085,5 +1085,5 @@
         ENDIF
 
-      endif                 ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
+      endif                 ! of if (leapf.OR.(.NOT.leapf.AND.(.NOT.forward)))
 
     ENDIF ! of IF(MOD(itau,iecri).EQ.0)
@@ -1093,10 +1093,10 @@
       !$OMP BARRIER
 
-      ! if (planet_type.eq."earth") THEN
+      ! if (planet_type.EQ."earth") THEN
       ! Write an Earth-format restart file
       CALL dynredem1_loc("restart.nc", 0.0, &
               vcov, ucov, teta, q, masse, ps)
-      ! endif ! of if (planet_type.eq."earth")
-      if (ok_guide) THEN
+      ! END IF ! of if (planet_type.EQ."earth")
+      IF (ok_guide) THEN
         ! set ok_guide to false to avoid extra output
         ! in following forward step
@@ -1141,5 +1141,5 @@
     !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
 
-  ELSE ! of IF (.not.purmats)
+  ELSE ! of IF (.NOT.purmats)
 
     CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1664')
@@ -1175,5 +1175,5 @@
           ENDIF
 #ifdef REPROBUS
-             if (type_trac == 'repr') CALL finalize_reprobus
+             IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
@@ -1226,5 +1226,5 @@
 
 
-          if (ok_dyn_ins) THEN
+          IF (ok_dyn_ins) THEN
              CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
                    masse,ps,phis)
@@ -1243,9 +1243,9 @@
 
       IF(itau==itaufin) THEN
-        ! if (planet_type.eq."earth") THEN
+        ! if (planet_type.EQ."earth") THEN
         CALL dynredem1_loc("restart.nc", 0.0, &
                 vcov, ucov, teta, q, masse, ps)
-        ! endif ! of if (planet_type.eq."earth")
-        if (ok_guide) THEN
+        ! END IF ! of if (planet_type.EQ."earth")
+        IF (ok_guide) THEN
           ! set ok_guide to false to avoid extra output
           ! in following forward step
@@ -1262,5 +1262,5 @@
     CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1750')
 
-  END IF ! of IF(.not.purmats)
+  END IF ! of IF(.NOT.purmats)
   !$OMP MASTER
   CALL fin_getparam
@@ -1277,5 +1277,5 @@
     ENDIF
 #ifdef REPROBUS
-  if (type_trac == 'repr') CALL finalize_reprobus
+  IF (type_trac == 'repr') CALL finalize_reprobus
 #endif
 
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90	(revision 5117)
@@ -71,15 +71,15 @@
           phis_dyn, q_dyn, flxw_dyn)
     USE dimensions_mod
-    use exner_hyb_loc_m, ONLY: exner_hyb_loc
-    use exner_milieu_loc_m, ONLY: exner_milieu_loc
+    USE exner_hyb_loc_m, ONLY: exner_hyb_loc
+    USE exner_milieu_loc_m, ONLY: exner_milieu_loc
     USE parallel_lmdz
     USE times
     USE mod_hallo
     USE Bands
-    USE vampir
+    USE lmdz_vampir
     USE infotrac, ONLY: nqtot
     USE control_mod
     USE write_field_loc
-    USE strings_mod, ONLY: int2str
+    USE lmdz_strings, ONLY: int2str
     USE comconst_mod, ONLY: dtphys
     USE logic_mod, ONLY: leapf, forward, ok_strato
@@ -144,5 +144,5 @@
     jH_cur = jH_ref + start_time + &
             mod(itau + 1, day_step) / float(day_step)
-    if (jH_cur > 1.0) THEN
+    IF (jH_cur > 1.0) THEN
       jD_cur = jD_cur + 1.
       jH_cur = jH_cur - 1.
@@ -231,5 +231,5 @@
     ijb = ij_begin
     ije = ij_end
-    IF (.not. pole_nord) THEN
+    IF (.NOT. pole_nord) THEN
 
       !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -246,5 +246,5 @@
       !$OMP END MASTER
 
-    ENDIF ! of if ( .not. pole_nord)
+    ENDIF ! of if ( .NOT. pole_nord)
 
     !$OMP BARRIER
@@ -275,5 +275,5 @@
     !$OMP BARRIER
     ijb = ij_begin
-    IF (.not. pole_nord) THEN
+    IF (.NOT. pole_nord) THEN
 
       !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -290,5 +290,5 @@
       !$OMP END MASTER
 
-    endif ! of if (.not. pole_nord)
+    endif ! of if (.NOT. pole_nord)
 
     IF (CPPKEY_DEBUGIO) THEN
@@ -334,5 +334,5 @@
     CALL massdair_loc(p, masse)
     !$OMP BARRIER
-    if (pressure_exner) THEN
+    IF (pressure_exner) THEN
       CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
     else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_filtreg_p.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_filtreg_p.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_filtreg_p.F90	(revision 5117)
@@ -102,5 +102,5 @@
     !-------------------------------------------------------c
 
-    IF(ifiltre==1.or.ifiltre==-1) &
+    IF(ifiltre==1.OR.ifiltre==-1) &
             CALL abort_gcm("lmdz_filtreg_p", 'Pas de transformee&
                     &simple dans cette version', 1)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.f90	(revision 5117)
@@ -88,6 +88,6 @@
   ije=ij_end+2*iip1
 
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90	(revision 5117)
@@ -18,5 +18,5 @@
     USE mod_prism
 #endif
-    USE wxios, ONLY: wxios_init, using_xios
+    USE lmdz_wxios, ONLY: wxios_init, using_xios
     IMPLICIT NONE
 
@@ -56,5 +56,5 @@
   SUBROUTINE Init_mpi
     USE lmdz_mpi
-    USE wxios, ONLY: wxios_init, using_xios
+    USE lmdz_wxios, ONLY: wxios_init, using_xios
 
   IMPLICIT NONE
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90	(revision 5117)
@@ -3,21 +3,21 @@
 IMPLICIT NONE
   logical,save :: use_mpi_alloc
-  integer, parameter :: MaxProc=512
-  integer, parameter :: DefaultMaxBufferSize=1024*1024*100
-  integer, SAVE :: MaxBufferSize=0
-  integer, parameter :: ListSize=1000
-  
-  integer,save       :: MaxBufferSize_Used
+  INTEGER, parameter :: MaxProc=512
+  INTEGER, parameter :: DefaultMaxBufferSize=1024*1024*100
+  INTEGER, SAVE :: MaxBufferSize=0
+  INTEGER, parameter :: ListSize=1000
+  
+  INTEGER,save       :: MaxBufferSize_Used
 !$OMP THREADPRIVATE( MaxBufferSize_Used)
 
-   real,save,pointer,dimension(:) :: Buffer
+   REAL,SAVE,pointer,DIMENSION(:) :: Buffer
 !$OMP THREADPRIVATE(Buffer)
 
-   integer,save,dimension(Listsize) :: Buffer_Pos
-   integer,save :: Index_Pos
+   INTEGER,SAVE,DIMENSION(Listsize) :: Buffer_Pos
+   INTEGER,save :: Index_Pos
 !$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
    
   type Hallo
-    real, dimension(:,:),pointer :: Field
+    REAL, DIMENSION(:,:),pointer :: Field
     INTEGER :: offset
     INTEGER :: size
@@ -37,6 +37,6 @@
 
   type request
-    type(request_SR),dimension(0:MaxProc-1) :: RequestSend
-    type(request_SR),dimension(0:MaxProc-1) :: RequestRecv
+    type(request_SR),DIMENSION(0:MaxProc-1) :: RequestSend
+    type(request_SR),DIMENSION(0:MaxProc-1) :: RequestRecv
     INTEGER :: tag=1
   end type request
@@ -143,11 +143,11 @@
     INTEGER :: Pos
 
-    if (Buffer_pos(Index_pos)+Size>MaxBufferSize_Used) MaxBufferSize_Used=Buffer_pos(Index_pos)+Size  
-    if (Buffer_pos(Index_pos)+Size>MaxBufferSize) THEN
+    IF (Buffer_pos(Index_pos)+Size>MaxBufferSize_Used) MaxBufferSize_Used=Buffer_pos(Index_pos)+Size
+    IF (Buffer_pos(Index_pos)+Size>MaxBufferSize) THEN
       print *,'STOP :: La taille de MaxBufferSize dans mod_hallo.F90 est trop petite !!!!'
       CALL abort_gcm("mod_hallo","stopped",1)
     endif
     
-    if (Index_pos>=ListSize) THEN
+    IF (Index_pos>=ListSize) THEN
       print *,'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
       CALL abort_gcm("mod_hallo","stopped",1)
@@ -167,5 +167,5 @@
     Buffer_Pos(Index)=-1
     
-    do while (Buffer_Pos(Index_Pos)==-1 .and. Index_Pos>1)
+    do while (Buffer_Pos(Index_Pos)==-1 .AND. Index_Pos>1)
       Index_Pos=Index_Pos-1
     END DO
@@ -187,5 +187,5 @@
     INTEGER :: size
     INTEGER :: offset
-    real, dimension(Stride,NbLevel),target :: Field
+    REAL, DIMENSION(Stride,NbLevel),target :: Field
     type(request_SR),pointer :: Ptr_request
     type(Hallo),POINTER :: NewHallos(:),HalloSwitch(:), NewHallo
@@ -220,5 +220,5 @@
     
       INTEGER :: ij,ll,offset,size,target
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       type(request),target :: a_request
       type(request_SR),pointer :: Ptr_request
@@ -236,5 +236,5 @@
    
       INTEGER :: ij,ll,offset,size,target
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       type(request),target :: a_request
       type(request_SR),pointer :: Ptr_request
@@ -253,9 +253,9 @@
     
     INTEGER :: ij,ll
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
     type(request) :: a_request
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
     INTEGER ::i,jje,jjb
@@ -269,11 +269,11 @@
     
     do i=0,MPI_Size-1
-      if (i /= MPI_Rank) THEN
+      IF (i /= MPI_Rank) THEN
         jjb=max(jj_begin_new(i),jj_begin)
         jje=min(jj_end_new(i),jj_end)
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -282,7 +282,7 @@
         jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -301,9 +301,9 @@
     
     INTEGER :: ij,ll,Up,Down
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
     type(request) :: a_request
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
     INTEGER ::i,jje,jjb
@@ -322,11 +322,11 @@
    
     do i=0,MPI_Size-1
-      if (i /= MPI_Rank) THEN
+      IF (i /= MPI_Rank) THEN
         jjb=max(jj_begin_new(i),jj_begin)
         jje=min(jj_end_new(i),jj_end)
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -335,7 +335,7 @@
         jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
         
-        if (ij==ip1jm .and. jje==jjp1) jje=jjm
-        
-        if (jje >= jjb) THEN
+        IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
+        
+        IF (jje >= jjb) THEN
           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
         endif
@@ -1153,5 +1153,5 @@
 
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: Sup,Sdown,rup,rdown
       type(request) :: a_request
@@ -1176,17 +1176,17 @@
       ENDIF
       
-      if (Sup==0) THEN
+      IF (Sup==0) THEN
         SendUp=.FALSE.
        endif
       
-      if (Sdown==0) THEN
+      IF (Sdown==0) THEN
         SendDown=.FALSE.
       endif
 
-      if (Rup==0) THEN
+      IF (Rup==0) THEN
         RecvUp=.FALSE.
       endif
       
-      if (Rdown==0) THEN
+      IF (Rdown==0) THEN
         RecvDown=.FALSE.
       endif
@@ -1217,5 +1217,5 @@
       IMPLICIT NONE
       INTEGER :: ll
-      REAL, dimension(ijb_u:ije_u,ll) :: Field
+      REAL, DIMENSION(ijb_u:ije_u,ll) :: Field
       INTEGER :: Sup,Sdown,rup,rdown
       type(request) :: a_request
@@ -1240,17 +1240,17 @@
       ENDIF
       
-      if (Sup==0) THEN
+      IF (Sup==0) THEN
         SendUp=.FALSE.
        endif
       
-      if (Sdown==0) THEN
+      IF (Sdown==0) THEN
         SendDown=.FALSE.
       endif
 
-      if (Rup==0) THEN
+      IF (Rup==0) THEN
         RecvUp=.FALSE.
       endif
       
-      if (Rdown==0) THEN
+      IF (Rdown==0) THEN
         RecvDown=.FALSE.
       endif
@@ -1280,5 +1280,5 @@
       IMPLICIT NONE
       INTEGER :: ll
-      REAL, dimension(ijb_v:ije_v,ll) :: Field
+      REAL, DIMENSION(ijb_v:ije_v,ll) :: Field
       INTEGER :: Sup,Sdown,rup,rdown
       type(request) :: a_request
@@ -1303,17 +1303,17 @@
       ENDIF
       
-      if (Sup==0) THEN
+      IF (Sup==0) THEN
         SendUp=.FALSE.
        endif
       
-      if (Sdown==0) THEN
+      IF (Sdown==0) THEN
         SendDown=.FALSE.
       endif
 
-      if (Rup==0) THEN
+      IF (Rup==0) THEN
         RecvUp=.FALSE.
       endif
       
-      if (Rdown==0) THEN
+      IF (Rdown==0) THEN
         RecvDown=.FALSE.
       endif
@@ -1349,5 +1349,5 @@
       INTEGER :: i,rank,l,ij,Pos,ierr
       INTEGER :: offset
-      real,dimension(:,:),pointer :: Field
+      REAL,DIMENSION(:,:),pointer :: Field
       INTEGER :: Nb
        
@@ -1367,5 +1367,5 @@
       
          Req%BufferSize=SizeBuffer
-         if (Req%NbRequest>0) THEN
+         IF (Req%NbRequest>0) THEN
           CALL allocate_buffer(SizeBuffer,Req%Index,Req%pos)
 
@@ -1389,5 +1389,5 @@
           enddo
     
-         if (SizeBuffer>0) THEN
+         IF (SizeBuffer>0) THEN
 !$OMP CRITICAL (MPI)
          
@@ -1426,8 +1426,8 @@
           Req%BufferSize=SizeBuffer
           
-          if (Req%NbRequest>0) THEN
+          IF (Req%NbRequest>0) THEN
           CALL allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
    
-          if (SizeBuffer>0) THEN
+          IF (SizeBuffer>0) THEN
 !$OMP CRITICAL (MPI)
 
@@ -1462,6 +1462,6 @@
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
-      integer, dimension(2*mpi_size) :: TabRequest
-      integer, dimension(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
+      INTEGER, DIMENSION(2*mpi_size) :: TabRequest
+      INTEGER, DIMENSION(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
       INTEGER :: NbRequest
       INTEGER :: i,rank,pos,ij,l,ierr
@@ -1473,5 +1473,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
+        IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1481,5 +1481,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
+        IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1487,5 +1487,5 @@
       enddo
      
-      if (NbRequest>0) THEN
+      IF (NbRequest>0) THEN
 !$OMP CRITICAL (MPI)
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1499,5 +1499,5 @@
       do rank=0,MPI_Size-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           Pos=Req%Pos
           do i=1,Req%NbRequest
@@ -1522,5 +1522,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1530,5 +1530,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1547,6 +1547,6 @@
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
-      integer, dimension(mpi_size) :: TabRequest
-      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
+      INTEGER, DIMENSION(mpi_size) :: TabRequest
+      INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
       INTEGER :: NbRequest
       INTEGER :: i,rank,pos,ij,l,ierr
@@ -1557,5 +1557,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1564,5 +1564,5 @@
       
 
-      if (NbRequest>0 .AND. Req%BufferSize > 0 ) THEN 
+      IF (NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
 !$OMP CRITICAL (MPI)     
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1578,5 +1578,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestSend(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1594,6 +1594,6 @@
       type(request_SR),pointer :: Req
       type(Hallo),pointer :: PtrHallo
-      integer, dimension(mpi_size) :: TabRequest
-      integer, dimension(MPI_STATUS_SIZE,mpi_size) :: TabStatus
+      INTEGER, DIMENSION(mpi_size) :: TabRequest
+      INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
       INTEGER :: NbRequest
       INTEGER :: i,rank,pos,ij,l,ierr
@@ -1605,5 +1605,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
+        IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
           NbRequest=NbRequest+1
           TabRequest(NbRequest)=Req%MSG_Request
@@ -1612,5 +1612,5 @@
      
       
-      if (NbRequest>0) THEN
+      IF (NbRequest>0) THEN
 !$OMP CRITICAL (MPI)     
 !        PRINT *,"-------------------------------------------------------------------"
@@ -1625,5 +1625,5 @@
       do rank=0,MPI_Size-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           Pos=Req%Pos
           do i=1,Req%NbRequest
@@ -1647,5 +1647,5 @@
       do rank=0,MPI_SIZE-1
         Req=>a_request%RequestRecv(rank)
-        if (Req%NbRequest>0) THEN
+        IF (Req%NbRequest>0) THEN
           CALL deallocate_buffer(Req%Index)
           Req%NbRequest=0 
@@ -1664,8 +1664,8 @@
     
     INTEGER :: ij,ll,l
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
     
     INTEGER ::i,jje,jjb,ijb,ije
@@ -1680,7 +1680,7 @@
     jjb=max(jj_begin,jj_begin_new(MPI_Rank))
     jje=min(jj_end,jj_end_new(MPI_Rank))
-    if (ij==ip1jm) jje=min(jje,jjm)
-
-    if (jje >= jjb) THEN
+    IF (ij==ip1jm) jje=min(jje,jjm)
+
+    IF (jje >= jjb) THEN
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
@@ -1702,8 +1702,8 @@
     
     INTEGER :: ij,ll,Up,Down
-    REAL, dimension(ij,ll) :: FieldS
-    REAL, dimension(ij,ll) :: FieldR
-    integer,dimension(0:MPI_Size-1) :: jj_Nb_New   
-    integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
+    REAL, DIMENSION(ij,ll) :: FieldS
+    REAL, DIMENSION(ij,ll) :: FieldR
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
+    INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
 
     INTEGER ::i,jje,jjb,ijb,ije,l
@@ -1720,8 +1720,8 @@
     jjb=max(jj_begin,jj_begin_new(MPI_Rank)-Up)
     jje=min(jj_end,jj_end_new(MPI_Rank)+Down)
-    if (ij==ip1jm) jje=min(jje,jjm)
-    
-    
-    if (jje >= jjb) THEN
+    IF (ij==ip1jm) jje=min(jje,jjm)
+    
+    
+    IF (jje >= jjb) THEN
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
@@ -1743,5 +1743,5 @@
      REAL :: field_glo(ip1jmp1,ll)
      type(request) :: request_gather
-     integer       :: l
+     INTEGER       :: l
 
 
@@ -1767,10 +1767,10 @@
      type(request) :: request_gather
      INTEGER :: ijb,ije
-     integer       :: l
+     INTEGER       :: l
      
    
      ijb=ij_begin
      ije=ij_end
-     if (pole_sud) ije=ij_end-iip1
+     IF (pole_sud) ije=ij_end-iip1
         
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -1795,5 +1795,5 @@
      type(request) :: request_gather
      TYPE(distrib) :: distrib_swap
-     integer       :: l
+     INTEGER       :: l
      
 !$OMP BARRIER
@@ -1829,5 +1829,5 @@
      type(request) :: request_gather
      TYPE(distrib) :: distrib_swap
-     integer       :: ijb,ije,l
+     INTEGER       :: ijb,ije,l
      
 
@@ -1849,5 +1849,5 @@
      ijb=ij_begin
      ije=ij_end
-     if (pole_sud) ije=ij_end-iip1
+     IF (pole_sud) ije=ij_end-iip1
      
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_xios_dyn3dmem.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_xios_dyn3dmem.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_xios_dyn3dmem.F90	(revision 5117)
@@ -15,5 +15,5 @@
 
      USE lmdz_xios
-     USE wxios, ONLY: g_comm
+     USE lmdz_wxios, ONLY: g_comm
      CHARACTER(len=100), SAVE :: dyn3d_ctx_name = "LMDZDYN"
      TYPE(xios_context), SAVE :: dyn3d_ctx_handle
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90	(revision 5117)
@@ -52,15 +52,15 @@
   END DO
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO  ij = 1,iip1
      x(    ij    ,l ) = 0.
     ENDDO
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     DO  ij = 1,iip1
      x( ij +ip1jm,l ) = 0.
     ENDDO
-  endif
+  ENDIF
   !
   END DO
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90	(revision 5117)
@@ -27,5 +27,5 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb+1, ije
@@ -44,6 +44,6 @@
   ije=ij_end+iip1
 
-  if (pole_nord)  ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord)  ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij = ijb,ije
@@ -51,15 +51,15 @@
   END DO
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO ij = 1,iip1
       x(    ij    ,l ) = 0.
     ENDDO
-  endif
+  ENDIF
 
-  if (pole_sud) THEN
+  IF (pole_sud) THEN
     DO ij = 1,iip1
       x( ij +ip1jm,l ) = 0.
     ENDDO
-  endif
+  ENDIF
   !
   END DO
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90	(revision 5117)
@@ -107,5 +107,5 @@
   jjb=jj_begin
   jje=jj_end
-  if (pole_sud) jje=jj_end-1
+  IF (pole_sud) jje=jj_end-1
 
   CALL filtreg_p( rot, jjb_v,jje_v, jjb,jje,jjm, &
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90	(revision 5117)
@@ -5,5 +5,5 @@
   USE mod_const_mpi
   USE lmdz_mpi, ONLY: using_mpi
-      use IOIPSL
+      USE IOIPSL
     INTEGER,PARAMETER :: halo_max=3
     
@@ -12,36 +12,36 @@
 !$OMP THREADPRIVATE(is_master)
     
-    integer, save :: mpi_size
-    integer, save :: mpi_rank
-    integer, save :: jj_begin
-    integer, save :: jj_end
-    integer, save :: jj_nb
-    integer, save :: ij_begin
-    integer, save :: ij_end
+    INTEGER, save :: mpi_size
+    INTEGER, save :: mpi_rank
+    INTEGER, save :: jj_begin
+    INTEGER, save :: jj_end
+    INTEGER, save :: jj_nb
+    INTEGER, save :: ij_begin
+    INTEGER, save :: ij_end
     logical, save :: pole_nord
     logical, save :: pole_sud
 
-    integer,save  :: jjb_u
-    integer,save  :: jje_u
-    integer,save  :: jjnb_u
-    integer,save  :: jjb_v
-    integer,save  :: jje_v
-    integer,save  :: jjnb_v    
-
-    integer,save  :: ijb_u
-    integer,save  :: ije_u
-    integer,save  :: ijnb_u    
-    
-    integer,save  :: ijb_v
-    integer,save  :: ije_v
-    integer,save  :: ijnb_v    
+    INTEGER,save  :: jjb_u
+    INTEGER,save  :: jje_u
+    INTEGER,save  :: jjnb_u
+    INTEGER,save  :: jjb_v
+    INTEGER,save  :: jje_v
+    INTEGER,save  :: jjnb_v
+
+    INTEGER,save  :: ijb_u
+    INTEGER,save  :: ije_u
+    INTEGER,save  :: ijnb_u
+    
+    INTEGER,save  :: ijb_v
+    INTEGER,save  :: ije_v
+    INTEGER,save  :: ijnb_v
      
     
-    integer, allocatable, save, dimension(:) :: jj_begin_para
-    integer, allocatable, save, dimension(:) :: jj_end_para
-    integer, allocatable, save, dimension(:) :: jj_nb_para
-    integer, save :: OMP_CHUNK
-    integer, save :: omp_rank
-    integer, save :: omp_size  
+    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: jj_begin_para
+    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: jj_end_para
+    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: jj_nb_para
+    INTEGER, save :: OMP_CHUNK
+    INTEGER, save :: omp_rank
+    INTEGER, save :: omp_size
 !$OMP THREADPRIVATE(omp_rank)
 
@@ -53,23 +53,23 @@
       INTEGER :: ij_end
 
-      integer  :: jjb_u
-      integer  :: jje_u
-      integer  :: jjnb_u
-      integer  :: jjb_v
-      integer  :: jje_v
-      integer  :: jjnb_v    
+      INTEGER  :: jjb_u
+      INTEGER  :: jje_u
+      INTEGER  :: jjnb_u
+      INTEGER  :: jjb_v
+      INTEGER  :: jje_v
+      INTEGER  :: jjnb_v
  
-      integer  :: ijb_u
-      integer  :: ije_u
-      integer  :: ijnb_u    
-    
-      integer  :: ijb_v
-      integer  :: ije_v
-      integer  :: ijnb_v    
+      INTEGER  :: ijb_u
+      INTEGER  :: ije_u
+      INTEGER  :: ijnb_u
+    
+      INTEGER  :: ijb_v
+      INTEGER  :: ije_v
+      INTEGER  :: ijnb_v
      
     
-      integer, pointer :: jj_begin_para(:) => NULL()
-      integer, pointer :: jj_end_para(:) => NULL()
-      integer, pointer :: jj_nb_para(:) => NULL()
+      INTEGER, pointer :: jj_begin_para(:) => NULL()
+      INTEGER, pointer :: jj_end_para(:) => NULL()
+      INTEGER, pointer :: jj_nb_para(:) => NULL()
     END TYPE distrib  
     
@@ -82,5 +82,5 @@
  
     SUBROUTINE init_parallel
-    USE vampir
+    USE lmdz_vampir
     USE lmdz_mpi
     IMPLICIT NONE
@@ -92,5 +92,5 @@
       INTEGER :: i,j
       INTEGER :: type_size
-      integer, dimension(3) :: blocklen,type
+      INTEGER, DIMENSION(3) :: blocklen,type
       INTEGER :: comp_id
       CHARACTER(LEN=4)  :: num
@@ -122,5 +122,5 @@
 
 ! Open text output file with mpi_rank in suffix of file name 
-      IF (lunout /= 5 .and. lunout /= 6) THEN
+      IF (lunout /= 5 .AND. lunout /= 6) THEN
          WRITE(num,'(I4.4)') mpi_rank
          filename='lmdz.out_'//num
@@ -138,7 +138,7 @@
       do i=0,mpi_size-1
         jj_nb_para(i)=(jjm+1)/mpi_size
-        if ( i < MOD((jjm+1),mpi_size) ) jj_nb_para(i)=jj_nb_para(i)+1
-        
-        if (jj_nb_para(i) <= 1 ) THEN
+        IF ( i < MOD((jjm+1),mpi_size) ) jj_nb_para(i)=jj_nb_para(i)+1
+        
+        IF (jj_nb_para(i) <= 1 ) THEN
          WRITE(lunout,*)"Arret : le nombre de bande de lattitude par process est trop faible (<2)."
          WRITE(lunout,*)" ---> diminuez le nombre de CPU ou augmentez la taille en lattitude"
@@ -172,5 +172,5 @@
       ij_end=jj_end*iip1
       
-      if (mpi_rank==0) THEN
+      IF (mpi_rank==0) THEN
         pole_nord=.TRUE.
       else 
@@ -178,5 +178,5 @@
       endif
       
-      if (mpi_rank==mpi_size-1) THEN
+      IF (mpi_rank==mpi_size-1) THEN
         pole_sud=.TRUE.
       else 
@@ -233,5 +233,5 @@
       CALL create_distrib(jj_nb_para,current_dist)
       
-      IF ((mpi_rank==0).and.(omp_rank==0)) THEN
+      IF ((mpi_rank==0).AND.(omp_rank==0)) THEN
         is_master=.TRUE.
       ELSE
@@ -379,15 +379,15 @@
     USE lmdz_mpi
     ! ug Pour les sorties XIOS
-  	USE wxios
+  	USE lmdz_wxios
 
 #ifdef CPP_COUPLE
 ! Use of Oasis-MCT coupler 
 #if defined CPP_OMCT
-    use mod_prism
+    USE mod_prism
 #else
-    use mod_prism_proto
+    USE mod_prism_proto
 #endif
 ! Ehouarn: surface_data module is in 'phylmd' ...
-      use surface_data, ONLY: type_ocean
+      USE surface_data, ONLY: type_ocean
       IMPLICIT NONE
 #else
@@ -403,9 +403,9 @@
       INTEGER :: i
 
-      if (allocated(jj_begin_para)) deallocate(jj_begin_para)
-      if (allocated(jj_end_para))   deallocate(jj_end_para)
-      if (allocated(jj_nb_para))    deallocate(jj_nb_para)
-
-      if (type_ocean == 'couple') THEN
+      IF (allocated(jj_begin_para)) deallocate(jj_begin_para)
+      IF (allocated(jj_end_para))   deallocate(jj_end_para)
+      IF (allocated(jj_nb_para))    deallocate(jj_nb_para)
+
+      IF (type_ocean == 'couple') THEN
 #ifdef CPP_COUPLE
         IF (using_xios) THEN
@@ -413,10 +413,10 @@
           CALL wxios_close()
           CALL prism_terminate_proto(ierr)
-          IF (ierr .ne. PRISM_Ok) THEN
+          IF (ierr .NE. PRISM_Ok) THEN
             CALL abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
           ENDIF
         ELSE
            CALL prism_terminate_proto(ierr)
-           IF (ierr .ne. PRISM_Ok) THEN
+           IF (ierr .NE. PRISM_Ok) THEN
               CALL abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
            endif
@@ -441,7 +441,7 @@
       INCLUDE "paramet.h"
 
-      integer, intent(in) :: ij,ll,row
-      real,dimension(ij,ll),intent(in) ::Field
-      real,dimension(ll*iip1*row), intent(out) :: Buffer 
+      INTEGER, INTENT(IN) :: ij,ll,row
+      REAL,DIMENSION(ij,ll),INTENT(IN) ::Field
+      REAL,DIMENSION(ll*iip1*row), INTENT(OUT) :: Buffer
             
       INTEGER :: Pos
@@ -464,7 +464,7 @@
       INCLUDE "paramet.h"
 
-      integer, intent(in) :: ij,ll,row
-      real,dimension(ij,ll),intent(out) ::Field
-      real,dimension(ll*iip1*row), intent(in) :: Buffer 
+      INTEGER, INTENT(IN) :: ij,ll,row
+      REAL,DIMENSION(ij,ll),INTENT(OUT) ::Field
+      REAL,DIMENSION(ll*iip1*row), INTENT(IN) :: Buffer
             
       INTEGER :: Pos
@@ -497,10 +497,10 @@
     SUBROUTINE exchange_hallo(Field,ij,ll,up,down)
     USE lmdz_mpi
-    USE Vampir
+    USE lmdz_vampir
     IMPLICIT NONE
       INCLUDE "dimensions.h"
       INCLUDE "paramet.h"    
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: up,down
       
@@ -512,6 +512,6 @@
 
       INTEGER :: NbRequest
-      REAL, dimension(:),allocatable :: Buffer_Send_up,Buffer_Send_down
-      REAL, dimension(:),allocatable :: Buffer_Recv_up,Buffer_Recv_down
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_Send_up,Buffer_Send_down
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_Recv_up,Buffer_Recv_down
       INTEGER :: Buffer_size      
 
@@ -537,10 +537,10 @@
         ENDIF
         
-        if (up==0) THEN
+        IF (up==0) THEN
           SendDown=.FALSE.
           RecvUp=.FALSE.
         endif
       
-        if (down==0) THEN
+        IF (down==0) THEN
           SendUp=.FALSE.
           RecvDown=.FALSE.
@@ -599,5 +599,5 @@
         ENDIF
   
-        if (NbRequest > 0) CALL MPI_WAITALL(NbRequest,Request,Status,ierr)
+        IF (NbRequest > 0) CALL MPI_WAITALL(NbRequest,Request,Status,ierr)
         IF (RecvUp)  CALL Unpack_Data(Field(ij_begin-up*iip1,1),ij,ll,up,Buffer_Recv_up)
         IF (RecvDown) CALL Unpack_Data(Field(ij_end+1,1),ij,ll,down,Buffer_Recv_down)
@@ -620,8 +620,8 @@
     INCLUDE "iniprint.h"
       INTEGER :: ij,ll,rank
-      REAL, dimension(ij,ll) :: Field
-      REAL, dimension(:),allocatable :: Buffer_send   
-      REAL, dimension(:),allocatable :: Buffer_Recv
-      INTEGER, dimension(0:MPI_Size-1) :: Recv_count, displ
+      REAL, DIMENSION(ij,ll) :: Field
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_send
+      REAL, DIMENSION(:),ALLOCATABLE :: Buffer_Recv
+      INTEGER, DIMENSION(0:MPI_Size-1) :: Recv_count, displ
       INTEGER :: ierr
       INTEGER ::i
@@ -629,8 +629,8 @@
       IF (using_mpi) THEN
 
-        if (ij==ip1jmp1) THEN
+        IF (ij==ip1jmp1) THEN
            allocate(Buffer_send(iip1*ll*(jj_end-jj_begin+1)))
            CALL Pack_Data(Field(ij_begin,1),ij,ll,jj_end-jj_begin+1,Buffer_send)
-        else if (ij==ip1jm) THEN
+        ELSE IF (ij==ip1jm) THEN
            allocate(Buffer_send(iip1*ll*(min(jj_end,jjm)-jj_begin+1)))
            CALL Pack_Data(Field(ij_begin,1),ij,ll,min(jj_end,jjm)-jj_begin+1,Buffer_send)
@@ -640,5 +640,5 @@
         endif
         
-        if (MPI_Rank==rank) THEN
+        IF (MPI_Rank==rank) THEN
           allocate(Buffer_Recv(ij*ll))
 
@@ -646,7 +646,7 @@
           do i=0,MPI_Size-1
              
-            if (ij==ip1jmp1) THEN
+            IF (ij==ip1jmp1) THEN
               Recv_count(i)=(jj_end_para(i)-jj_begin_para(i)+1)*ll*iip1
-            else if (ij==ip1jm) THEN
+            ELSE IF (ij==ip1jm) THEN
               Recv_count(i)=(min(jj_end_para(i),jjm)-jj_begin_para(i)+1)*ll*iip1
             else
@@ -654,5 +654,5 @@
             endif
                    
-            if (i==0) THEN
+            IF (i==0) THEN
               displ(i)=0 
             else
@@ -674,11 +674,11 @@
 !$OMP END CRITICAL (MPI)
       
-        if (MPI_Rank==rank) THEN
-          if (ij==ip1jmp1) THEN
+        IF (MPI_Rank==rank) THEN
+          IF (ij==ip1jmp1) THEN
             do i=0,MPI_Size-1
               CALL Unpack_Data(Field((jj_begin_para(i)-1)*iip1+1,1),ij,ll,                 &
                                jj_end_para(i)-jj_begin_para(i)+1,Buffer_Recv(displ(i)+1))
             enddo
-          else if (ij==ip1jm) THEN
+          ELSE IF (ij==ip1jm) THEN
             do i=0,MPI_Size-1
                CALL Unpack_Data(Field((jj_begin_para(i)-1)*iip1+1,1),ij,ll,                       &
@@ -698,5 +698,5 @@
     INCLUDE "paramet.h"    
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: ierr
       
@@ -716,5 +716,5 @@
     INCLUDE "paramet.h"    
       INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
+      REAL, DIMENSION(ij,ll) :: Field
       INTEGER :: rank
       INTEGER :: ierr
@@ -737,8 +737,8 @@
 
 !      INTEGER :: ij,ll
-!      REAL, dimension(ij,ll) :: Field
+!      REAL, DIMENSION(ij,ll) :: Field
 !      INTEGER :: up,down 
 
-!      REAL,dimension(ij,ll): NewField
+!      REAL,DIMENSION(ij,ll): NewField
 
 !      NewField=0
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/pression_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/pression_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/pression_loc.f90	(revision 5117)
@@ -29,6 +29,6 @@
   ije=ij_end+2*iip1
 
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90	(revision 5117)
@@ -6,6 +6,6 @@
   USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers, &
         isoCheck, min_qParent
-  USE strings_mod, ONLY: strIdx
-  USE readTracFiles_mod, ONLY: addPhase
+  USE lmdz_strings, ONLY: strIdx
+  USE lmdz_readTracFiles, ONLY: addPhase
   IMPLICIT none
   !
@@ -87,6 +87,6 @@
 !$OMP DO SCHEDULE(STATIC)
     DO i = ijb, ije
-      if (seuil_liq - q(i,k,iq_liq) > 0.d0 ) THEN
-        if (niso > 0) zx_defau_diag(i,k,2)=AMAX1 &
+      IF (seuil_liq - q(i,k,iq_liq) > 0.d0 ) THEN
+        IF (niso > 0) zx_defau_diag(i,k,2)=AMAX1 &
               ( seuil_liq - q(i,k,iq_liq), 0.0 )
 
@@ -108,6 +108,6 @@
     DO i = ijb, ije
 
-      if ( seuil_vap - q(i,k,iq_vap) > 0.d0 ) THEN
-        if (niso > 0) zx_defau_diag(i,k,1) &
+      IF ( seuil_vap - q(i,k,iq_vap) > 0.d0 ) THEN
+        IF (niso > 0) zx_defau_diag(i,k,1) &
               = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
 
@@ -148,5 +148,5 @@
 
   !WRITE(lunout,*) 'qminimum 128'
-  if (niso > 0) THEN
+  IF (niso > 0) THEN
           !WRITE(lunout,*) 'qminimum 140'
   ! CRisi: traiter de même les traceurs d'eau
@@ -164,5 +164,5 @@
 !$OMP DO SCHEDULE(STATIC)
   DO i = ijb, ije
-    if (zx_pump(i)>0.0) THEN
+    IF (zx_pump(i)>0.0) THEN
       q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
     endif !if (zx_pump(i).gt.0.0) THEN
@@ -175,9 +175,9 @@
 !$OMP DO SCHEDULE(STATIC)
     DO i = ijb, ije
-      if (zx_defau_diag(i,k,1)>0.0) THEN
+      IF (zx_defau_diag(i,k,1)>0.0) THEN
           ! on ajoute la vapeur en k
           !  WRITE(lunout,*) 'i,k,q_follow(i,k-1,ivap)=',
   ! :                 i,k,q_follow(i,k-1,1)
-          if (q_follow(i,k-1,1)<min_qParent) THEN
+          IF (q_follow(i,k-1,1)<min_qParent) THEN
             WRITE(lunout,*) 'tmp qmin: on stoppe'
             WRITE(lunout,*) 'zx_pump(i)=',zx_pump(i)
@@ -200,5 +200,5 @@
                  *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
 
-          if (isoCheck) THEN
+          IF (isoCheck) THEN
             IF(iso_verif_noNaN_nostop(q(i,k,iqIsoPha(ixt,iq_vap)), &
                   'qminimum 155')==1) THEN
@@ -224,6 +224,6 @@
                  /q_follow(i,k-1,1)
 
-           if (isoCheck) THEN
-            if (iso_verif_noNaN_nostop( &
+           IF (isoCheck) THEN
+            IF (iso_verif_noNaN_nostop( &
                   q(i,k-1,iqIsoPha(ixt,iq_vap)), &
                   'qminimum 175')==1) THEN
@@ -260,5 +260,5 @@
 !$OMP DO SCHEDULE(STATIC)
     DO i = ijb, ije
-      if (zx_defau_diag(i,k,2)>0.0) THEN
+      IF (zx_defau_diag(i,k,2)>0.0) THEN
           ! on ajoute eau liquide en k en k
           do ixt=1,ntiso
@@ -282,5 +282,5 @@
    CALL check_isotopes(q,ijb,ije,'qminimum 197')
 
-  endif !if (niso > 0) THEN
+  ENDIF !if (niso > 0) THEN
   !WRITE(*,*) 'qminimum 188'
 !$OMP BARRIER
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90	(revision 5117)
@@ -53,5 +53,5 @@
     jjb=jj_begin
     jje=jj_end
-    if (pole_sud) jje=jj_end-1
+    IF (pole_sud) jje=jj_end-1
     CALL filtreg_p( rot, jjb_v, jje_v,jjb,jje,jjm, &
           klevel, 2, 2, .FALSE., 1 )
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.f90	(revision 5117)
@@ -53,9 +53,9 @@
   !   ------
 
-  real,allocatable :: ucov_glo(:,:)
-  real,allocatable :: vcov_glo(:,:)
-  real,allocatable :: teta_glo(:,:)
-  real,allocatable :: masse_glo(:,:)
-  real,allocatable :: ps_glo(:)
+  REAL,ALLOCATABLE :: ucov_glo(:,:)
+  REAL,ALLOCATABLE :: vcov_glo(:,:)
+  REAL,ALLOCATABLE :: teta_glo(:,:)
+  REAL,ALLOCATABLE :: masse_glo(:,:)
+  REAL,ALLOCATABLE :: ps_glo(:)
 
    ! REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
@@ -65,9 +65,9 @@
    ! REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
 
-  real,allocatable :: p(:,:)
-  real,allocatable :: pks(:)
-  real,allocatable :: pk(:,:)
-  real,allocatable :: pkf(:,:)
-  real,allocatable :: alpha(:,:),beta(:,:)
+  REAL,ALLOCATABLE :: p(:,:)
+  REAL,ALLOCATABLE :: pks(:)
+  REAL,ALLOCATABLE :: pk(:,:)
+  REAL,ALLOCATABLE :: pkf(:,:)
+  REAL,ALLOCATABLE :: alpha(:,:),beta(:,:)
 
   REAL :: sinth,costh,costh2, Ath,Bth,Cth, lon,dps
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90	(revision 5117)
@@ -1,24 +1,24 @@
 module times
-  integer,PRIVATE,save :: Last_Count=0
-  real, PRIVATE,save :: Last_cpuCount=0
+  INTEGER,PRIVATE,save :: Last_Count=0
+  REAL, PRIVATE,save :: Last_cpuCount=0
   logical, PRIVATE,save :: AllTimer_IsActive=.FALSE.
   
-  integer, parameter :: nb_timer = 4
-  integer, parameter :: timer_caldyn  = 1
-  integer, parameter :: timer_vanleer = 2
-  integer, parameter :: timer_dissip = 3
-  integer, parameter :: timer_physic = 4
-  integer, parameter :: stopped = 1
-  integer, parameter :: running = 2
-  integer, parameter :: suspended = 3 
+  INTEGER, parameter :: nb_timer = 4
+  INTEGER, parameter :: timer_caldyn  = 1
+  INTEGER, parameter :: timer_vanleer = 2
+  INTEGER, parameter :: timer_dissip = 3
+  INTEGER, parameter :: timer_physic = 4
+  INTEGER, parameter :: stopped = 1
+  INTEGER, parameter :: running = 2
+  INTEGER, parameter :: suspended = 3
   
   INTEGER :: max_size
-  real,    allocatable, dimension(:,:,:) :: timer_table
-  real,    allocatable, dimension(:,:,:) :: timer_table_sqr 
-  integer, allocatable, dimension(:,:,:) :: timer_iteration
-  real,    allocatable, dimension(:,:,:) :: timer_average
-  real,    allocatable, dimension(:,:,:) :: timer_delta
-  real,    allocatable,dimension(:) :: timer_running, last_time
-  integer, allocatable,dimension(:) :: timer_state
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_table
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_table_sqr
+  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: timer_iteration
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_average
+  REAL,    ALLOCATABLE, DIMENSION(:,:,:) :: timer_delta
+  REAL,    ALLOCATABLE,DIMENSION(:) :: timer_running, last_time
+  INTEGER, ALLOCATABLE,DIMENSION(:) :: timer_state
   
   contains
@@ -52,6 +52,6 @@
     INTEGER :: no_timer
     
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=stopped) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=stopped) THEN
         CALL abort_gcm("times","start_timer :: timer is already running or suspended",1)
       else
@@ -70,6 +70,6 @@
     INTEGER :: no_timer
      
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=running) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=running) THEN
          CALL abort_gcm("times","suspend_timer :: timer is not running",1)
       else
@@ -87,6 +87,6 @@
     INTEGER :: no_timer
      
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=suspended) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=suspended) THEN
         CALL abort_gcm("times","resume_timer :: timer is not suspended",1)
       else
@@ -106,6 +106,6 @@
     REAL :: V,V2
     
-    if (AllTimer_IsActive) THEN
-      if (timer_state(no_timer)/=running) THEN
+    IF (AllTimer_IsActive) THEN
+      IF (timer_state(no_timer)/=running) THEN
         CALL abort_gcm("times","stop_timer :: timer is not running",1)
       else
@@ -121,5 +121,5 @@
       timer_iteration(jj_nb,no_timer,mpi_rank)=timer_iteration(jj_nb,no_timer,mpi_rank)+1
       timer_average(jj_nb,no_timer,mpi_rank)=timer_table(jj_nb,no_timer,mpi_rank)/timer_iteration(jj_nb,no_timer,mpi_rank)
-      if (timer_iteration(jj_nb,no_timer,mpi_rank)>=2) THEN
+      IF (timer_iteration(jj_nb,no_timer,mpi_rank)>=2) THEN
         N=timer_iteration(jj_nb,no_timer,mpi_rank)
 	V2=timer_table_sqr(jj_nb,no_timer,mpi_rank)
@@ -140,9 +140,9 @@
     INTEGER :: ierr
     INTEGER :: data_size
-    real, allocatable,dimension(:,:) :: tmp_table
+    REAL, ALLOCATABLE,DIMENSION(:,:) :: tmp_table
 
     IF (using_mpi) THEN    
    
-      if (AllTimer_IsActive) THEN
+      IF (AllTimer_IsActive) THEN
       allocate(tmp_table(max_size,nb_timer))
     
@@ -167,11 +167,11 @@
     INTEGER :: ierr
     INTEGER :: data_size
-    real, allocatable,dimension(:,:),target :: tmp_table
-    integer, allocatable,dimension(:,:),target :: tmp_iter
+    REAL, ALLOCATABLE,DIMENSION(:,:),target :: tmp_table
+    INTEGER, ALLOCATABLE,DIMENSION(:,:),target :: tmp_iter
     INTEGER :: istats
 
     IF (using_mpi) THEN
         
-      if (AllTimer_IsActive) THEN
+      IF (AllTimer_IsActive) THEN
       allocate(tmp_table(max_size,nb_timer))
       allocate(tmp_iter(max_size,nb_timer))
@@ -197,5 +197,5 @@
     
     AllTimer_IsActive=.TRUE.
-    if (AllTimer_IsActive) THEN
+    IF (AllTimer_IsActive) THEN
       CALL system_clock(count,count_rate,count_max)
       CALL cpu_time(Last_cpuCount)
@@ -210,5 +210,5 @@
   
     CALL system_clock(count,count_rate,count_max)
-    if (Count>=Last_Count) THEN
+    IF (Count>=Last_Count) THEN
       DiffTime=(1.*(Count-last_Count))/count_rate
     else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.f90	(revision 5117)
@@ -60,9 +60,9 @@
   !   ----------
 
-  real,intent(inout) :: ucov(iip1,jjb_u:jje_u,llm) ! covariant zonal wind
-  real,intent(inout) :: vcov(iip1,jjb_v:jje_v,llm) ! covariant meridional wind
-  real,intent(inout) :: teta(iip1,jjb_u:jje_u,llm) ! potential temperature
-  real,intent(in) :: masse(iip1,jjb_u:jje_u,llm) ! mass of atmosphere
-  real,intent(in) :: dt ! time step (s) of sponge model
+  REAL,INTENT(INOUT) :: ucov(iip1,jjb_u:jje_u,llm) ! covariant zonal wind
+  REAL,INTENT(INOUT) :: vcov(iip1,jjb_v:jje_v,llm) ! covariant meridional wind
+  REAL,INTENT(INOUT) :: teta(iip1,jjb_u:jje_u,llm) ! potential temperature
+  REAL,INTENT(IN) :: masse(iip1,jjb_u:jje_u,llm) ! mass of atmosphere
+  REAL,INTENT(IN) :: dt ! time step (s) of sponge model
 
    ! REAL dv(iip1,jjb_v:jje_v,llm),du(iip1,jjb_u:jje_u,llm)
@@ -78,15 +78,15 @@
   INTEGER :: i
   REAL,SAVE :: rdamp(llm)
-  real,save :: lambda(llm) ! inverse or quenching time scale (Hz)
+  REAL,save :: lambda(llm) ! inverse or quenching time scale (Hz)
   LOGICAL,SAVE :: first=.TRUE.
   INTEGER :: j,l,jjb,jje
 
 
-  if (iflag_top_bound == 0) return
-
-  if (first) THEN
+  IF (iflag_top_bound == 0) return
+
+  IF (first) THEN
 !$OMP BARRIER
 !$OMP MASTER
-     if (iflag_top_bound == 1) THEN
+     IF (iflag_top_bound == 1) THEN
   ! sponge quenching over the topmost 4 atmospheric layers
          lambda(:)=0.
@@ -95,5 +95,5 @@
          lambda(llm-2)=tau_top_bound/4.
          lambda(llm-3)=tau_top_bound/8.
-     else if (iflag_top_bound == 2) THEN
+     ELSE IF (iflag_top_bound == 2) THEN
   ! sponge quenching over topmost layers down to pressures which are
   ! higher than 100 times the topmost layer pressure
@@ -110,5 +110,5 @@
      WRITE(lunout,*)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
      do l=1,llm
-       if (rdamp(l)/=0.) THEN
+       IF (rdamp(l)/=0.) THEN
          WRITE(lunout,'(6(1pe12.4,1x))') &
                presnivs(l),log(preff/presnivs(l))*scaleheight, &
@@ -119,5 +119,5 @@
 !$OMP END MASTER
 !$OMP BARRIER
-  endif ! of if (first)
+  ENDIF ! of if (first)
 
 
@@ -125,5 +125,5 @@
 
   ! compute zonal average of vcov (or set it to zero)
-  if (mode_top_bound>=2) THEN
+  IF (mode_top_bound>=2) THEN
    jjb=jj_begin
    jje=jj_end
@@ -150,8 +150,8 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.2)
+  ENDIF ! of if (mode_top_bound.ge.2)
 
   ! compute zonal average of u (or set it to zero)
-  if (mode_top_bound>=2) THEN
+  IF (mode_top_bound>=2) THEN
    jjb=jj_begin
    jje=jj_end
@@ -177,8 +177,8 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.2)
+  ENDIF ! of if (mode_top_bound.ge.2)
 
   ! compute zonal average of potential temperature, if necessary
-  if (mode_top_bound>=3) THEN
+  IF (mode_top_bound>=3) THEN
    jjb=jj_begin
    jje=jj_end
@@ -198,7 +198,7 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.3)
-
-  if (mode_top_bound>=1) THEN
+  ENDIF ! of if (mode_top_bound.ge.3)
+
+  IF (mode_top_bound>=1) THEN
    ! Apply sponge quenching on vcov:
    jjb=jj_begin
@@ -233,7 +233,7 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bound.ge.1)
-
-  if (mode_top_bound>=3) THEN
+  ENDIF ! of if (mode_top_bound.ge.1)
+
+  IF (mode_top_bound>=3) THEN
    ! Apply sponge quenching on teta:
    jjb=jj_begin
@@ -252,5 +252,5 @@
    enddo
 !$OMP END DO NOWAIT
-  endif ! of if (mode_top_bond.ge.3)
+  ENDIF ! of if (mode_top_bond.ge.3)
 
 END SUBROUTINE top_bound_loc
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.f90	(revision 5117)
@@ -60,6 +60,6 @@
   ije = ije_x
 
-  if (pole_nord.and.ijb==1) ijb = ijb + iip1
-  if (pole_sud.and.ije==ip1jmp1)  ije = ije - iip1
+  IF (pole_nord.AND.ijb==1) ijb = ijb + iip1
+  IF (pole_sud.AND.ije==ip1jmp1)  ije = ije - iip1
 
   IF (pente_max>-1.e-5) THEN
@@ -238,5 +238,5 @@
       !   indicage des mailles concernees par le traitement special
       DO ij = ijb, ije
-        IF(iadvplus(ij, l)==1.and.mod(ij, iip1)/=0) THEN
+        IF(iadvplus(ij, l)==1.AND.mod(ij, iip1)/=0) THEN
           iju = iju + 1
           indu(iju) = ij
@@ -313,5 +313,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masse(ij, l, iq2) = max(masse(ij, l, iq) * q(ij, l, iq), min_qMass)
-        if (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij, l, iq2) = q(ij, l, iq2) / q(ij, l, iq)
         else
@@ -440,6 +440,6 @@
   ijb = ij_begin - 2 * iip1
   ije = ij_end + 2 * iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end
 
   IF(first) THEN
@@ -474,5 +474,5 @@
     !    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
 
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       DO i = 1, iim
         airescb(i) = aire(i + iip1) * q(i + iip1, l, iq)
@@ -481,5 +481,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       DO i = 1, iim
         airesch(i) = aire(i + ip1jm - iip1) * q(i + ip1jm - iip1, l, iq)
@@ -492,6 +492,6 @@
     ijb = ij_begin - 2 * iip1
     ije = ij_end + iip1
-    if (pole_nord) ijb = ij_begin
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_nord) ijb = ij_begin
+    IF (pole_sud)  ije = ij_end - iip1
 
     ! on a besoin de q entre ij_begin-2*iip1 et ij_end+2*iip1
@@ -507,6 +507,6 @@
     ijb = ij_begin - iip1
     ije = ij_end + iip1
-    if (pole_nord) ijb = ij_begin + iip1
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_nord) ijb = ij_begin + iip1
+    IF (pole_sud)  ije = ij_end - iip1
 
     DO ij = ijb, ije
@@ -654,6 +654,6 @@
     ijb = ij_begin - iip1
     ije = ij_end + iip1
-    if (pole_nord) ijb = ij_begin + iip1
-    if (pole_sud)  ije = ij_end - iip1
+    IF (pole_nord) ijb = ij_begin + iip1
+    IF (pole_sud)  ije = ij_end - iip1
 
     DO ij = ijb, ije
@@ -670,6 +670,6 @@
   ijb = ij_begin - iip1
   ije = ij_end
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -697,8 +697,8 @@
   ijbm = ij_begin - iip1
   ijem = ij_end + iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end
-  if (pole_nord) ijbm = ij_begin
-  if (pole_sud)  ijem = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end
+  IF (pole_nord) ijbm = ij_begin
+  IF (pole_sud)  ijem = ij_end
 
   do ifils = 1, tracers(iq)%nqDescen
@@ -716,5 +716,5 @@
       DO ij = ijb, ije
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
-        if (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij, l, iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij, l, iq2) = q(ij, l, iq2) / q(ij, l, iq)
         else
@@ -734,6 +734,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ij_begin + iip1
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_nord) ijb = ij_begin + iip1
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -750,5 +750,5 @@
     ENDDO
 
-    if (pole_nord) THEN
+    IF (pole_nord) THEN
       convpn = SSUM(iim, qbyv(1, l), 1)
       convmpn = ssum(iim, masse_adv_v(1, l), 1)
@@ -764,5 +764,5 @@
     endif
 
-    if (pole_sud) THEN
+    IF (pole_sud) THEN
       convps = -SSUM(iim, qbyv(ip1jm - iim, l), 1)
       convmps = -ssum(iim, masse_adv_v(ip1jm - iim, l), 1)
@@ -1014,5 +1014,5 @@
             ! CRisi 24nov2020: ajout d'un message d'erreur clair au lieu d'un plantage
             ! pour seg fault
-            if (lorig(ij, l)==0) THEN
+            IF (lorig(ij, l)==0) THEN
               CALL abort_gcm("vlz in vlsplt_loc", &
                       "unfixable violation of CFL", 1)
@@ -1065,5 +1065,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masse(ij, l, iq2) = max(masse(ij, l, iq) * q(ij, l, iq), min_qMass)
-        if (q(ij, l, iq)>min_qParent) THEN
+        IF (q(ij, l, iq)>min_qParent) THEN
           Ratio(ij, l, iq2) = q(ij, l, iq2) / q(ij, l, iq)
         else
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90	(revision 5117)
@@ -25,5 +25,5 @@
   USE mod_hallo
   USE write_field_loc, ONLY: WriteField_u, WriteField_v
-  USE VAMPIR
+  USE lmdz_vampir
   ! CRisi: on rajoute variables utiles d'infotrac
   USE infotrac, ONLY: nqtot, tracers, isoCheck
@@ -97,6 +97,6 @@
   ijb = ij_begin - iip1
   ije = ij_end + iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud) ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud) ije = ij_end
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -124,6 +124,6 @@
   ijb = ij_begin
   ije = ij_end
-  if (pole_nord) ijb = ijb + iip1
-  if (pole_sud)  ije = ije - iip1
+  IF (pole_nord) ijb = ijb + iip1
+  IF (pole_sud)  ije = ije - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -137,6 +137,6 @@
   ijb = ij_begin - iip1
   ije = ij_end
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end - iip1
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end - iip1
 
   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -253,6 +253,6 @@
   ijb = ij_begin - 2 * iip1
   ije = ij_end + 2 * iip1
-  if (pole_nord) ijb = ij_begin
-  if (pole_sud)  ije = ij_end
+  IF (pole_nord) ijb = ij_begin
+  IF (pole_sud)  ije = ij_end
   CALL check_isotopes(zq, ij_begin, ij_end, 'vlspltgen_loc 280')
 
@@ -290,6 +290,6 @@
     ijb = ij_begin - 2 * iip1
     ije = ij_end + 2 * iip1
-    if (pole_nord) ijb = ij_begin
-    if (pole_sud)  ije = ij_end
+    IF (pole_nord) ijb = ij_begin
+    IF (pole_sud)  ije = ij_end
     CALL check_isotopes(zq, ijb, ije, 'vlspltgen_loc 336')
   END IF
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.f90	(revision 5117)
@@ -59,6 +59,6 @@
   ije=ije_x
 
-  if (pole_nord.and.ijb==1) ijb=ijb+iip1
-  if (pole_sud.and.ije==ip1jmp1)  ije=ije-iip1
+  IF (pole_nord.AND.ijb==1) ijb=ijb+iip1
+  IF (pole_sud.AND.ije==ip1jmp1)  ije=ije-iip1
 
   IF (pente_max>-1.e-5) THEN
@@ -157,5 +157,5 @@
 !$OMP END DO NOWAIT
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,llm
@@ -163,7 +163,7 @@
     ENDDO
 !$OMP END DO NOWAIT
-  endif
-
-  if (pole_sud)  THEN
+  ENDIF
+
+  IF (pole_sud)  THEN
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     DO l=1,llm
@@ -171,5 +171,5 @@
     ENDDO
 !$OMP END DO NOWAIT
-  endif
+  ENDIF
 
   !   calcul des flux a gauche et a droite
@@ -247,5 +247,5 @@
   !   indicage des mailles concernees par le traitement special
            DO ij=ijb,ije
-              IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN
+              IF(iadvplus(ij,l)==1.AND.mod(ij,iip1)/=0) THEN
                  iju=iju+1
                  indu(iju)=ij
@@ -319,5 +319,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
-        if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
         else
@@ -448,12 +448,12 @@
   ijb=ij_begin-2*iip1
   ije=ij_end+2*iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
   ij=3525
   l=3
-  if ((ij>=ijb).and.(ij<=ije)) THEN
+  IF ((ij>=ijb).AND.(ij<=ije)) THEN
     !WRITE(*,*) 'vlyqs 480: ij,l,iq,ijb,q(ij,l,:)=',
   ! &             ij,l,iq,ijb,q(ij,l,:)
-  endif
+  ENDIF
 
   IF(first) THEN
@@ -488,17 +488,17 @@
   !    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
 
-  if (pole_nord) THEN
+  IF (pole_nord) THEN
     DO i = 1, iim
       airescb(i) = aire(i+ iip1) * q(i+ iip1,l,iq)
     ENDDO
     qpns   = SSUM( iim,  airescb ,1 ) / airej2
-  endif
-
-  if (pole_sud) THEN
+  ENDIF
+
+  IF (pole_sud) THEN
     DO i = 1, iim
       airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l,iq)
     ENDDO
     qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
-  endif
+  ENDIF
 
 
@@ -507,6 +507,6 @@
   ijb=ij_begin-2*iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij=ijb,ije
@@ -520,6 +520,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij=ijb,ije
@@ -664,6 +664,6 @@
   ijb=ij_begin-iip1
   ije=ij_end+iip1
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
   DO ij=ijb,ije
@@ -680,6 +680,6 @@
   ijb=ij_begin-iip1
   ije=ij_end
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -708,8 +708,8 @@
   ijbm=ij_begin-iip1
   ijem=ij_end+iip1
-  if (pole_nord) ijb=ij_begin
-  if (pole_sud)  ije=ij_end
-  if (pole_nord) ijbm=ij_begin
-  if (pole_sud)  ijem=ij_end
+  IF (pole_nord) ijb=ij_begin
+  IF (pole_sud)  ije=ij_end
+  IF (pole_nord) ijbm=ij_begin
+  IF (pole_sud)  ijem=ij_end
 
   !WRITE(lunout,*) 'vlspltqs 737: iq,ijb,ije=',iq,ijb,ije
@@ -731,5 +731,5 @@
         !MVals: veiller a ce qu'on n'ait pas de denominateur nul
         !WRITE(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq)
-        if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
+        IF (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
         else
@@ -751,6 +751,6 @@
   ijb=ij_begin
   ije=ij_end
-  if (pole_nord) ijb=ij_begin+iip1
-  if (pole_sud)  ije=ij_end-iip1
+  IF (pole_nord) ijb=ij_begin+iip1
+  IF (pole_sud)  ije=ij_end-iip1
 
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90	(revision 5117)
@@ -24,5 +24,5 @@
   INTEGER :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
 
-  logical :: writectl
+  LOGICAL :: writectl
 
   writectl = .FALSE.
@@ -63,5 +63,5 @@
   else
     ivar(if) = mod(ivar(if), nvar(if)) + 1
-    if (ivar(if)==nvar(if)) THEN
+    IF (ivar(if)==nvar(if)) THEN
       writectl = .TRUE.
       itime(if) = itime(if) + 1
@@ -77,5 +77,5 @@
       CALL abort_gcm("wrgrads", "problem", 1)
     endif
-  endif
+  ENDIF
 
   PRINT*, 'ivar(if),nvar(if),var(ivar(if),if),writectl'
@@ -90,5 +90,5 @@
                     , i = iii, iif), j = iji, ijf)
   enddo
-  if (writectl) THEN
+  IF (writectl) THEN
     file = fichier(if)
     !   WARNING! on reecrase le fichier .ctl a chaque ecriture
@@ -118,5 +118,5 @@
     close(unit(if))
 
-  endif ! writectl
+  ENDIF ! writectl
 
 END SUBROUTINE wrgrads
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90	(revision 5117)
@@ -14,5 +14,5 @@
   SUBROUTINE write_field1D_u(name,Field)
     CHARACTER(LEN=*)   :: name
-    real, dimension(:) :: Field
+    REAL, DIMENSION(:) :: Field
 
     CALL write_field_u_gen(name,Field,1)
@@ -24,5 +24,5 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:) :: Field
+    REAL, DIMENSION(:,:) :: Field
     INTEGER :: ll
     
@@ -35,5 +35,5 @@
    SUBROUTINE write_field_u_gen(name,Field,ll)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     USE mod_hallo
     IMPLICIT NONE
@@ -42,7 +42,7 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(ijb_u:ije_u,ll) :: Field
-    real, allocatable,SAVE :: New_Field(:,:,:)
-    integer,dimension(0:mpi_size-1) :: jj_nb_master
+    REAL, DIMENSION(ijb_u:ije_u,ll) :: Field
+    REAL, ALLOCATABLE,SAVE :: New_Field(:,:,:)
+    INTEGER,DIMENSION(0:mpi_size-1) :: jj_nb_master
     type(Request),SAVE :: Request_write
 !$OMP THREADPRIVATE(Request_write)
@@ -70,5 +70,5 @@
 
 !$OMP MASTER
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     DEALLOCATE(New_Field)
 !$OMP END MASTER        
@@ -79,5 +79,5 @@
   SUBROUTINE write_field1D_v(name,Field)
     CHARACTER(LEN=*)   :: name
-    real, dimension(:) :: Field
+    REAL, DIMENSION(:) :: Field
 
     CALL write_field_v_gen(name,Field,1)
@@ -89,5 +89,5 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:) :: Field
+    REAL, DIMENSION(:,:) :: Field
     INTEGER :: ll
     
@@ -100,5 +100,5 @@
    SUBROUTINE write_field_v_gen(name,Field,ll)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     USE mod_hallo
     IMPLICIT NONE
@@ -107,7 +107,7 @@
       
     CHARACTER(LEN=*)   :: name
-    real, dimension(ijb_v:ije_v,ll) :: Field
-    real, allocatable,SAVE :: New_Field(:,:,:)
-    integer,dimension(0:mpi_size-1) :: jj_nb_master
+    REAL, DIMENSION(ijb_v:ije_v,ll) :: Field
+    REAL, ALLOCATABLE,SAVE :: New_Field(:,:,:)
+    INTEGER,DIMENSION(0:mpi_size-1) :: jj_nb_master
     type(Request),SAVE :: Request_write
 !$OMP THREADPRIVATE(Request_write)    
@@ -146,5 +146,5 @@
 
 !$OMP MASTER
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     DEALLOCATE(New_Field)
 !$OMP END MASTER        
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90	(revision 5117)
@@ -10,12 +10,12 @@
   SUBROUTINE write_field1D_p(name,Field)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     IMPLICIT NONE
   
-    integer, parameter :: MaxDim=1
+    INTEGER, parameter :: MaxDim=1
     CHARACTER(LEN=*)   :: name
-    real, dimension(:) :: Field
-    real, dimension(:),allocatable :: New_Field
-    integer, dimension(MaxDim) :: Dim
+    REAL, DIMENSION(:) :: Field
+    REAL, DIMENSION(:),ALLOCATABLE :: New_Field
+    INTEGER, DIMENSION(MaxDim) :: Dim
     
     
@@ -25,5 +25,5 @@
     CALL Gather_Field(New_Field,dim(1),1,0)
     
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     
     END SUBROUTINE  write_field1D_p
@@ -31,12 +31,12 @@
   SUBROUTINE write_field2D_p(name,Field)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     IMPLICIT NONE
   
-    integer, parameter :: MaxDim=2
+    INTEGER, parameter :: MaxDim=2
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:) :: Field
-    real, dimension(:,:),allocatable :: New_Field
-    integer, dimension(MaxDim) :: Dim
+    REAL, DIMENSION(:,:) :: Field
+    REAL, DIMENSION(:,:),ALLOCATABLE :: New_Field
+    INTEGER, DIMENSION(MaxDim) :: Dim
     
     Dim=shape(Field)
@@ -45,5 +45,5 @@
     CALL Gather_Field(New_Field(1,1),dim(1)*dim(2),1,0)
     
-    if (MPI_Rank==0) CALL WriteField(name,New_Field)
+    IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     
      
@@ -52,12 +52,12 @@
   SUBROUTINE write_field3D_p(name,Field)
     USE parallel_lmdz
-    USE write_field
+    USE lmdz_write_field
     IMPLICIT NONE
   
-    integer, parameter :: MaxDim=3
+    INTEGER, parameter :: MaxDim=3
     CHARACTER(LEN=*)   :: name
-    real, dimension(:,:,:) :: Field
-    real, dimension(:,:,:),allocatable :: New_Field
-    integer, dimension(MaxDim) :: Dim
+    REAL, DIMENSION(:,:,:) :: Field
+    REAL, DIMENSION(:,:,:),ALLOCATABLE :: New_Field
+    INTEGER, DIMENSION(MaxDim) :: Dim
     
     Dim=shape(Field)
@@ -66,5 +66,5 @@
     CALL Gather_Field(New_Field(1,1,1),dim(1)*dim(2),dim(3),0)
     
-   if (MPI_Rank==0) CALL WriteField(name,New_Field)
+   IF (MPI_Rank==0) CALL WriteField(name,New_Field)
     
   END SUBROUTINE  write_field3D_p
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90	(revision 5117)
@@ -8,5 +8,5 @@
   USE misc_mod
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
+  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
@@ -47,5 +47,5 @@
   REAL phis(ijb_u:ije_u)
   REAL q(ijb_u:ije_u, llm, nqtot)
-  integer time
+  INTEGER time
 
 
@@ -57,6 +57,6 @@
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
   REAL, SAVE, ALLOCATABLE :: vbuffer(:, :)
-  logical ok_sync
-  integer itau_w
+  LOGICAL ok_sync
+  INTEGER itau_w
   INTEGER :: ijb, ije, jjn
   LOGICAL, SAVE :: first = .TRUE.
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90	(revision 5117)
@@ -9,5 +9,5 @@
   USE misc_mod
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
+  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
@@ -67,5 +67,5 @@
   REAL, SAVE, ALLOCATABLE :: tm(:, :)
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   INTEGER :: itau_w
   INTEGER :: ijb, ije, jjn
@@ -76,5 +76,5 @@
   !  Initialisations
   !
-  if (adjust) return
+  IF (adjust) return
 
   IF (first) THEN
@@ -121,6 +121,6 @@
   !
   ije = ij_end
-  if (pole_sud) jjn = jj_nb - 1
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) ije = ij_end - iip1
   !$OMP BARRIER
   !$OMP MASTER
@@ -209,5 +209,5 @@
   !
   !$OMP MASTER
-  if (ok_sync) THEN
+  IF (ok_sync) THEN
     CALL histsync(histaveid)
     CALL histsync(histvaveid)
Index: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90	(revision 5116)
+++ LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90	(revision 5117)
@@ -6,5 +6,5 @@
   USE misc_mod
   USE infotrac, ONLY: nqtot
-  use com_io_dyn_mod, ONLY: histid, histvid, histuid
+  USE com_io_dyn_mod, ONLY: histid, histvid, histuid
   USE comconst_mod, ONLY: cpp
   USE temps_mod, ONLY: itau_dyn
@@ -64,5 +64,5 @@
   REAL, SAVE, ALLOCATABLE :: tm(:, :)
   REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
-  logical :: ok_sync
+  LOGICAL :: ok_sync
   INTEGER :: itau_w
   INTEGER :: ijb, ije, jjn
@@ -73,5 +73,5 @@
   !  Initialisations
   !
-  if (adjust) return
+  IF (adjust) return
 
   IF (first) THEN
@@ -118,6 +118,6 @@
   !
   ije = ij_end
-  if (pole_sud) jjn = jj_nb - 1
-  if (pole_sud) ije = ij_end - iip1
+  IF (pole_sud) jjn = jj_nb - 1
+  IF (pole_sud) ije = ij_end - iip1
   !$OMP BARRIER
   !$OMP MASTER
@@ -205,9 +205,9 @@
   !
   !$OMP MASTER
-  if (ok_sync) THEN
+  IF (ok_sync) THEN
     CALL histsync(histid)
     CALL histsync(histvid)
     CALL histsync(histuid)
-  endif
+  ENDIF
   !$OMP END MASTER
 END SUBROUTINE writehist_loc
