Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90	(revision 5158)
@@ -256,7 +256,7 @@
  
 
-  do k=1,klon
+  DO k=1,klon
       maskdustloc(k)=0
-      do i=1,ntyp
+      DO i=1,ntyp
          IF (masklisa(k,i)>0) THEN
              maskdustloc(k)=1
@@ -358,5 +358,5 @@
   auxr3=9999.
   auxr4=9999.
-  do i=1,nbins+1
+  DO i=1,nbins+1
    IF (abs(sizeacclow-itv(i))<auxr1) THEN
           auxr1=abs( sizeacclow-itv(i))
@@ -380,6 +380,6 @@
 IF (writeaerosoldistrib) THEN
 !JEdbg<<
-  do j=1,klon
-  do i=1,nbins
+  DO j=1,klon
+  DO i=1,nbins
     itvmean(j,i)=(itv(i)+itv(i+1))/2.
     itv2(j,i)=itv(i)
@@ -405,6 +405,6 @@
   ALLOCATE(emisbinlocalmean(klon,nbins))
   ALLOCATE(emisbinlocalmean2(klon,nbins))
-  do i=1,nbins
-    do j=1,klon
+  DO i=1,nbins
+    DO j=1,klon
        emisbinlocalmean(j,i)=0.0
        emisbinlocalmean2(j,i)=0.0
@@ -433,13 +433,13 @@
 auxr2=0.0
 auxr3=0.0
-  do i=iminacclow,iminacchigh-1
+  DO i=iminacclow,iminacchigh-1
    auxr1=auxr1+emisbinlocal(k,i)
   enddo
   emdustacc(k)=(auxr1 + basesumacc(k))*tuningfactorfine
-  do i=imincoalow,imincoahigh-1
+  DO i=imincoalow,imincoahigh-1
     auxr2=auxr2+emisbinlocal(k,i)
   enddo
   emdustcoa(k)=(auxr2 + basesumcoa(k))*tuningfactorcoa
-  do i=iminscolow,iminscohigh-1
+  DO i=iminscolow,iminscohigh-1
     auxr3=auxr3+emisbinlocal(k,i)
   enddo
@@ -468,6 +468,6 @@
 !JEdbg<<
 IF (writeaerosoldistrib) THEN
-  do i=1,nbins
-    do j=1,klon
+  DO i=1,nbins
+    DO j=1,klon
         emisbinlocalmean(j,i)=emisbinlocalmean(j,i)+emisbinlocal(j,i)
     enddo 
@@ -479,6 +479,6 @@
 IF (MOD(counter,1440)== 0) THEN
    !if (MOD(counter,480).EQ. 0) THEN
-   do k = 1,klon
-   do i=1,nbins
+   DO k = 1,klon
+   DO i=1,nbins
      emisbinlocalmean2(k,i)=emisbinlocalmean(k,i)/float(counter1)
    enddo
@@ -493,6 +493,6 @@
 !!$OMP END MASTER
 !!$OMP BARRIER
-   do i=1,nbins
-     do j=1,klon
+   DO i=1,nbins
+     DO j=1,klon
         emisbinlocalmean(j,i)=0.0
      enddo
@@ -751,5 +751,5 @@
       dstep=0.0005
       dp=dmin
-      do i=1,nclass
+      DO i=1,nclass
          dp=dp*exp(dstep)
          sizeclass(i)=dp
@@ -770,5 +770,5 @@
 !c 0: Iversen and White 1982
        print *,'Using  Iversen and White 1982 Uth'
-         do i=1,ncl
+         DO i=1,ncl
             bb=adust*(sizeclass(i)**xdust)+bdust
             cc=sqrt(1+ddust*(sizeclass(i)**(-2.5)))
@@ -789,5 +789,5 @@
             an=0.0123
             gam=0.3
-            do i=1,ncl
+            DO i=1,ncl
                sigshao=rop/roa
                x1=sigshao*gravity*sizeclass(i)
@@ -845,6 +845,6 @@
   !wind friction velocity.
       !    feff(:,:)=0.
-       do i=1,klon
-          do k=1,ntyp
+       DO i=1,klon
+          DO k=1,ntyp
      !     PRINT*,'IKKK ',i,klon,k,ntyp
              IF (zos(i,k)==0..or.z01(i,k)==0.) THEN
@@ -887,6 +887,6 @@
   IF (flag_feff == 0) THEN
     print *,'JE_dbg FORCED deactivated feff'
-    do i=1,klon
-      do k=1,ntyp
+    DO i=1,klon
+      DO k=1,ntyp
         feff(i,k)=1.
       enddo
@@ -1273,5 +1273,5 @@
 
 !                  CALL def_ag01(kfin,ft1,ft2,ft3)
-      do ni=1,kfin
+      DO ni=1,kfin
          fdp1=1.-(uth2(ni)/(ceff*ustarsalt))
          IF (fdp1<=0..or.srel2(nat,ni)==0.) THEN
@@ -1388,5 +1388,5 @@
 ! readaptation of large sizes particles
          kfin=0
-         do i=ideb,ifin
+         DO i=ideb,ifin
             kfin=kfin+1
             sizeclass2(kfin)=sizeclass(i)
@@ -1397,5 +1397,5 @@
          kfin2=kfin
          istep=50
-         do i=ifin,ncl,istep
+         DO i=ifin,ncl,istep
             kfin=kfin+1
             sizeclass2(kfin)=sizeclass(i)
@@ -1433,5 +1433,5 @@
       ismax=i2
       ihalf=int((ismax+ismin)/2.)
-      do k2=1,1000000
+      DO k2=1,1000000
           IF(ds>siz(ihalf))THEN
              ismin=ihalf
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90	(revision 5158)
@@ -4,4 +4,7 @@
   USE infotrac
   USE lmdz_libmath, ONLY: ismax, ismin
+
+  IMPLICIT NONE
+
   INCLUDE "dimensions.h"
 
@@ -9,4 +12,5 @@
   CHARACTER(LEN = *) :: comment
   REAL :: qmin, qmax
+  REAL :: zqmin, zqmax
   REAL :: zq(klon, klev)
 
@@ -24,7 +28,5 @@
   zqmax = zq(ijmax, lmax)
 
-  IF(zqmin<qmin.OR.zqmax>qmax) &
-          WRITE(*, 9999) comment, &
-                  ijmin, lmin, zqmin, ijmax, lmax, zqmax
+  IF(zqmin<qmin.OR.zqmax>qmax) WRITE(*, 9999) comment, ijmin, lmin, zqmin, ijmax, lmax, zqmax
 
   RETURN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90	(revision 5158)
@@ -5,4 +5,6 @@
   USE lmdz_libmath, ONLY: ismax, ismin
 
+  IMPLICIT NONE
+
   INCLUDE "dimensions.h"
 
@@ -10,4 +12,5 @@
   CHARACTER(LEN = *) :: comment
   REAL :: qmin, qmax
+  REAL :: zqmin, zqmax
   REAL :: zq(klon, nbtr)
 
@@ -25,7 +28,5 @@
   zqmax = zq(ijmax, lmax)
 
-  IF(zqmin<qmin.OR.zqmax>qmax) &
-          WRITE(*, 9999) comment, &
-                  ijmin, lmin, zqmin, ijmax, lmax, zqmax
+  IF(zqmin<qmin.OR.zqmax>qmax) WRITE(*, 9999) comment, ijmin, lmin, zqmin, ijmax, lmax, zqmax
 
   RETURN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/neutral.f90	(revision 5158)
@@ -41,5 +41,5 @@
 
   psi = 0.
-  do i = 1, klon
+  DO i = 1, klon
 
     IF (u10_mps(i) < 0.) u10_mps(i) = 0.0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90	(revision 5158)
@@ -1343,7 +1343,7 @@
 
     !JE_dbg
-    do i = 1, klon
+    DO i = 1, klon
       tsol(i) = 0.0
-      do j = 1, nbsrf
+      DO j = 1, nbsrf
         tsol(i) = tsol(i) + ftsol(i, j) * pctsrf(i, j)
       enddo
@@ -1382,5 +1382,5 @@
       id_scdu = -1
       itr = 0
-      do iq = 1, nqtot
+      DO iq = 1, nqtot
         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
         itr = itr + 1
@@ -1941,5 +1941,5 @@
       !$OMP END MASTER
       !$OMP BARRIER
-      do i = 1, klon
+      DO i = 1, klon
         aux_var2(i) = pctsrf(i, is_oce)
       enddo
@@ -1954,5 +1954,5 @@
       !$OMP BARRIER
 
-      do i = 1, klon
+      DO i = 1, klon
         aux_var2(i) = pctsrf(i, is_sic)
       enddo
@@ -1967,5 +1967,5 @@
       !$OMP BARRIER
 
-      do i = 1, klon
+      DO i = 1, klon
         aux_var2(i) = pctsrf(i, is_ter)
       enddo
@@ -1980,5 +1980,5 @@
       !$OMP BARRIER
 
-      do i = 1, klon
+      DO i = 1, klon
         aux_var2(i) = pctsrf(i, is_lic)
       enddo
@@ -2066,10 +2066,10 @@
     !     .                                         MAXVAL(tr_seri(:,:,3))
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,itr))
          CALL iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,itr))
       enddo
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -2099,5 +2099,5 @@
 
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,itr))
@@ -2196,5 +2196,5 @@
 #ifdef IOPHYS_DUST
 
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,itr))
@@ -2240,5 +2240,5 @@
 
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,itr))
@@ -2296,5 +2296,5 @@
 
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -2336,5 +2336,5 @@
 
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -2410,5 +2410,5 @@
       CALL iophys_ecrit('yv1',1,'yv1','',yv1)
       CALL iophys_ecrit('delp',klev,'delp','',delp)
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -2602,5 +2602,5 @@
     !=======================================================================
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -2689,5 +2689,5 @@
 
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -2854,5 +2854,5 @@
 
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -3053,5 +3053,5 @@
       CALL iophys_ecrit('wdtrainM',klev,'wdtrainM','',wdtrainM)
 
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -3174,5 +3174,5 @@
     !=======================================================================
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -3440,5 +3440,5 @@
     !======================================================================
 #ifdef IOPHYS_DUST
-      do itr=1,nbtr
+      DO itr=1,nbtr
          WRITE(str2,'(i2.2)') itr
          CALL iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
@@ -4306,5 +4306,5 @@
     IF (is_mpi_root .AND. is_omp_root) THEN
       OPEN(1, file = trim(adjustl(filescaleparams)), form = 'unformatted')
-      do k = 1, nbreg
+      DO k = 1, nbreg
         read(1)  scale_param(k)
       enddo
@@ -4454,5 +4454,5 @@
       ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
       IF (ierr == nf90_noerr) THEN
-        do i = 1, nbreg
+        DO i = 1, nbreg
           WRITE(aux_2s, '(i2.2)') i
           varname = trim(adjustl(paramname)) // aux_2s
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90	(revision 5158)
@@ -52,5 +52,5 @@
       latstr='null'
       isinversed=.FALSE.
-      do i=1,5
+      DO i=1,5
        IF (i==1) aux4s='latu'
        IF (i==2) aux4s='LATU'
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90	(revision 5158)
@@ -111,6 +111,6 @@
   REAL :: zz
 
-  do l = 1, nl
-    do i = 2, iim - 1
+  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))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/spla_output_dat.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/spla_output_dat.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/spla_output_dat.h	(revision 5158)
@@ -192,5 +192,5 @@
 !      (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)',  &
 !         't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
-	
+
   type(ctrl_out),save :: o_trm01     = ctrl_out((/ 4, 4, 4, 10, 10, 10, 10, 10, 10, 10 /), &
   'trm01','Burden PREC','', (/ ('', i=1, 10) /))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90	(revision 5158)
@@ -127,5 +127,5 @@
        tks = 5e-4
 
-       do iter = 1, 3
+       DO iter = 1, 3
           ! Cool skin
           dels = rns * (0.065 + 11. * tkt - 6.6e-5 / tkt &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90	(revision 5158)
@@ -1,4 +1,6 @@
 MODULE strataer_emiss_mod
   ! This module contains information about strato microphysic model emission parameters
+  IMPLICIT NONE; PRIVATE
+  PUBLIC strataer_emiss_init
 
 CONTAINS
@@ -11,4 +13,7 @@
     USE lmdz_phys_para, ONLY: is_master
     USE lmdz_abort_physic, ONLY: abort_physic
+    USE dimphy, ONLY: klon
+
+    IMPLICIT NONE
 
     ! Local variables
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90	(revision 5158)
@@ -43,6 +43,6 @@
       REAL, parameter :: rath2oair = mAIRmol/mH2Omol
       REAL, parameter :: third = 1./3.
-      real            :: pph2ogas(klon,klev) 
-      real            :: temp, wpp, xa, surtens, mvh2o, radwet, fkelvin, pph2okel, r2so4ik, denso4ik
+      REAL            :: pph2ogas(klon,klev)
+      REAL            :: temp, wpp, xa, surtens, mvh2o, radwet, fkelvin, pph2okel, r2so4ik, denso4ik
 !----------------------------------------
   
@@ -750,5 +750,5 @@
        INTEGER N
        REAL XT,X(N)
-!      Working variables	  	   
+!      Working variables
        INTEGER JX,I
   
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/YOMCST2.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/YOMCST2.h	(revision 5157)
+++ 	(revision )
@@ -1,14 +1,0 @@
-
-      INTEGER choice, iflag_mix, iflag_mix_adiab
-      REAL  gammas, alphas, betas, Fmax, qqa1, qqa2, qqa3, scut
-      REAL  Qcoef1max,Qcoef2max,Supcrit1,Supcrit2
-      REAL coef_clos_ls
-
-      COMMON/YOMCST2/gammas,    alphas, betas, Fmax, scut,              &
-                     qqa1, qqa2, qqa3,                                  &
-                     Qcoef1max,Qcoef2max,                               &
-                     Supcrit1, Supcrit2,                                &
-                     choice,iflag_mix,coef_clos_ls,iflag_mix_adiab
-!$OMP THREADPRIVATE(/YOMCST2/)
-!    --------------------------------------------------------------------
-
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_th.F90	(revision 5158)
@@ -135,5 +135,5 @@
 
              !----Initialisations
-             do i=1,klon
+             DO i=1,klon
 !!jyg                proba_notrig(i)=1.
                 random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
@@ -156,5 +156,5 @@
              IF (iflag_trig_bl==1) THEN
                 !----Tirage al\'eatoire et calcul de ale_bl_trig
-                do i=1,klon
+                DO i=1,klon
                    IF ( (ale_bl_stat(i) > abs(cin(i))+1.e-10) )  THEN
                       proba_notrig(i)=proba_notrig(i)* &
@@ -177,5 +177,5 @@
 
              ELSE IF (iflag_trig_bl>=2) THEN
-                do i=1,klon
+                DO i=1,klon
                    IF ( (Ale_bl(i) > abs(cin(i))+1.e-10) )  THEN
                       proba_notrig(i)=proba_notrig(i)* &
@@ -208,5 +208,5 @@
           !-----------Statistical closure-----------
           IF (iflag_clos_bl==1) THEN
-             do i=1,klon
+             DO i=1,klon
                 !CR: alp probabiliste
                 IF (ale_bl_trig(i)>0.) THEN
@@ -217,5 +217,5 @@
           ELSE IF (iflag_clos_bl==2) THEN
              !CR: alp calculee dans thermcell_main
-             do i=1,klon
+             DO i=1,klon
                 alp_bl(i)=alp_bl_stat(i)
              enddo
@@ -244,9 +244,9 @@
         ! iflag_trig_bl value.
         IF (iflag_trig_bl==1) then         ! use ale_bl_stat (Rochetin computation)
-         do i=1,klon
+         DO i=1,klon
               ale_bl_ref(i)=ale_bl_stat(i)
          enddo
         ELSE IF (iflag_trig_bl>=2) then    ! use ale_bl (old computation)
-         do i=1,klon
+         DO i=1,klon
               ale_bl_ref(i)=Ale_bl(i)
          enddo
@@ -255,5 +255,5 @@
 
         !----Initializations and random number generation
-        do i=1,klon
+        DO i=1,klon
 !!jyg           proba_notrig(i)=1.
            random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
@@ -273,5 +273,5 @@
 
         !----alp_bl computation
-        do i=1,klon
+        DO i=1,klon
            IF ( (ale_bl_ref(i) > abs(cin(i))+1.e-10) )  THEN
               birth_number = n2(i)*exp(-strig(i)/s2(i))
@@ -292,5 +292,5 @@
 
         !----ale_bl_trig computation
-         do i=1,klon
+         DO i=1,klon
            IF (random_notrig(i) >= proba_notrig(i)) THEN
               ale_bl_trig(i)=ale_bl_ref(i)
@@ -324,5 +324,5 @@
                 WRITE(lunout,*)'Couplage Thermiques/Emanuel seulement si T<0'
              ENDIF
-             do i=1,klon
+             DO i=1,klon
                 IF (t_seri(i,lmax_th(i))>273.) THEN
                    Ale_bl(i)=0.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/calbeta_clim.F90	(revision 5158)
@@ -41,5 +41,5 @@
   lat_nord=lat_sahel+25.
   lat_sud=lat_sahel-25.
-  do j=1,klon
+  DO j=1,klon
      !===========
      IF (lat(j) < 5. ) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/calltherm.F90	(revision 5158)
@@ -207,6 +207,6 @@
          logexpr0=prt_level>=10
          nbptspb=0
-         do k=1,klev
-            do i=1,klon
+         DO k=1,klev
+            DO i=1,klon
 ! Attention teste abderr 19-03-09
 !               logexpr2(i,k)=.NOT.q_seri(i,k).ge.0.
@@ -219,5 +219,5 @@
                 nbptspb=nbptspb+1
 #ifdef ISO
-                do ixt=1,ntiso
+                DO ixt=1,ntiso
                   xt_seri(ixt,i,k)=1.e-15*(xt_seri(ixt,i,k)/qprec(i,k))
                   ! xt_seri(ixt,i,k)=1.e-15*(Rdefault(index_iso(ixt)))
@@ -249,5 +249,5 @@
 
 
-         do isplit=1,nsplit_thermals
+         DO isplit=1,nsplit_thermals
 
           IF (iflag_thermals>=1000) THEN
@@ -345,9 +345,9 @@
       IF (iflag_thermals<=12.OR.iflag_thermals>=1000) THEN
          lmax(:)=1
-         do k=1,klev-1
+         DO k=1,klev-1
             zdetr_therm(:,k)=zentr_therm(:,k)+zfm_therm(:,k)-zfm_therm(:,k+1)
          enddo
-         do k=1,klev-1
-            do i=1,klon
+         DO k=1,klev-1
+            DO i=1,klon
                IF (zfm_therm(i,k+1)>0.) lmax(i)=k
             enddo
@@ -374,5 +374,5 @@
          +zdetr_therm(:,k)*fact(:)
 #ifdef ISO
-            do ixt=1,ntiso
+            DO ixt=1,ntiso
               d_xt_the(ixt,:,k)=d_xt_the(ixt,:,k)*dtime*fact(:)
             enddo
@@ -438,5 +438,5 @@
                 nbptspb=nbptspb+1
 #ifdef ISO
-                do ixt=1,ntiso
+                DO ixt=1,ntiso
                   xt_seri(ixt,i,k)=1.e-15*(xtmemoire(ixt,i,k)/qmemoire(i,k))
                 enddo
@@ -482,6 +482,6 @@
 
       fmc_therm=0.
-               do k=1,klev
-            do i=1,klon
+               DO k=1,klev
+            DO i=1,klon
                   IF (entr_therm(i,k)>0.) THEN
                      fmc_therm(i,k+1)=fmc_therm(i,k)+entr_therm(i,k)
@@ -500,7 +500,7 @@
 !CR:on ne le calcule que pour le cas sec
       IF (iflag_thermals<=11) THEN
-      do i=1,klon
+      DO i=1,klon
          zqasc(i,1)=q_seri(i,1)
-         do k=2,klev
+         DO k=2,klev
             IF (fmc_therm(i,k+1)>1.e-6) THEN
                zqasc(i,k)=(fmc_therm(i,k)*zqasc(i,k-1)  &
@@ -517,6 +517,6 @@
 !     calcul de l'eau condensee dans l'ascendance
 !             PRINT*,'<<<<calcul de leau condensee dans thermique'
-             do i=1,klon
-                do k=1,klev
+             DO i=1,klon
+                DO k=1,klev
                    clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
                    IF (clwcon0(i,k)<0. .OR.   &
@@ -527,6 +527,6 @@
              enddo
        else
-              do i=1,klon
-                do k=1,klev
+              DO i=1,klon
+                DO k=1,klev
                    clwcon0(i,k)=zqla(i,k)  
                    IF (clwcon0(i,k)<0. .OR.   &
@@ -541,6 +541,6 @@
 
 !jyg  Protection contre les temperatures nulles
-          do i=1,klon
-             do k=1,klev
+          DO i=1,klon
+             DO k=1,klev
                 IF (ztla(i,k) < 1.e-10) fraca(i,k) =0.
              enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/clc_core_cp.F90	(revision 5158)
@@ -3,8 +3,8 @@
 
       SUBROUTINE clc_core_cp(du, dt, dq, t1, q1, &
-     				zu, zt, zq, &
-     					P,&
-     				n_it, mixte, &
-    			 coeffs, rugosm, rugosh)
+                     zu, zt, zq, &
+                         P,&
+                     n_it, mixte, &
+                 coeffs, rugosm, rugosh)
 
       IMPLICIT NONE
@@ -114,5 +114,5 @@
 !!!!!!!!! début des itérations....
 
-  do i = 1,n_it
+  DO i = 1,n_it
 
      usr = cd_rt * u 
@@ -150,5 +150,5 @@
      END IF
 
-     do j =2,3
+     DO j =2,3
         IF ( zeta(j) > 0 ) THEN
            psi(1,j) = -5.*zeta(j)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/coare_cp_mod.F90	(revision 5158)
@@ -188,5 +188,5 @@
 
   !***************  bulk loop ************
-  do i=1, nits
+  DO i=1, nits
 
      zet=von*grav*zu/t*(tsr*(1+0.61*Q)+.61*t*qsr)/(usr*usr)/(1+0.61*Q)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90	(revision 5157)
+++ 	(revision )
@@ -1,584 +1,0 @@
-SUBROUTINE concvl(iflag_clos, &
-        dtime, paprs, pplay, k_upper_cv, &
-        t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
-        Ale, Alp, sig1, w01, &
-        d_t, d_q, d_qcomp, d_u, d_v, d_tra, &
-        rain, snow, kbas, ktop, sigd, &
-        cbmf, plcl, plfc, wbeff, convoccur, &
-        upwd, dnwd, dnwdbis, &
-        Ma, mip, Vprecip, &
-        cape, cin, tvp, Tconv, iflag, &
-        pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
-        qcondc, wd, pmflxr, pmflxs, &
-        !RomP >>>
-        !!     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
-        da, phi, mp, phii, d1a, dam, sij, qta, clw, elij, &! RomP
-        dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
-        evap, ep, epmlmMm, eplaMm, &                       ! RomP
-        wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
-        tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
-        !RomP <<<
-        epmax_diag) ! epmax_cape
-  ! **************************************************************
-  ! *
-  ! CONCVL                                                      *
-  ! *
-  ! *
-  ! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
-  ! modified by :                                               *
-  ! **************************************************************
-
-  USE dimphy
-  USE infotrac_phy, ONLY: nbtr
-  USE phys_local_var_mod, ONLY: omega
-  USE lmdz_print_control, ONLY: prt_level, lunout
-  USE lmdz_clesphys
-  USE lmdz_conema3
-  USE lmdz_yoethf
-
-  USE lmdz_yomcst
-
-  IMPLICIT NONE
- INCLUDE "FCTTRE.h"
-  ! ======================================================================
-  ! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
-  ! Objet: schema de convection de Emanuel (1991) interface
-  ! ======================================================================
-  ! Arguments:
-  ! dtime--input-R-pas d'integration (s)
-  ! s-------input-R-la vAleur "s" pour chaque couche
-  ! sigs----input-R-la vAleur "sigma" de chaque couche
-  ! sig-----input-R-la vAleur de "sigma" pour chaque niveau
-  ! psolpa--input-R-la pression au sol (en Pa)
-  ! pskapa--input-R-exponentiel kappa de psolpa
-  ! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa)
-  ! q-------input-R-vapeur d'eau (en kg/kg)
-
-  ! work*: input et output: deux variables de travail,
-  ! on peut les mettre a 0 au debut
-  ! ALE--------input-R-energie disponible pour soulevement
-  ! ALP--------input-R-puissance disponible pour soulevement
-
-  ! d_h--------output-R-increment de l'enthAlpie potentielle (h)
-  ! d_q--------output-R-increment de la vapeur d'eau
-  ! rain-------output-R-la pluie (mm/s)
-  ! snow-------output-R-la neige (mm/s)
-  ! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
-  ! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
-  ! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
-  ! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
-  ! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
-  ! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s)
-  ! Tconv------output-R-environment temperature seen by convective scheme (K)
-  ! Cape-------output-R-CAPE (J/kg)
-  ! Cin -------output-R-CIN  (J/kg)
-  ! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
-  ! adiabatiquement a partir du niveau 1 (K)
-  ! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
-  ! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
-  ! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
-  ! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
-  ! lalim_conv-
-  ! wght_th----
-  ! evap-------output-R
-  ! ep---------output-R
-  ! epmlmMm----output-R
-  ! eplaMm-----output-R
-  ! wdtrainA---output-R
-  ! wdtrainS---output-R
-  ! wdtrainM---output-R
-  ! wght-------output-R
-  ! ======================================================================
-
-  INTEGER, INTENT(IN) :: iflag_clos
-  REAL, INTENT(IN) :: dtime
-  REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay
-  REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
-  INTEGER, INTENT(IN) :: k_upper_cv
-  REAL, DIMENSION(klon, klev), INTENT(IN) :: t, q, u, v
-  REAL, DIMENSION(klon, klev), INTENT(IN) :: t_wake, q_wake
-  REAL, DIMENSION(klon), INTENT(IN) :: s_wake
-  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tra
-  INTEGER, INTENT(IN) :: ntra
-  REAL, DIMENSION(klon), INTENT(IN) :: Ale, Alp
-  !CR:test: on passe lentr et alim_star des thermiques
-  INTEGER, DIMENSION(klon), INTENT(IN) :: lalim_conv
-  REAL, DIMENSION(klon, klev), INTENT(IN) :: wght_th
-
-  REAL, DIMENSION(klon, klev), INTENT(INOUT) :: sig1, w01
-
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t, d_q, d_qcomp, d_u, d_v
-  REAL, DIMENSION(klon, klev, nbtr), INTENT(OUT) :: d_tra
-  REAL, DIMENSION(klon), INTENT(OUT) :: rain, snow
-
-  INTEGER, DIMENSION(klon), INTENT(OUT) :: kbas, ktop
-  REAL, DIMENSION(klon), INTENT(OUT) :: sigd
-  REAL, DIMENSION(klon), INTENT(OUT) :: cbmf, plcl, plfc, wbeff
-  REAL, DIMENSION(klon), INTENT(OUT) :: convoccur
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: upwd, dnwd, dnwdbis
-
-  !!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)                    !jyg
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: Ma, mip
-  REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: Vprecip                        !jyg
-  REAL, DIMENSION(klon), INTENT(OUT) :: cape, cin
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: tvp
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: Tconv
-  INTEGER, DIMENSION(klon), INTENT(OUT) :: iflag
-  REAL, DIMENSION(klon), INTENT(OUT) :: pbase, bbase
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: dtvpdt1, dtvpdq1
-  REAL, DIMENSION(klon), INTENT(OUT) :: dplcldt, dplcldr
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcondc
-  REAL, DIMENSION(klon), INTENT(OUT) :: wd
-  REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: pmflxr, pmflxs
-
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: da, mp
-  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phi
-  ! RomP >>>
-  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phii
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d1a, dam
-  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: sij, elij
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qta
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: clw
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: dd_t, dd_q
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: evap, ep
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: eplaMm
-  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: epmlmMm
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: wdtrainA, wdtrainS, wdtrainM
-  ! RomP <<<
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: wght                       !RL
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qtc
-  REAL, DIMENSION(klon, klev), INTENT(OUT) :: sigt, detrain
-  REAL, INTENT(OUT) :: tau_cld_cv, coefw_cld_cv
-  REAL, DIMENSION(klon), INTENT(OUT) :: epmax_diag                ! epmax_cape
-
-  !  Local
-  !  ----
-  REAL, DIMENSION(klon, klev) :: em_p
-  REAL, DIMENSION(klon, klev + 1) :: em_ph
-  REAL :: em_sig1feed ! sigma at lower bound of feeding layer
-  REAL :: em_sig2feed ! sigma at upper bound of feeding layer
-  REAL, DIMENSION(klev) :: em_wght ! weight density determining the feeding mixture
-  REAL, DIMENSION(klon, klev + 1) :: Vprecipi                       !jyg
-  !on enleve le save
-  ! SAVE em_sig1feed,em_sig2feed,em_wght
-
-  REAL, DIMENSION(klon) :: rflag
-  REAL, DIMENSION(klon) :: plim1, plim2
-  REAL, DIMENSION(klon) :: ptop2
-  REAL, DIMENSION(klon, klev) :: asupmax
-  REAL, DIMENSION(klon) :: supmax0, asupmaxmin
-  REAL :: zx_t, zdelta, zx_qs, zcor
-
-  !   INTEGER iflag_mix
-  !   SAVE iflag_mix
-  INTEGER :: noff, minorig
-  INTEGER :: i, j, k, itra
-  REAL, DIMENSION(klon, klev) :: qs, qs_wake
-  !LF          SAVE cbmf
-  !IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
-  !!!$OMP THREADPRIVATE(cbmf)!
-  REAL, DIMENSION(klon) :: cbmflast
-
-
-  ! Variables supplementaires liees au bilan d'energie
-  ! Real paire(klon)
-  !LF      Real ql(klon,klev)
-  ! Save paire
-  !LF      Save ql
-  !LF      Real t1(klon,klev),q1(klon,klev)
-  !LF      Save t1,q1
-  ! Data paire /1./
-  REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
-  !$OMP THREADPRIVATE(ql, q1, t1)
-
-  ! Variables liees au bilan d'energie et d'enthAlpi
-  REAL ztsol(klon)
-  REAL        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
-          h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
-  SAVE        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
-          h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
-  !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
-  !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
-  REAL        d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
-  REAL        d_h_vcol_phy
-  REAL        fs_bound, fq_bound
-  SAVE        d_h_vcol_phy
-  !$OMP THREADPRIVATE(d_h_vcol_phy)
-  REAL        zero_v(klon)
-  CHARACTER *15 ztit
-  INTEGER     ip_ebil ! PRINT level for energy conserv. diag.
-  SAVE        ip_ebil
-  DATA        ip_ebil/2/
-  !$OMP THREADPRIVATE(ip_ebil)
-  INTEGER     if_ebil ! level for energy conserv. dignostics
-  SAVE        if_ebil
-  DATA        if_ebil/2/
-  !$OMP THREADPRIVATE(if_ebil)
-  !+jld ec_conser
-  REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
-  REAL zrcpd
-  !-jld ec_conser
-  !LF
-  INTEGER nloc
-  LOGICAL, SAVE :: first = .TRUE.
-  !$OMP THREADPRIVATE(first)
-  INTEGER, SAVE :: itap, igout
-  !$OMP THREADPRIVATE(itap, igout)
-
-  include "YOMCST2.h"
-
-  IF (first) THEN
-    ! Allocate some variables LF 04/2008
-
-    !IM/JYG allocate(cbmf(klon))
-    ALLOCATE (ql(klon, klev))
-    ALLOCATE (t1(klon, klev))
-    ALLOCATE (q1(klon, klev))
-
-    convoccur(:) = 0.
-
-    itap = 0
-    igout = klon / 2 + 1 / klon
-  END IF
-  ! Incrementer le compteur de la physique
-  itap = itap + 1
-
-  ! Copy T into Tconv
-  DO k = 1, klev
-    DO i = 1, klon
-      Tconv(i, k) = t(i, k)
-    END DO
-  END DO
-
-  IF (if_ebil>=1) THEN
-    DO i = 1, klon
-      ztsol(i) = t(i, 1)
-      zero_v(i) = 0.
-      DO k = 1, klev
-        ql(i, k) = 0.
-      END DO
-    END DO
-  END IF
-
-  ! ym
-  snow(:) = 0
-
-  IF (first) THEN
-    first = .FALSE.
-
-    ! ===========================================================================
-    ! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
-    ! ===========================================================================
-
-    IF (iflag_con==3) THEN
-      !      CALL cv3_inicp()
-      CALL cv3_inip()
-    END IF
-
-    ! ===========================================================================
-    ! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
-    ! ===========================================================================
-
-    ! c$$$         open (56,file='supcrit.data')
-    ! c$$$         read (56,*) Supcrit1, Supcrit2
-    ! c$$$         close (56)
-
-    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
-
-    ! ===========================================================================
-    ! Initialisation pour les bilans d'eau et d'energie
-    ! ===========================================================================
-    IF (if_ebil>=1) d_h_vcol_phy = 0.
-
-    DO i = 1, klon
-      cbmf(i) = 0.
-      !!          plcl(i) = 0.
-      sigd(i) = 0.
-    END DO
-  END IF !(first)
-
-  ! Initialisation a chaque pas de temps
-  plfc(:) = 0.
-  wbeff(:) = 100.
-  plcl(:) = 0.
-
-  DO k = 1, klev + 1
-    DO i = 1, klon
-      em_ph(i, k) = paprs(i, k) / 100.0
-      pmflxr(i, k) = 0.
-      pmflxs(i, k) = 0.
-    END DO
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      em_p(i, k) = pplay(i, k) / 100.0
-    END DO
-  END DO
-
-
-  ! Feeding layer
-
-  em_sig1feed = 1.
-  !jyg<
-  !  em_sig2feed = 0.97
-  em_sig2feed = cvl_sig2feed
-  !>jyg
-  ! em_sig2feed = 0.8
-  ! Relative Weight densities
-  DO k = 1, klev
-    em_wght(k) = 1.
-  END DO
-  !CRtest: couche alim des tehrmiques ponderee par a*
-  ! DO i = 1, klon
-  ! do k=1,lalim_conv(i)
-  ! em_wght(k)=wght_th(i,k)
-  ! PRINT*,'em_wght=',em_wght(k),wght_th(i,k)
-  ! END DO
-  ! END DO
-
-  IF (iflag_con==4) THEN
-    DO k = 1, klev
-      DO i = 1, klon
-        zx_t = t(i, k)
-        zdelta = max(0., sign(1., rtt - zx_t))
-        zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0)
-        zcor = 1. / (1. - retv * zx_qs)
-        qs(i, k) = zx_qs * zcor
-      END DO
-      DO i = 1, klon
-        zx_t = t_wake(i, k)
-        zdelta = max(0., sign(1., rtt - zx_t))
-        zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0)
-        zcor = 1. / (1. - retv * zx_qs)
-        qs_wake(i, k) = zx_qs * zcor
-      END DO
-    END DO
-  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
-    DO k = 1, klev
-      DO i = 1, klon
-        zx_t = t(i, k)
-        zdelta = max(0., sign(1., rtt - zx_t))
-        zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0
-        zx_qs = min(0.5, zx_qs)
-        zcor = 1. / (1. - retv * zx_qs)
-        zx_qs = zx_qs * zcor
-        qs(i, k) = zx_qs
-      END DO
-      DO i = 1, klon
-        zx_t = t_wake(i, k)
-        zdelta = max(0., sign(1., rtt - zx_t))
-        zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0
-        zx_qs = min(0.5, zx_qs)
-        zcor = 1. / (1. - retv * zx_qs)
-        zx_qs = zx_qs * zcor
-        qs_wake(i, k) = zx_qs
-      END DO
-    END DO
-  END IF ! iflag_con
-
-  ! ------------------------------------------------------------------
-
-  ! Main driver for convection:
-  !                   iflag_con=3 -> nvlle version de KE (JYG)
-  !                   iflag_con = 30  -> equivAlent to convect3
-  !                   iflag_con = 4  -> equivAlent to convect1/2
-
-  IF (iflag_con==30) THEN
-
-    ! print *, '-> cv_driver'      !jyg
-    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
-            t, q, qs, u, v, tra, &
-            em_p, em_ph, iflag, &
-            d_t, d_q, d_u, d_v, d_tra, rain, &
-            Vprecip, cbmf, sig1, w01, & !jyg
-            kbas, ktop, &
-            dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
-            da, phi, mp, phii, d1a, dam, sij, clw, elij, &       !RomP
-            evap, ep, epmlmMm, eplaMm, &                         !RomP
-            wdtrainA, wdtrainM, &                                !RomP
-            epmax_diag) ! epmax_cape
-    !           print *, 'cv_driver ->'      !jyg
-
-    DO i = 1, klon
-      cbmf(i) = Ma(i, kbas(i))
-    END DO
-
-    !RL
-    wght(:, :) = 0.
-    DO i = 1, klon
-      wght(i, 1) = 1.
-    END DO
-    !RL
-
-  ELSE
-
-    !LF   necessary for gathered fields
-    nloc = klon
-    CALL cva_driver(klon, klev, klev + 1, ntra, nloc, k_upper_cv, &
-            iflag_con, iflag_mix, iflag_ice_thermo, &
-            iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
-            t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
-            em_p, em_ph, &
-            Ale, Alp, omega, &
-            em_sig1feed, em_sig2feed, em_wght, &
-            iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, &
-            cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
-            Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
-            cape, cin, tvp, &
-            dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
-            asupmaxmin, lalim_conv, &
-            !AC!+!RomP+jyg
-            !!                   da,phi,mp,phii,d1a,dam,sij,clw,elij, &               ! RomP
-            !!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
-            da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
-            qta, clw, elij, evap, ep, epmlmMm, eplaMm, &        ! RomP+RL
-            wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, &
-            tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
-            !AC!+!RomP+jyg
-            epmax_diag) ! epmax_cape
-  END IF
-  ! ------------------------------------------------------------------
-  IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff, d_t, d_q ', &
-          cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1, 1), d_q(1, 1)
-
-  DO i = 1, klon
-    rain(i) = rain(i) / 86400.
-    rflag(i) = iflag(i)
-  END DO
-
-  DO k = 1, klev
-    DO i = 1, klon
-      d_t(i, k) = dtime * d_t(i, k)
-      d_q(i, k) = dtime * d_q(i, k)
-      d_u(i, k) = dtime * d_u(i, k)
-      d_v(i, k) = dtime * d_v(i, k)
-    END DO
-  END DO
-
-  IF (iflag_con==3) THEN
-    DO i = 1, klon
-      IF (wbeff(i) > 100. .OR. wbeff(i) == 0 .OR. iflag(i) > 3) THEN
-        wbeff(i) = 0.
-        convoccur(i) = 0.
-      ELSE
-        convoccur(i) = 1.
-      ENDIF
-    ENDDO
-  ENDIF
-
-  IF (iflag_con==30) THEN
-    DO itra = 1, ntra
-      DO k = 1, klev
-        DO i = 1, klon
-          !RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
-          d_tra(i, k, itra) = 0.
-        END DO
-      END DO
-    END DO
-  END IF
-
-  !!AC!
-  IF (iflag_con==3) THEN
-    DO itra = 1, ntra
-      DO k = 1, klev
-        DO i = 1, klon
-          !RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
-          d_tra(i, k, itra) = 0.
-        END DO
-      END DO
-    END DO
-  END IF
-  !!AC!
-
-  DO k = 1, klev
-    DO i = 1, klon
-      t1(i, k) = t(i, k) + d_t(i, k)
-      q1(i, k) = q(i, k) + d_q(i, k)
-    END DO
-  END DO
-  !                                                     !jyg
-  IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN
-    ! --Separation neige/pluie (pour diagnostics)         !jyg
-    DO k = 1, klev                                    !jyg
-      DO i = 1, klon                                  !jyg
-        IF (t1(i, k)<rtt) THEN                         !jyg
-          pmflxs(i, k) = Vprecip(i, k)                !jyg
-        ELSE                                          !jyg
-          pmflxr(i, k) = Vprecip(i, k)                !jyg
-        END IF                                        !jyg
-      END DO                                          !jyg
-    END DO                                            !jyg
-  ELSE
-    DO k = 1, klev                                    !jyg
-      DO i = 1, klon                                  !jyg
-        pmflxs(i, k) = Vprecipi(i, k)                 !jyg
-        pmflxr(i, k) = Vprecip(i, k) - Vprecipi(i, k)   !jyg
-      END DO                                          !jyg
-    END DO                                            !jyg
-  ENDIF
-
-  ! c      IF (if_ebil.ge.2) THEN
-  ! c        ztit='after convect'
-  ! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
-  ! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
-  ! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-  ! c         CALL diagphy(paire,ztit,ip_ebil
-  ! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
-  ! c     e      , zero_v, rain, zero_v, ztsol
-  ! c     e      , d_h_vcol, d_qt, d_ec
-  ! c     s      , fs_bound, fq_bound )
-  ! c      END IF
-
-
-  ! les traceurs ne sont pas mis dans cette version de convect4:
-  IF (iflag_con==4) THEN
-    DO itra = 1, ntra
-      DO k = 1, klev
-        DO i = 1, klon
-          d_tra(i, k, itra) = 0.
-        END DO
-      END DO
-    END DO
-  END IF
-  ! PRINT*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
-
-  DO k = 1, klev
-    DO i = 1, klon
-      dtvpdt1(i, k) = 0.
-      dtvpdq1(i, k) = 0.
-    END DO
-  END DO
-  DO i = 1, klon
-    dplcldt(i) = 0.
-    dplcldr(i) = 0.
-  END DO
-
-  IF (prt_level>=20) THEN
-    DO k = 1, klev
-      ! PRINT*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
-      !         k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
-      !         d_q_con(igout,k),dql0(igout,k)
-      ! PRINT*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
-      !         itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
-      !         t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
-      ! PRINT*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
-      !         itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
-      !         ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
-      ! PRINT*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
-      !         itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
-      !         tvp(igout,k),Tconv(igout,k)
-      ! PRINT*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
-      !         itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
-      !         dplcldr(igout),qcondc(igout,k)
-      ! PRINT*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
-      !         itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
-      !         pmflxs(igout,k+1)
-      ! PRINT*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
-      !         itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
-      !         fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
-    END DO
-  END IF !(prt_level.EQ.20) THEN
-
-END SUBROUTINE concvl
-
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90	(revision 5158)
@@ -45,6 +45,7 @@
             GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat
     USE lmdz_yomcst
-
-    INCLUDE "YOMCST2.h"
+    USE lmdz_yomcst2
+
+    IMPLICIT NONE
 
     ! Configuration de la "physique" de LMDZ a l'aide de la fonction
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/convect1.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/convect1.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/convect1.F90	(revision 5158)
@@ -6,5 +6,5 @@
   ! .............................START PROLOGUE............................
 
-  ! SCCS IDENTIFICATION:  @(#)convect1.f	1.1 04/21/00
+  ! SCCS IDENTIFICATION:  @(#)convect1.f    1.1 04/21/00
   ! 19:40:52 /h/cm/library/nogaps4/src/sub/fcst/convect1.f_v
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/convect2.F90	(revision 5158)
@@ -9,5 +9,5 @@
   ! .............................START PROLOGUE............................
 
-  ! SCCS IDENTIFICATION:  @(#)convect2.f	1.2 05/18/00
+  ! SCCS IDENTIFICATION:  @(#)convect2.f    1.2 05/18/00
   ! 22:06:22 /h/cm/library/nogaps4/src/sub/fcst/convect2.f_v
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/convect3.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/convect3.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/convect3.F90	(revision 5158)
@@ -1023,5 +1023,5 @@
   ! sb  ***                    water vapor fluctuations
   ! ***
-  ! sb		(inspire de convect 4.3)
+  ! sb        (inspire de convect 4.3)
 
   ! BETAD=10.0
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/array_lib.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/array_lib.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/array_lib.F90	(revision 5158)
@@ -141,5 +141,5 @@
   xsort = xarr(ist)
   
-  do i=1,nxx
+  DO i=1,nxx
     iloc = infind(xsort,xxarr(i),dist=d)
     if (d > tol) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/congvec.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/congvec.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/congvec.h	(revision 5158)
@@ -37,5 +37,5 @@
 ! *****************************COPYRIGHT*******************************
 
-      do irand = 1, npoints
+      DO irand = 1, npoints
           ! Marsaglia CONG algorithm
           seed(irand)=69069*seed(irand)+1234567
@@ -48,5 +48,5 @@
       overflow_32=i2_16*i2_16
       if ( overflow_32 .le. huge32 ) then
-          do irand = 1, npoints
+          DO irand = 1, npoints
               ran(irand)=ran(irand)+1
               ran(irand)=(ran(irand))-int(ran(irand))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_mod.F90	(revision 5158)
@@ -72,5 +72,5 @@
          "clmcalipsoice", "CALIPSO Ice-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))	 	 
+         "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 
          "clhcalipsoice", "CALIPSO Ice-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /))  
@@ -80,5 +80,5 @@
          "cltcalipsoice", "CALIPSO Ice-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))	 	 
+         "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 
          "cllcalipsoun", "CALIPSO Undefined-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /))  
@@ -94,5 +94,5 @@
          "clcalipsoliq", "Lidar Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))	 
+         "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "clcalipsotmpice", "Lidar Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
@@ -115,7 +115,7 @@
          "clcalipsothin", "Lidar Thin profile Cloud Fraction", "%", (/ ('', i=1, 3) /))         !OPAQ
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsozopaque = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
-         "clcalipsozopaque", "Lidar z_opaque Fraction", "%", (/ ('', i=1, 3) /))	        !OPAQ
+         "clcalipsozopaque", "Lidar z_opaque Fraction", "%", (/ ('', i=1, 3) /))            !OPAQ
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsoopacity = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
-         "clcalipsoopacity", "Lidar opacity Fraction", "%", (/ ('', i=1, 3) /))	                !OPAQ
+         "clcalipsoopacity", "Lidar opacity Fraction", "%", (/ ('', i=1, 3) /))                    !OPAQ
 
   TYPE(ctrl_outcosp), SAVE :: o_proftemp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &         !TIBO
@@ -243,5 +243,5 @@
   integer                  :: Nlevlmdz, Ncolumns      ! Number of levels
   real,dimension(Nlevlmdz) :: presnivs
-  real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth 
+  REAL                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
   logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, use_vgrid, ok_all_xml                    
   type(cosp_vgrid)   :: vgrid   ! Information on vertical grid of stats
@@ -250,5 +250,5 @@
 !!! Variables locales
   integer                   :: idayref, iff, ii
-  real                      :: zjulian,zjulian_start
+  REAL                      :: zjulian,zjulian_start
   real,dimension(Ncolumns)  :: column_ax
   real,dimension(DBZE_BINS) ::  dbze_ax
@@ -271,9 +271,9 @@
 
 !! Definition valeurs axes
-    do ii=1,Ncolumns
+    DO ii=1,Ncolumns
       column_ax(ii) = real(ii)
     enddo
 
-    do i=1,DBZE_BINS
+    DO i=1,DBZE_BINS
      dbze_ax(i) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(i - 0.5)
     enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90	(revision 5158)
@@ -31,5 +31,5 @@
 !!! Variables d'entree
   integer               :: itap, Nlevlmdz, Ncolumns, Npoints
-  real                  :: freq_COSP, dtime, missing_val, missing_cosp
+  REAL                  :: freq_COSP, dtime, missing_val, missing_cosp
   type(cosp_config)     :: cfg     ! Control outputs
   type(cosp_gridbox)    :: gbx     ! Gridbox information. Input for COSP
@@ -161,5 +161,5 @@
 
    IF (using_xios) THEN
-     do icl=1,SR_BINS
+     DO icl=1,SR_BINS
         tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
      enddo
@@ -169,10 +169,10 @@
    ELSE
      if (cfg%LcfadLidarsr532) then
-       do icl=1,SR_BINS
+       DO icl=1,SR_BINS
           CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
        enddo
      endif
      if (cfg%LprofSR) then
-       do icl=1,Ncolumns                                                              !TIBO
+       DO icl=1,Ncolumns                                                              !TIBO
           CALL histwrite3d_cosp(o_profSR,stlidar%profSR(:,icl,:),nvert,icl)           !TIBO
        enddo                                                                          !TIBO
@@ -183,6 +183,6 @@
 
   if (cfg%LparasolRefl) then
-    do k=1,PARASOL_NREFL
-     do ip=1, Npoints
+    DO k=1,PARASOL_NREFL
+     DO ip=1, Npoints
       if (stlidar%cldlayer(ip,4).gt.0.01.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
         parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
@@ -203,5 +203,5 @@
    ELSE
      if (cfg%Latb532) then
-       do icl=1,Ncolumns
+       DO icl=1,Ncolumns
           CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
        enddo
@@ -218,5 +218,5 @@
    where(stradar%cfad_ze == R_UNDEF) stradar%cfad_ze = missing_val
    IF (using_xios) THEN
-     do icl=1,DBZE_BINS
+     DO icl=1,DBZE_BINS
        tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
      enddo
@@ -226,10 +226,10 @@
    ELSE
      if (cfg%Ldbze94) then
-       do icl=1,Ncolumns
+       DO icl=1,Ncolumns
          CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
        enddo
      endif
      if (cfg%LcfadDbze94) then
-       do icl=1,DBZE_BINS
+       DO icl=1,DBZE_BINS
          CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
        enddo
@@ -266,5 +266,5 @@
    ELSE
      if (cfg%Lclisccp) then
-       do icl=1,7
+       DO icl=1,7
          CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
        enddo
@@ -287,5 +287,5 @@
 
    IF (using_xios) THEN
-     do icl=1,MISR_N_CTH
+     DO icl=1,MISR_N_CTH
         tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
      enddo
@@ -294,5 +294,5 @@
    ELSE
      if (cfg%LclMISR) then
-      do icl=1,7
+      DO icl=1,7
         CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
       enddo
@@ -367,5 +367,5 @@
    ELSE
      if (cfg%Lclmodis) then
-       do icl=1,7
+       DO icl=1,7
          CALL histwrite3d_cosp(o_clmodis, &
          modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)
@@ -385,5 +385,5 @@
    ELSE
      if (cfg%Lcrimodis) then
-       do icl=1,7
+       DO icl=1,7
          CALL histwrite3d_cosp(o_crimodis, &
             modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
@@ -391,5 +391,5 @@
      endif
      if (cfg%Lcrlmodis) then
-       do icl=1,7
+       DO icl=1,7
          CALL histwrite3d_cosp(o_crlmodis, &
             modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_read_otputkeys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_read_otputkeys.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_read_otputkeys.F90	(revision 5158)
@@ -28,5 +28,5 @@
 
                 
-   do i=1,N_OUT_LIST
+   DO i=1,N_OUT_LIST
       cfg%out_list(i)=''
    enddo
@@ -130,5 +130,5 @@
 
 
-   do i=1,N_OUT_LIST
+   DO i=1,N_OUT_LIST
       cfg%out_list(i)=''
    enddo
@@ -269,5 +269,5 @@
              LprofSR,Lproftemp                                                                        !TIBO (2)
    
-  do i=1,N_OUT_LIST
+  DO i=1,N_OUT_LIST
     cfg%out_list(i)=''
   enddo
@@ -771,5 +771,5 @@
   IF (using_xios) THEN
     
-    do i=1,N_OUT_LIST
+    DO i=1,N_OUT_LIST
       cfg%out_list(i)=''
     enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/dsd.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/dsd.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/dsd.F90	(revision 5158)
@@ -311,5 +311,5 @@
       lidx = infind(D,dmin)
       uidx = infind(D,dmax)    
-      do k=lidx,uidx
+      DO k=lidx,uidx
  
         N(k) = ( &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/format_input.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/format_input.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/format_input.F90	(revision 5158)
@@ -52,5 +52,5 @@
 
   nprof = size(hgt_matrix,1)
-  do i=1,nprof
+  DO i=1,nprof
     call lin_interpolate(env_t_matrix(i,:),env_hgt_matrix(i,:), &
       t_matrix(i,:),hgt_matrix(i,:),1000._KR8)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/gases.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/gases.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/gases.F90	(revision 5158)
@@ -126,5 +126,5 @@
   sumo = 0.
   aux1 = 1.1*e_th
-  do i=1,nbands_o2
+  DO i=1,nbands_o2
     aux2 = f/v0(i)
     aux3 = v0(i)-f
@@ -151,5 +151,5 @@
   sumo = 0.
   aux1 = 4.8*e_th
-  do i=1,nbands_h2o
+  DO i=1,nbands_h2o
     aux2 = f/v1(i)
     aux3 = v1(i)-f
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/lidar_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/lidar_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/lidar_simulator.F90	(revision 5158)
@@ -324,5 +324,5 @@
 ! altitude at half pressure levels:
       zheight(:,1) = 0.0
-      do k = 2, nlev+1
+      DO k = 2, nlev+1
         zheight(:,k) = zheight(:,k-1) &
                   -(presf(:,k)-presf(:,k-1))/(rhoair(:,k-1)*9.81)
@@ -341,5 +341,5 @@
 
 ! polynomes kp_lidar derived from Mie theory:
-      do i = 1, npart
+      DO i = 1, npart
        where ( rad_part(:,:,i).gt.0.0)
          kp_part(:,:,i) = &
@@ -361,5 +361,5 @@
 
 ! alpha of particles in each subcolumn:
-      do i = 1, npart
+      DO i = 1, npart
         where ( rad_part(:,:,i).gt.0.0)
           alpha_part(:,:,i) = 3.0/4.0 * Qscat &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/math_lib.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/math_lib.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/math_lib.F90	(revision 5158)
@@ -49,5 +49,5 @@
       ga=1.0
       m1=x-1
-      do k=2,m1
+      DO k=2,m1
         ga=ga*k
       enddo
@@ -60,5 +60,5 @@
       m=int(z)
       r=1.0
-      do k=1,m
+      DO k=1,m
         r=r*(z-k)
       enddo
@@ -80,5 +80,5 @@
           -.206d-13, -.54d-14, .14d-14, .1d-15/
     gr=g(26)
-    do k=25,1,-1
+    DO k=25,1,-1
       gr=gr*z+g(k)
     enddo 
@@ -146,5 +146,5 @@
   else
      sumo = 0.
-     do j=i1,i2
+     DO j=i1,i2
        deltah = abs(s(i1+1)-s(i1))
        sumo = sumo + f(j)*deltah
@@ -268,5 +268,5 @@
   end if
  
-  do i = 2, ntab
+  DO i = 2, ntab
     if ( xtab(i) <= xtab(i-1) ) then
        lerror = .true.
@@ -311,5 +311,5 @@
   ihi = ntab
 
-  do i = 1, ntab
+  DO i = 1, ntab
     if ( a <= xtab(i) ) then
       exit
@@ -321,5 +321,5 @@
   ilo = min ( ilo, ntab - 1 )
 
-  do i = 1, ntab
+  DO i = 1, ntab
     if ( xtab(i) <= b ) then
       exit
@@ -335,5 +335,5 @@
   sum1 = 0.0D+00
  
-  do i = ilo, ihi
+  DO i = ilo, ihi
  
     x1 = xtab(i-1)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp.F90	(revision 5158)
@@ -68,5 +68,5 @@
   integer,dimension(2) :: ix,iy
   logical :: reff_zero
-  real :: maxp,minp
+  REAL :: maxp,minp
   integer,dimension(:),allocatable :: & ! Dimensions nPoints
                   seed    !  It is recommended that the seed is set to a different value for each model
@@ -95,5 +95,5 @@
 
 !++++++++++ Depth of model layers ++++++++++++
-  do i=1,Nlevels-1
+  DO i=1,Nlevels-1
     gbx%dlev(:,i) = gbx%zlev_half(:,i+1) - gbx%zlev_half(:,i)
   enddo
@@ -195,5 +195,5 @@
         Niter = gbx%Npoints/gbx%Npoints_it ! Integer division
         if (Niter*gbx%Npoints_it < gbx%Npoints) Niter = Niter + 1
-        do i=1,Niter
+        DO i=1,Niter
             i_first = (i-1)*gbx%Npoints_it + 1
             i_last  = i_first + gbx%Npoints_it - 1
@@ -409,7 +409,7 @@
         
         ! Precipitation fraction
-        do j=1,Npoints,1
-        do k=1,Nlevels,1
-            do i=1,Ncolumns,1
+        DO j=1,Npoints,1
+        DO k=1,Nlevels,1
+            DO i=1,Ncolumns,1
                 if (sgx%frac_out (j,i,Nlevels+1-k) == I_LSC) frac_ls(j,k)=frac_ls(j,k)+1.
                 if (sgx%frac_out (j,i,Nlevels+1-k) == I_CVC) frac_cv(j,k)=frac_cv(j,k)+1.
@@ -434,5 +434,5 @@
         else
             ! This is done within a loop (unvectorized) over nPoints to save memory
-            do j=1,Npoints
+            DO j=1,Npoints
                 sgx%frac_out(j,:,1:Nlevels)  = sgx%frac_out(j,:,Nlevels:1:-1)
                 sgx%prec_frac(j,:,1:Nlevels) = sgx%prec_frac(j,:,Nlevels:1:-1)
@@ -445,5 +445,5 @@
         ! Populate the subgrid arrays
         call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro)
-        do k=1,Ncolumns
+        DO k=1,Ncolumns
             !--------- Mixing ratios for clouds and Reff for Clouds and precip -------
             column_frac_out => sgx%frac_out(:,k,:)
@@ -498,6 +498,6 @@
         enddo
         ! convert the mixing ratio and precipitation flux from gridbox mean to the fraction-based values
-        do k=1,Nlevels
-            do j=1,Npoints
+        DO k=1,Nlevels
+            DO j=1,Npoints
                 !--------- Clouds -------
                 if (frac_ls(j,k) .ne. 0.) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_constants.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_constants.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_constants.F90	(revision 5158)
@@ -164,5 +164,5 @@
     integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO)
 
-    real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &
+    REAL :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &
             HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), &
             HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO)
@@ -274,5 +274,5 @@
     integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO) 
 
-    real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &           
+    REAL :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &
             HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), &
             HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_isccp_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_isccp_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_isccp_simulator.F90	(revision 5158)
@@ -45,15 +45,15 @@
   ! Local variables 
   integer :: Nlevels,Npoints
-  real :: pfull(gbx%Npoints, gbx%Nlevels)
-  real :: phalf(gbx%Npoints, gbx%Nlevels + 1)
-  real :: qv(gbx%Npoints, gbx%Nlevels)
-  real :: cc(gbx%Npoints, gbx%Nlevels)
-  real :: conv(gbx%Npoints, gbx%Nlevels)
-  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
-  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
-  real :: at(gbx%Npoints, gbx%Nlevels)
-  real :: dem_s(gbx%Npoints, gbx%Nlevels)
-  real :: dem_c(gbx%Npoints, gbx%Nlevels)
-  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
+  REAL :: pfull(gbx%Npoints, gbx%Nlevels)
+  REAL :: phalf(gbx%Npoints, gbx%Nlevels + 1)
+  REAL :: qv(gbx%Npoints, gbx%Nlevels)
+  REAL :: cc(gbx%Npoints, gbx%Nlevels)
+  REAL :: conv(gbx%Npoints, gbx%Nlevels)
+  REAL :: dtau_s(gbx%Npoints, gbx%Nlevels)
+  REAL :: dtau_c(gbx%Npoints, gbx%Nlevels)
+  REAL :: at(gbx%Npoints, gbx%Nlevels)
+  REAL :: dem_s(gbx%Npoints, gbx%Nlevels)
+  REAL :: dem_c(gbx%Npoints, gbx%Nlevels)
+  REAL :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
   integer :: sunlit(gbx%Npoints)
   
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_lidar.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_lidar.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_lidar.F90	(revision 5158)
@@ -54,5 +54,5 @@
   ! Local variables 
   integer :: i
-  real :: presf(sgx%Npoints, sgx%Nlevels + 1)
+  REAL :: presf(sgx%Npoints, sgx%Nlevels + 1)
   real,dimension(sgx%Npoints, sgx%Nlevels) :: lsca,mr_ll,mr_li,mr_cl,mr_ci
   real,dimension(sgx%Npoints, sgx%Nlevels) :: beta_tot,tau_tot
@@ -63,5 +63,5 @@
   presf(:,sgx%Nlevels + 1) = 0.0
   lsca = gbx%tca-gbx%cca
-  do i=1,sgx%Ncolumns
+  DO i=1,sgx%Ncolumns
       ! Temporary arrays for simulator call
       mr_ll(:,:) = sghydro%mr_hydro(:,i,:,I_LSCLIQ)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_misr_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_misr_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_misr_simulator.F90	(revision 5158)
@@ -49,11 +49,11 @@
   ! Local variables 
   integer :: Nlevels,Npoints
-  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
-  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
-  real :: at(gbx%Npoints, gbx%Nlevels)
-  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
+  REAL :: dtau_s(gbx%Npoints, gbx%Nlevels)
+  REAL :: dtau_c(gbx%Npoints, gbx%Nlevels)
+  REAL :: at(gbx%Npoints, gbx%Nlevels)
+  REAL :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
   integer :: sunlit(gbx%Npoints)
   
-  real :: zfull(gbx%Npoints, gbx%Nlevels) !  height (in meters) of full model levels (i.e. midpoints)
+  REAL :: zfull(gbx%Npoints, gbx%Nlevels) !  height (in meters) of full model levels (i.e. midpoints)
                                           !  zfull(npoints,1)    is    top level of model
                                           !  zfull(npoints,nlev) is bottom level of model
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_modis_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_modis_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_modis_simulator.F90	(revision 5158)
@@ -162,7 +162,7 @@
 
       ! Loop version of spread above - intrinsic doesn't work on certain platforms. 
-      do k = 1, nLevels
-        do j = 1, nSubCols
-          do i = 1, nSunlit
+      DO k = 1, nLevels
+        DO j = 1, nSubCols
+          DO i = 1, nSunlit
             if(subCols%frac_out(sunlit(i), j, k) == I_LSC) then
               opticalThickness(i, j, k) = gridBox%dtau_s(sunlit(i), k)
@@ -186,7 +186,7 @@
 
       ! Loop version of spread above - intrinsic doesn't work on certain platforms. 
-      do k = 1, nLevels
-        do j = 1, nSubCols
-          do i = 1, nSunlit
+      DO k = 1, nLevels
+        DO j = 1, nSubCols
+          DO i = 1, nSunlit
             if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
           end do 
@@ -205,5 +205,5 @@
       isccpCloudTopPressure(:, :) = isccpSim%boxptop(sunlit(:), :)
       
-      do i = 1, nSunlit
+      DO i = 1, nSunlit
         call modis_L2_simulator(temperature(i, :), pressureLayers(i, :), pressureLevels(i, :),     &
                                 opticalThickness(i, :, :), cloudWater(i, :, :), cloudIce(i, :, :), &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_radar.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_radar.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_radar.F90	(revision 5158)
@@ -139,20 +139,20 @@
 
   ! set flag denoting position of radar relative to hgt_matrix orientation
-	  ngate = size(hgt_matrix,2)
+      ngate = size(hgt_matrix,2)
 
-	  hgt_descending = hgt_matrix(1,1) > hgt_matrix(1,ngate)
+      hgt_descending = hgt_matrix(1,1) > hgt_matrix(1,ngate)
 
-	  if ( &
-	     (gbx%surface_radar == 1 .and. hgt_descending) .or.  &
-	     (gbx%surface_radar == 0 .and. (.not. hgt_descending)) &
-	     ) &
-	  then
-	    gbx%hp%radar_at_layer_one = .false.
-	  else
-	    gbx%hp%radar_at_layer_one = .true.
-	  endif
+      if ( &
+         (gbx%surface_radar == 1 .and. hgt_descending) .or.  &
+         (gbx%surface_radar == 0 .and. (.not. hgt_descending)) &
+         ) &
+      then
+        gbx%hp%radar_at_layer_one = .false.
+      else
+        gbx%hp%radar_at_layer_one = .true.
+      endif
 
   ! ----- loop over subcolumns -----
-  do pr=1,sgx%Ncolumns
+  DO pr=1,sgx%Ncolumns
 
       !  NOTE:
@@ -160,5 +160,5 @@
       !  only hydrometeor profiles will be different for each subgridbox
 
-         do i=1,gbx%Nhydro
+         DO i=1,gbx%Nhydro
             hm_matrix(i,:,:) = sghydro%mr_hydro(:,pr,:,i)*1000.0 ! Units from kg/kg to g/kg
             if (gbx%use_reff) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_stats.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_stats.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_stats.F90	(revision 5158)
@@ -203,10 +203,10 @@
    logical :: lunits
    integer :: l
-   real :: w ! Weight
-   real :: dbb, dtb, dbt, dtt ! Distances between edges of both grids
+   REAL :: w ! Weight
+   REAL :: dbb, dtb, dbt, dtt ! Distances between edges of both grids
    integer :: Nw  ! Number of weights
-   real :: wt  ! Sum of weights
+   REAL :: wt  ! Sum of weights
    real,dimension(Nlevels) :: oldgrid_bot,oldgrid_top ! Lower and upper boundaries of model grid
-   real :: yp ! Local copy of y at a particular point.
+   REAL :: yp ! Local copy of y at a particular point.
               ! This allows for change of units.
 
@@ -216,5 +216,5 @@
    r = 0.0
 
-   do i=1,Npoints
+   DO i=1,Npoints
      ! Calculate tops and bottoms of new and old grids
      oldgrid_bot = zhalf(i,:)
@@ -223,9 +223,9 @@
      l = 0 ! Index of level in the old grid
      ! Loop over levels in the new grid
-     do k = 1,Nglevels
+     DO k = 1,Nglevels
        Nw = 0 ! Number of weigths
        wt = 0.0 ! Sum of weights
        ! Loop over levels in the old grid and accumulate total for weighted average
-       do
+       DO
          l = l + 1
          w = 0.0 ! Initialise weight to 0
@@ -254,5 +254,5 @@
              Nw = Nw + 1
              wt = wt + w
-             do j=1,Ncolumns
+             DO j=1,Ncolumns
                if (lunits) then
                  if (y(i,j,l) /= R_UNDEF) then
@@ -273,5 +273,5 @@
        ! Calculate average in new grid
        if (Nw > 0) then
-         do j=1,Ncolumns
+         DO j=1,Ncolumns
            r(i,j,k) = r(i,j,k)/wt
          enddo
@@ -281,7 +281,7 @@
 
    ! Set points under surface to R_UNDEF, and change to dBZ if necessary
-   do k=1,Nglevels
-     do j=1,Ncolumns
-       do i=1,Npoints
+   DO k=1,Nglevels
+     DO j=1,Ncolumns
+       DO i=1,Npoints
          if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level
            if (lunits) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_types.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_types.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_types.F90	(revision 5158)
@@ -44,5 +44,5 @@
                 Lclcalipsoliq,Lclcalipsoice,Lclcalipsoun, &
                 Lclcalipsotmp,Lclcalipsotmpliq,Lclcalipsotmpice,Lclcalipsotmpun, &
-	              Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun, &
+                  Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun, &
                 Lclhcalipsoliq,Lclhcalipsoice,Lclhcalipsoun, &
                 Lclmcalipsoliq,Lclmcalipsoice,Lclmcalipsoun, &
@@ -274,5 +274,5 @@
     
     ! Radar ancillary info
-    real :: radar_freq, & ! Radar frequency [GHz]
+    REAL :: radar_freq, & ! Radar frequency [GHz]
             k2 ! |K|^2, -1=use frequency dependent default
     integer :: surface_radar, & ! surface=1, spaceborne=0
@@ -383,5 +383,5 @@
                                  ! 2 = experimental setting  
     integer :: isccp_overlap !  overlap type (1=max, 2=rand, 3=max/rand)
-    real :: isccp_emsfc_lw      ! 10.5 micron emissivity of surface (fraction)
+    REAL :: isccp_emsfc_lw      ! 10.5 micron emissivity of surface (fraction)
   
     ! RTTOV inputs/options
@@ -392,6 +392,6 @@
     integer, dimension(:), pointer :: Ichan   ! Channel numbers
     real,    dimension(:), pointer :: Surfem  ! Surface emissivity
-    real    :: ZenAng ! Satellite Zenith Angles
-    real :: co2,ch4,n2o,co ! Mixing ratios of trace gases
+    REAL    :: ZenAng ! Satellite Zenith Angles
+    REAL :: co2,ch4,n2o,co ! Mixing ratios of trace gases
 
   END TYPE COSP_GRIDBOX
@@ -550,5 +550,5 @@
     ! Local variables
     integer :: i
-    real :: zstep
+    REAL :: zstep
     
     x%use_vgrid  = use_vgrid
@@ -587,5 +587,5 @@
          zstep = 20000.0/x%Nlvgrid
       endif
-      do i=1,x%Nlvgrid
+      DO i=1,x%Nlvgrid
          x%zl(i) = (i-1)*zstep
          x%zu(i) = i*zstep
@@ -654,6 +654,6 @@
     x%tau_tot    = 0.0
     x%refl       = 0.0 ! parasol
-    x%temp_tot   	= 0.0
-    x%betaperp_tot 	= 0.0	
+    x%temp_tot       = 0.0
+    x%betaperp_tot     = 0.0
   END SUBROUTINE CONSTRUCT_COSP_SGLIDAR
 
@@ -1204,7 +1204,7 @@
     ! y%hp%idd     = x%hp%idd
     sz = shape(x%hp%Z_scale_flag)
-    do k=1,sz(3)
-      do j=1,sz(2)
-        do i=1,sz(1)
+    DO k=1,sz(3)
+      DO j=1,sz(2)
+        DO i=1,sz(1)
            if (x%hp%N_scale_flag(i,k))   y%hp%N_scale_flag(i,k)      = .true.
            if (x%hp%Z_scale_flag(i,j,k)) y%hp%Z_scale_flag(i,j,k)    = .true.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_utils.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_utils.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_utils.F90	(revision 5158)
@@ -58,6 +58,6 @@
     ! Local variables
     integer :: i,j,k
-    real :: sigma,one_over_xip1,xi,rho0,rho,lambda_x,gamma_4_3_2,delta
-    real :: seuil 
+    REAL :: sigma,one_over_xip1,xi,rho0,rho,lambda_x,gamma_4_3_2,delta
+    REAL :: seuil
 
     if (ok_debug_cosp) then
@@ -77,7 +77,7 @@
         delta = (alpha_x + b_x + d_x - n_bx + 1.0)
         
-        do k=1,Nlevels
-            do j=1,Ncolumns
-                do i=1,Npoints
+        DO k=1,Nlevels
+            DO j=1,Ncolumns
+                DO i=1,Npoints
                     if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
                         rho = p(i,k)/(287.05*T(i,k))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_llnl_stats.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_llnl_stats.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_llnl_stats.F90	(revision 5158)
@@ -67,7 +67,7 @@
    ! Valid x values smaller than bmin and larger than bmax are set 
    ! into the smallest bin and largest bin, respectively.
-   do j = 1, Nlevels, 1
-      do k = 1, Ncolumns, 1
-         do i = 1, Npoints, 1
+   DO j = 1, Nlevels, 1
+      DO k = 1, Ncolumns, 1
+         DO i = 1, Npoints, 1
             if (x(i,k,j) == R_GROUND) then
                cosp_cfad(i,:,j) = R_UNDEF
@@ -101,6 +101,6 @@
 
    ! local variables
-   real :: sc_ratio
-   real :: s_cld, s_att
+   REAL :: sc_ratio
+   REAL :: s_cld, s_att
    parameter (S_cld = 5.0)
    parameter (s_att = 0.01)
@@ -111,9 +111,9 @@
    lidar_only_freq_cloud = 0.0
    tcc = 0.0
-   do pr=1,Npoints
-     do i=1,Ncolumns
+   DO pr=1,Npoints
+     DO i=1,Ncolumns
        flag_sat = 0
        flag_cld = 0
-       do j=Nlevels,1,-1 !top->surf
+       DO j=Nlevels,1,-1 !top->surf
         sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
         if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90	(revision 5158)
@@ -131,5 +131,5 @@
 
 ! SR detection threshold
-      real, parameter  ::  S_cld_att = 30. ! New threshold for undefine cloud phase detection	
+      real, parameter  ::  S_cld_att = 30. ! New threshold for undefine cloud phase detection
 
 ! c -------------------------------------------------------
@@ -144,5 +144,5 @@
 ! c -------------------------------------------------------
 
-      do ic = 1, ncol
+      DO ic = 1, ncol
         pnorm_c = pnorm(:,ic,:)
         where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
@@ -152,6 +152,6 @@
         end where
          x3d(:,ic,:) = x3d_c
-!	profSR(:,ic,:) = x3d(:,ic,:) !TIBO
-	profSR(:,:,ic) = x3d(:,ic,:) !TIBO2
+!    profSR(:,ic,:) = x3d(:,ic,:) !TIBO
+    profSR(:,:,ic) = x3d(:,ic,:) !TIBO2
       enddo
 
@@ -188,11 +188,11 @@
       parasolrefl(:,:) = 0.0
 
-      do k = 1, nrefl
-       do ic = 1, ncol
+      DO k = 1, nrefl
+       DO ic = 1, ncol
          parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
        enddo
       enddo
 
-      do k = 1, nrefl
+      DO k = 1, nrefl
         parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
 ! if land=1 -> parasolrefl=undef
@@ -253,5 +253,5 @@
       srbval(5) =  7.0
       srbval(6) = 10.0
-      do i = 7, MIN(10,Nbins)
+      DO i = 7, MIN(10,Nbins)
        srbval(i) = srbval(i-1) + 5.0
       enddo
@@ -268,8 +268,8 @@
 ! c c- Compute CFAD
 ! c -------------------------------------------------------
-      do j = 1, Nlevels
-         do ib = 1, Nbins
-            do k = 1, Ncolumns
-               do i = 1, Npoints
+      DO j = 1, Nlevels
+         DO ib = 1, Nbins
+            DO k = 1, Ncolumns
+               DO i = 1, Npoints
                   if (x(i,k,j) /= undef) then
                      if ((x(i,k,j).gt.srbval_ext(ib-1)).and.(x(i,k,j).le.srbval_ext(ib))) &
@@ -310,5 +310,5 @@
       integer,parameter  ::  Ntemp=40 ! indice of the temperature vector
       integer ip, k, iz, ic, ncol, nlev, i, itemp  ! loop indice
-      real  S_cld_att ! New threshold for undefine cloud phase detection (SR=30)	
+      real  S_cld_att ! New threshold for undefine cloud phase detection (SR=30)
       integer toplvlsat  ! level of the first cloud with SR>30
       real alpha50, beta50, gamma50, delta50, epsilon50, zeta50 ! Polynomial Coef of the phase
@@ -316,5 +316,5 @@
 
 ! Input variables
-      real tmp(Npoints,Nlevels)			! temperature
+      real tmp(Npoints,Nlevels)            ! temperature
       real ATB(Npoints,Ncolumns,Nlevels) ! 3D Attenuated backscatter
       real ATBperp(Npoints,Ncolumns,Nlevels) ! 3D perpendicular attenuated backscatter
@@ -332,7 +332,7 @@
 
 ! Local variables
-      real tmpi(Npoints,Ncolumns,Nlevels)	! temperature of ice cld
-      real tmpl(Npoints,Ncolumns,Nlevels)	! temperature of liquid cld
-      real tmpu(Npoints,Ncolumns,Nlevels)	! temperature of undef cld
+      real tmpi(Npoints,Ncolumns,Nlevels)    ! temperature of ice cld
+      real tmpl(Npoints,Ncolumns,Nlevels)    ! temperature of liquid cld
+      real tmpu(Npoints,Ncolumns,Nlevels)    ! temperature of undef cld
 
       real checktemp, ATBperp_tmp ! temporary variable
@@ -399,5 +399,5 @@
                 -54.,-51.,-48.,-45.,-42.,-39.,-36.,-33.,-30.,-27.,-24.,-21.,-18.,  &
                 -15.,-12.,-9.,-6.,-3.,0.,3.,6.,9.,12.,15.,18.,21.,24.,200. /)
-	
+
 ! convert C to K
       tempmod=tempmod+273.15
@@ -418,5 +418,5 @@
 ! ---------------------------------------------------------------
 
-      do k = 1, Nlevels
+      DO k = 1, Nlevels
 
 ! cloud detection at subgrid-scale:
@@ -454,12 +454,12 @@
       nsublay(:,:,4) = 0.0
 
-      do k = Nlevels, 1, -1
-       do ic = 1, Ncolumns
-        do ip = 1, Npoints
+      DO k = Nlevels, 1, -1
+       DO ic = 1, Ncolumns
+        DO ip = 1, Npoints
 
          if(srok(ip,ic,k).gt.0.)then
            ! Computation of the cloud fraction as a function of the temperature
            ! instead of height, for ice,liquid and all clouds
-           do itemp=1,Ntemp
+           DO itemp=1,Ntemp
              if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
                lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
@@ -469,5 +469,5 @@
 
          if (cldy(ip,ic,k).eq.1.) then
-           do itemp=1,Ntemp
+           DO itemp=1,Ntemp
              if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
                lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
@@ -505,12 +505,12 @@
       cldlay = 0.0
       nsublay = 0.0
-      do k = Nlevels, 1, -1
-       do ic = 1, Ncolumns
-        do ip = 1, Npoints
+      DO k = Nlevels, 1, -1
+       DO ic = 1, Ncolumns
+        DO ip = 1, Npoints
 
           ! Computation of the cloud fraction as a function of the temperature
           ! instead of height, for ice,liquid and all clouds
           if(srok(ip,ic,k).gt.0.)then
-          do itemp=1,Ntemp
+          DO itemp=1,Ntemp
             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
               lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
@@ -520,5 +520,5 @@
 
           if(cldy(ip,ic,k).eq.1.)then
-          do itemp=1,Ntemp
+          DO itemp=1,Ntemp
             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
               lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
@@ -562,6 +562,6 @@
       nsublayer = 0.0
 
-      do iz = 1, Ncat
-       do ic = 1, Ncolumns
+      DO iz = 1, Ncat
+       DO ic = 1, Ncolumns
 
           cldlayer(:,iz)=cldlayer(:,iz) + cldlay(:,ic,iz)
@@ -582,13 +582,13 @@
 ! 4.1 - For Cloudy pixels with 8.16km < z < 19.2km
 ! ---------------------------------------------------------------
-do ncol=1,Ncolumns
-do i=1,Npoints
-
-      do nlev=Nlevels,18,-1  ! from 19.2km until 8.16km
+DO ncol=1,Ncolumns
+DO i=1,Npoints
+
+      DO nlev=Nlevels,18,-1  ! from 19.2km until 8.16km
          p1 = pplay(i,nlev)
 
 
 ! Avoid zero values
-	if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
+    if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
 ! Computation of the ATBperp along the phase discrimination line
            ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
@@ -609,19 +609,19 @@
                lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1.   ! keep the information "temperature criterium used"
                                                     ! to classify the phase cloud
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
                 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,2) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
+               cldlayphase(i,ncol,3,2) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,2) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,2) = 1.
                 endif
-         	   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,5) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,5) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,5) = 1.
+                cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
+             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+               cldlayphase(i,ncol,3,5) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,5) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,5) = 1.
                 endif
 
@@ -630,11 +630,11 @@
               lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.
               tmpi(i,ncol,nlev)=tmp(i,nlev)
-         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,1) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
+                cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+               cldlayphase(i,ncol,3,1) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,1) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,1) = 1.
                 endif
 
@@ -651,12 +651,12 @@
                lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.
                tmpl(i,ncol,nlev)=tmp(i,nlev)
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,2) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
-	 	endif
+                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+                cldlayphase(i,ncol,3,2) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,2) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,2) = 1.
+         endif
 
              else
@@ -666,25 +666,25 @@
                lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1.   ! keep the information "temperature criterium used"
                                                     ! to classify the phase cloud
-         	   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,4) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,4) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,4) = 1.
-	 	endif
-         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,1) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
-	 	endif
+                cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
+             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+                cldlayphase(i,ncol,3,4) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,4) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,4) = 1.
+         endif
+                cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+            if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+                cldlayphase(i,ncol,3,1) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,1) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,1) = 1.
+         endif
 
              endif
 
             endif  ! end of discrimination condition 
-	 endif  ! end of cloud condition
+     endif  ! end of cloud condition
       enddo ! end of altitude loop
 
@@ -696,8 +696,8 @@
 
       toplvlsat=0
-      do nlev=17,1,-1  ! from 8.16km until 0km
+      DO nlev=17,1,-1  ! from 8.16km until 0km
          p1 = pplay(i,nlev)
 
-	if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
+    if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
 ! Phase discrimination line : ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 
 !                                  + ATB*epsilon50 + zeta50
@@ -718,20 +718,20 @@
                lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1.
 
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
-        	   cldlayphase(i,ncol,3,2) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
+               cldlayphase(i,ncol,3,2) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,2) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,2) = 1.
                 endif
 
-         	   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,5) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,5) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,5) = 1.
+                cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
+             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+               cldlayphase(i,ncol,3,5) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,5) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,5) = 1.
                 endif
 
@@ -741,11 +741,11 @@
               tmpi(i,ncol,nlev)=tmp(i,nlev)
 
-          	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,1) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
+                 cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+            if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+               cldlayphase(i,ncol,3,1) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,1) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,1) = 1.
                 endif
 
@@ -763,12 +763,12 @@
                tmpl(i,ncol,nlev)=tmp(i,nlev)
 
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,2) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
-	 	endif
+                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+                cldlayphase(i,ncol,3,2) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,2) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,2) = 1.
+         endif
 
              else
@@ -778,34 +778,34 @@
                lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1.  ! false liq ==> ice
 
-         	   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,4) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,4) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,4) = 1.
-	 	endif
-
-         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,1) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
-	 	endif
+                cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
+             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+                cldlayphase(i,ncol,3,4) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,4) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,4) = 1.
+         endif
+
+                cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+            if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+                cldlayphase(i,ncol,3,1) = 1.
+             else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+                cldlayphase(i,ncol,2,1) = 1.
+         else                                                    ! low cloud
+                cldlayphase(i,ncol,1,1) = 1.
+         endif
 
              endif
            endif  ! end of discrimination condition 
 
-       	    toplvlsat=0
+               toplvlsat=0
 
            ! Find the level of the highest cloud with SR>30
-	    if(x(i,ncol,nlev).gt.S_cld_att)then	 ! SR > 30.
-      		toplvlsat=nlev-1
-       		goto 99 
-    	    endif
-
-	endif  ! end of cloud condition
+        if(x(i,ncol,nlev).gt.S_cld_att)then     ! SR > 30.
+              toplvlsat=nlev-1
+               goto 99
+            endif
+
+    endif  ! end of cloud condition
        enddo  ! end of altitude loop
 
@@ -818,21 +818,21 @@
 !____________________________________________________________________________________________________
 
-if(toplvlsat.ne.0)then     	
-      do nlev=toplvlsat,1,-1
+if(toplvlsat.ne.0)then
+      DO nlev=toplvlsat,1,-1
          p1 = pplay(i,nlev)
-	if(cldy(i,ncol,nlev).eq.1.)then
+    if(cldy(i,ncol,nlev).eq.1.)then
            lidarcldphase(i,nlev,3)=lidarcldphase(i,nlev,3)+1.
            tmpu(i,ncol,nlev)=tmp(i,nlev)
 
-         	   cldlayphase(i,ncol,4,3) = 1.                         ! tot cloud
+                cldlayphase(i,ncol,4,3) = 1.                         ! tot cloud
           if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
              cldlayphase(i,ncol,3,3) = 1.
           else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid cloud
              cldlayphase(i,ncol,2,3) = 1.
-	  else                                                     ! low cloud
+      else                                                     ! low cloud
              cldlayphase(i,ncol,1,3) = 1.
-	  endif
-
-        endif	
+      endif
+
+        endif
       enddo
 endif
@@ -876,7 +876,7 @@
 
 ! Compute Phase low mid high cloud fractions
-    do iz = 1, Ncat
-       do i=1,Nphase-3
-       do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO i=1,Nphase-3
+       DO ic = 1, Ncolumns
           cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
           cldlayerphasesum(:,iz)=cldlayerphasesum(:,iz)+cldlayphase(:,ic,iz,i)
@@ -885,7 +885,7 @@
     enddo
 
-    do iz = 1, Ncat
-       do i=4,5
-       do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO i=4,5
+       DO ic = 1, Ncolumns
           cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)          
        enddo
@@ -901,5 +901,5 @@
     ENDWHERE
 
-    do i=1,Nphase-1
+    DO i=1,Nphase-1
       WHERE ( cldlayerphasesum(:,:).gt.0.0 )
          cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:) 
@@ -908,11 +908,11 @@
 
 
-    do i=1,Npoints
-       do iz=1,Ncat
+    DO i=1,Npoints
+       DO iz=1,Ncat
           checkcldlayerphase=0.
           checkcldlayerphase2=0.
 
           if (cldlayerphasesum(i,iz).gt.0.0 )then
-             do ic=1,Nphase-3
+             DO ic=1,Nphase-3
                 checkcldlayerphase=checkcldlayerphase+cldlayerphase(i,iz,ic)  
              enddo
@@ -925,5 +925,5 @@
     enddo
 
-    do i=1,Nphase-1
+    DO i=1,Nphase-1
       WHERE ( nsublayer(:,:).eq.0.0 )
          cldlayerphase(:,:,i) = undef
@@ -934,8 +934,8 @@
 
 ! Compute Phase 3D as a function of temperature
-do nlev=1,Nlevels
-do ncol=1,Ncolumns     
-do i=1,Npoints
-do itemp=1,Ntemp
+DO nlev=1,Nlevels
+DO ncol=1,Ncolumns
+DO i=1,Npoints
+DO itemp=1,Ntemp
 if(tmpi(i,ncol,nlev).gt.0.)then
       if( (tmpi(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpi(i,ncol,nlev).lt.tempmod(itemp+1)) )then
@@ -957,12 +957,12 @@
 
 ! Check temperature cloud fraction
-do i=1,Npoints
-   do itemp=1,Ntemp
+DO i=1,Npoints
+   DO itemp=1,Ntemp
 checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
 
-	if(checktemp.NE.lidarcldtemp(i,itemp,1))then
-	  print *, i,itemp
-	  print *, lidarcldtemp(i,itemp,1:4)
-	endif
+    if(checktemp.NE.lidarcldtemp(i,itemp,1))then
+      print *, i,itemp
+      print *, lidarcldtemp(i,itemp,1:4)
+    endif
 
    enddo
@@ -979,5 +979,5 @@
 ENDWHERE
 
-do i=1,4
+DO i=1,4
   WHERE(lidarcldtempind(:,:).gt.0.)
      lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
@@ -1025,5 +1025,5 @@
   
     ! ####################################################################################
-	! 1) Initialize    
+    ! 1) Initialize
     ! ####################################################################################
     cldtype               = 0.0
@@ -1040,5 +1040,5 @@
     ! 2) Cloud detection and Fully attenuated layer detection
     ! ####################################################################################
-    do k=1,Nlevels
+    DO k=1,Nlevels
        ! Cloud detection at subgrid-scale:
        where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
@@ -1072,7 +1072,7 @@
     ! ####################################################################################
 
-    do k= Nlevels,1,-1
-       do ic = 1, Ncolumns
-          do ip = 1, Npoints
+    DO k= Nlevels,1,-1
+       DO ic = 1, Ncolumns
+          DO ip = 1, Npoints
 
              cldlay(ip,ic,1)   = MAX(cldlay(ip,ic,1),cldyopaq(ip,ic,k)) ! Opaque clouds
@@ -1090,39 +1090,39 @@
 
 ! OPAQ variables
-     do ic = 1, Ncolumns
-        do ip = 1, Npoints
+     DO ic = 1, Ncolumns
+        DO ip = 1, Npoints
 
      ! Declaring non-opaque cloudy profiles as thin cloud profiles
-	   if ( (cldlay(ip,ic,4) .eq. 1.0) .and. (cldlay(ip,ic,1) .eq. 0.0) ) then
-	      cldlay(ip,ic,2)  =  1.0
- 	   endif
+       if ( (cldlay(ip,ic,4) .eq. 1.0) .and. (cldlay(ip,ic,1) .eq. 0.0) ) then
+          cldlay(ip,ic,2)  =  1.0
+        endif
 
      ! Filling in 3D and 2D variables
 
      ! Opaque cloud profiles
-	   if ( cldlay(ip,ic,1) .eq. 1.0 ) then
-	      zopac = 0.0
-	      do k=2,Nlevels
+       if ( cldlay(ip,ic,1) .eq. 1.0 ) then
+          zopac = 0.0
+          DO k=2,Nlevels
      ! Declaring opaque cloud fraction and z_opaque altitude for 3D and 2D variables
-	         if ( (cldy(ip,ic,k) .eq. 1.0) .and. (zopac .eq. 0.0) ) then
-		    lidarcldtype(ip,k-1,3) = lidarcldtype(ip,k-1,3) + 1.0
-		    cldlay(ip,ic,3)        = vgrid_z(k-1) !z_opaque altitude
-		    nsublay(ip,ic,3)       = 1.0
-		    zopac = 1.0
-		 endif
-	         if ( cldy(ip,ic,k) .eq. 1.0 ) then
-		    lidarcldtype(ip,k,1)   = lidarcldtype(ip,k,1) + 1.0
+             if ( (cldy(ip,ic,k) .eq. 1.0) .and. (zopac .eq. 0.0) ) then
+            lidarcldtype(ip,k-1,3) = lidarcldtype(ip,k-1,3) + 1.0
+            cldlay(ip,ic,3)        = vgrid_z(k-1) !z_opaque altitude
+            nsublay(ip,ic,3)       = 1.0
+            zopac = 1.0
+         endif
+             if ( cldy(ip,ic,k) .eq. 1.0 ) then
+            lidarcldtype(ip,k,1)   = lidarcldtype(ip,k,1) + 1.0
                  endif
-	      enddo
-	   endif
+          enddo
+       endif
 
      ! Thin cloud profiles
-	   if ( cldlay(ip,ic,2) .eq. 1.0 ) then
-	      do k=1,Nlevels
+       if ( cldlay(ip,ic,2) .eq. 1.0 ) then
+          DO k=1,Nlevels
      ! Declaring thin cloud fraction for 3D variable
                  if ( cldy(ip,ic,k) .eq. 1.0 ) then
                     lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1.0
                  endif
-	      enddo
+          enddo
            endif
 
@@ -1146,10 +1146,10 @@
     ! 3D opacity fraction (=4) !Summing z_opaque fraction from TOA(k=Nlevels) to SFC(k=1)
        lidarcldtype(:,Nlevels,4) = lidarcldtype(:,Nlevels,3)
-    do ip = 1, Npoints
-     	do k = Nlevels-1, 1, -1
+    DO ip = 1, Npoints
+         DO k = Nlevels-1, 1, -1
            if ( lidarcldtype(ip,k,3) .ne. undef ) then
-	      lidarcldtype(ip,k,4) = lidarcldtype(ip,k+1,4) + lidarcldtype(ip,k,3)
+          lidarcldtype(ip,k,4) = lidarcldtype(ip,k+1,4) + lidarcldtype(ip,k,3)
            endif
-	enddo
+    enddo
     enddo
     where ( nsubopaq(:,:) .eq. 0.0 )
@@ -1159,6 +1159,6 @@
     ! Layered cloud types (opaque, thin and z_opaque 2D variables)
 
-    do iz = 1, Ntype
-       do ic = 1, Ncolumns
+    DO iz = 1, Ntype
+       DO ic = 1, Ncolumns
           cldtype(:,iz)   = cldtype(:,iz)   + cldlay(:,ic,iz)
           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90	(revision 5158)
@@ -200,5 +200,5 @@
     logical, dimension(size(retrievedTau))                     :: cloudMask
     real,    dimension(size(waterSize, 1), size(waterSize, 2)) :: tauLiquidFraction, tauTotal
-    real    :: integratedLiquidFraction
+    REAL    :: integratedLiquidFraction
     integer :: i, nSubcols, nLevels
 
@@ -256,5 +256,5 @@
     end if 
     
-    do i = 1, nSubCols
+    DO i = 1, nSubCols
       if(cloudMask(i)) then 
 
@@ -371,5 +371,5 @@
            liquid_opticalThickness, ice_opticalThickness, tauLiquidFraction
     
-    real :: seuil
+    REAL :: seuil
     ! ---------------------------------------------------
     
@@ -596,5 +596,5 @@
     reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
     reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
-    do j=1,nPoints
+    DO j=1,nPoints
 
        ! Fill clear and optically thin subcolumns with fill
@@ -651,6 +651,6 @@
     integer :: ij,ik
     
-    do ij=2,nbin1+1
-       do ik=2,nbin2+1
+    DO ij=2,nbin1+1
+       DO ik=2,nbin2+1
           jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
                var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))        
@@ -778,5 +778,5 @@
     ! Joint histogram 
 
-    do i = 1, numTauHistogramBins 
+    DO i = 1, numTauHistogramBins
       where(cloudMask(:, :)) 
         tauMask(:, :, i) = optical_thickness(:, :) >= tauHistogramBoundaries(i) .and. &
@@ -787,5 +787,5 @@
     end do 
 
-    do i = 1, numPressureHistogramBins 
+    DO i = 1, numPressureHistogramBins
       where(cloudMask(:, :)) 
         pressureMask(:, :, i) = cloud_top_pressure(:, :) >= pressureHistogramBoundaries(i) .and. &
@@ -796,6 +796,6 @@
     end do 
     
-    do i = 1, numPressureHistogramBins
-      do j = 1, numTauHistogramBins
+    DO i = 1, numPressureHistogramBins
+      DO j = 1, numTauHistogramBins
         Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = & 
           real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
@@ -808,14 +808,14 @@
     real, dimension(:), intent(in) :: tauIncrement, pressure
     real,               intent(in) :: tauLimit
-    real                           :: cloud_top_pressure
+    REAL                           :: cloud_top_pressure
 
     ! Find the extinction-weighted pressure. Assume that pressure varies linearly between 
     !   layers and use the trapezoidal rule.
 
-    real :: deltaX, totalTau, totalProduct
+    REAL :: deltaX, totalTau, totalProduct
     integer :: i 
     
     totalTau = 0.; totalProduct = 0. 
-    do i = 2, size(tauIncrement)
+    DO i = 2, size(tauIncrement)
       if(totalTau + tauIncrement(i) > tauLimit) then 
         deltaX = tauLimit - totalTau
@@ -840,13 +840,13 @@
     real, dimension(:), intent(in) :: tauIncrement, f
     real,               intent(in) :: tauLimit
-    real                           :: weight_by_extinction
+    REAL                           :: weight_by_extinction
 
     ! Find the extinction-weighted value of f(tau), assuming constant f within each layer
 
-    real    :: deltaX, totalTau, totalProduct
+    REAL    :: deltaX, totalTau, totalProduct
     integer :: i 
     
     totalTau = 0.; totalProduct = 0. 
-    do i = 1, size(tauIncrement)
+    DO i = 1, size(tauIncrement)
       if(totalTau + tauIncrement(i) > tauLimit) then 
         deltaX       = tauLimit - totalTau
@@ -864,5 +864,5 @@
   pure function compute_nir_reflectance(water_tau, water_size, ice_tau, ice_size) 
     real, dimension(:), intent(in) :: water_tau, water_size, ice_tau, ice_size
-    real                           :: compute_nir_reflectance
+    REAL                           :: compute_nir_reflectance
     
     real, dimension(size(water_tau)) :: water_g, water_w0, ice_g, ice_w0, &
@@ -893,5 +893,5 @@
       integer, intent(in) :: phase
       real,    intent(in) :: tau, obs_Refl_nir
-      real                :: retrieve_re
+      REAL                :: retrieve_re
 
       ! Finds the re that produces the minimum mis-match between predicted and observed reflectance in 
@@ -907,5 +907,5 @@
 
       real, parameter :: min_distance_to_boundary = 0.01
-      real    :: re_min, re_max, delta_re
+      REAL    :: re_min, re_max, delta_re
       integer :: i 
       
@@ -957,5 +957,5 @@
     real, dimension(:), intent(in) :: x, y 
     real,               intent(in) :: yobs
-    real                           :: interpolate_to_min
+    REAL                           :: interpolate_to_min
 
     ! Given a set of values of y as y(x), find the value of x that minimizes abs(y - yobs)
@@ -1008,5 +1008,5 @@
     integer, intent(in) :: phase
     real,    intent(in) :: re
-    real :: get_g_nir 
+    REAL :: get_g_nir
 
     real, dimension(3), parameter :: ice_coefficients         = (/ 0.7490, 6.5153e-3, -5.4136e-5 /), &
@@ -1035,5 +1035,5 @@
         integer, intent(in) :: phase
         real,    intent(in) :: re
-        real                :: get_ssa_nir
+        REAL                :: get_ssa_nir
 
         ! Polynomial fit for single scattering albedo in MODIS band 7 (near IR) as a function 
@@ -1060,5 +1060,5 @@
     real,               intent(in) :: x
     real, dimension(:), intent(in) :: coefficients
-    real                           :: fit_to_cubic
+    REAL                           :: fit_to_cubic
     
     
@@ -1069,5 +1069,5 @@
     real,               intent(in) :: x
     real, dimension(:), intent(in) :: coefficients
-    real                           :: fit_to_quadratic
+    REAL                           :: fit_to_quadratic
     
     
@@ -1079,10 +1079,10 @@
   pure function compute_toa_reflectace(tau, g, w0)
     real, dimension(:), intent(in) :: tau, g, w0
-    real                           :: compute_toa_reflectace
+    REAL                           :: compute_toa_reflectace
     
     logical, dimension(size(tau))         :: cloudMask
     integer, dimension(count(tau(:) > 0)) :: cloudIndicies
     real,    dimension(count(tau(:) > 0)) :: Refl,     Trans
-    real                                  :: Refl_tot, Trans_tot
+    REAL                                  :: Refl_tot, Trans_tot
     integer                               :: i
     ! ---------------------------------------
@@ -1092,5 +1092,5 @@
     cloudMask = tau(:) > 0. 
     cloudIndicies = pack((/ (i, i = 1, size(tau)) /), mask = cloudMask) 
-    do i = 1, size(cloudIndicies)
+    DO i = 1, size(cloudIndicies)
       call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
     end do 
@@ -1115,5 +1115,5 @@
     integer, parameter :: beam = 2
     real,    parameter :: xmu = 0.866, minConservativeW0 = 0.9999999
-    real :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
+    REAL :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
             rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den, th
 
@@ -1183,5 +1183,5 @@
   elemental function two_stream_reflectance(tauint, gint, w0int) 
     real, intent(in) :: tauint, gint, w0int
-    real             :: two_stream_reflectance
+    REAL             :: two_stream_reflectance
 
     ! Compute reflectance in a single layer using the two stream approximation 
@@ -1194,5 +1194,5 @@
     integer, parameter :: beam = 2
     real,    parameter :: xmu = 0.866, minConservativeW0 = 0.9999999
-    real :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
+    REAL :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
             rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den
     ! ------------------------
@@ -1267,5 +1267,5 @@
       Refl_cumulative(1) = Refl(1); Tran_cumulative(1) = Tran(1)    
       
-      do i=2, size(Refl)
+      DO i=2, size(Refl)
           ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
           Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1 - Refl_cumulative(i-1) * Refl(i))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90	(revision 5158)
@@ -519,5 +519,5 @@
 
 !   // region from 0.045 microns to 167.0 microns - no temperature depend
-    do i=2,nwl
+    DO i=2,nwl
       if(alam < wl(i)) continue
     enddo
@@ -539,10 +539,10 @@
     if(tk > temref(1)) tk=temref(1)
     if(tk < temref(4)) tk=temref(4)
-    do 11 i=2,4
+    DO 11 i=2,4
       if(tk.ge.temref(i)) go to 12
     11 continue
     12 lt1=i
     lt2=i-1
-    do 13 i=2,nwlt
+    DO 13 i=2,nwlt
       if(alam.le.wlt(i)) go to 14
     13 continue
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90	(revision 5158)
@@ -44,6 +44,6 @@
 ! mr_ozone,                             !Concentration ozone (Kg/Kg)
 ! dem_s                                 !Cloud optical emissivity
-! dtau_s               			!Cloud optical thickness
-! emsfc_lw = 1.        			!Surface emissivity dans radlwsw.F90
+! dtau_s                           !Cloud optical thickness
+! emsfc_lw = 1.                    !Surface emissivity dans radlwsw.F90
 
 !!! Outputs :
@@ -132,5 +132,5 @@
 ! Declaration necessaires pour les sorties IOIPSL
   integer :: ii
-  real    :: ecrit_day,ecrit_hf,ecrit_mth, missing_val
+  REAL    :: ecrit_day,ecrit_hf,ecrit_mth, missing_val
   logical :: ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, ok_all_xml
 
@@ -150,5 +150,5 @@
   real,dimension(Nlevlmdz)        :: presnivs
   integer                         :: itap,k,ip
-  real                            :: dtime,freq_cosp
+  REAL                            :: dtime,freq_cosp
   real,dimension(2)               :: time_bnds
 
@@ -249,6 +249,6 @@
 
         zlev_half(:,1) = phis(:)/9.81
-        do k = 2, Nlevels
-          do ip = 1, Npoints
+        DO k = 2, Nlevels
+          DO ip = 1, Npoints
            zlev_half(ip,k) = phi(ip,k)/9.81 + &
                (phi(ip,k)-phi(ip,k-1))/9.81 * (ph(ip,k)-p(ip,k)) / (p(ip,k)-p(ip,k-1))
@@ -267,5 +267,5 @@
         gbx%skt  = skt !Skin temperature (K)
 
-        do ip = 1, Npoints
+        DO ip = 1, Npoints
           if (fracTerLic(ip).ge.0.5) then
              gbx%land(ip) = 1.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator.F90	(revision 5158)
@@ -41,5 +41,5 @@
 !   [hm_matrix]       table of hydrometeor mixing rations (g/kg)
 !   [re_matrix]       table of hydrometeor effective radii.  0 ==> use defaults. (units=microns)    
-!   [Np_matrix]	      table of hydrometeor number concentration.  0 ==> use defaults. (units = 1/kg)
+!   [Np_matrix]          table of hydrometeor number concentration.  0 ==> use defaults. (units = 1/kg)
 
 ! Outputs:
@@ -117,5 +117,5 @@
   ns       ! number of discrete drop sizes
 
-  logical :: hydro	! true=hydrometeor in vol, false=none
+  logical :: hydro    ! true=hydrometeor in vol, false=none
   real*8 :: &
   rho_a, &   ! air density (kg m^-3)
@@ -180,11 +180,11 @@
     d_gate=-1
   endif
-  do k=start_gate,end_gate,d_gate
+  DO k=start_gate,end_gate,d_gate
   ! // loop over each profile (nprof)
-    do pr=1,nprof
+    DO pr=1,nprof
       t_kelvin = t_matrix(pr,k)
 !     :: determine if hydrometeor(s) present in volume
       hydro = .false.
-      do j=1,hp%nhclass
+      DO j=1,hp%nhclass
         if ((hm_matrix(j,pr,k) > 1E-12) .and. (hp%dtype(j) > 0)) then
           hydro = .true.
@@ -198,5 +198,5 @@
         rho_a = (p_matrix(pr,k)*100.)/(287.0*(t_kelvin))
 !       :: loop over hydrometeor type
-        do tp=1,hp%nhclass
+        DO tp=1,hp%nhclass
           if (hm_matrix(tp,pr,k) <= 1E-12) cycle
           phase = hp%phase(tp)
@@ -233,5 +233,5 @@
             if (iRe_type.lt.1) iRe_type=1
 
-            Re=step*(iRe_type+0.5)	! set value of Re to closest value allowed in LUT.
+            Re=step*(iRe_type+0.5)    ! set value of Re to closest value allowed in LUT.
             iRe_type=iRe_type+base-int(n*Re_BIN_LENGTH/step)
 
@@ -273,5 +273,5 @@
               if (hp%rho(tp) < 0) then
                 ! Use equivalent volume spheres.
-                hp%rho_eff(tp,1:ns,iRe_type) = 917  				! solid ice == equivalent volume approach
+                hp%rho_eff(tp,1:ns,iRe_type) = 917                  ! solid ice == equivalent volume approach
                 Deq = ( ( 6/pi*hp%apm(tp)/917 ) ** (1.0/3.0) ) * ( (Di*1E-6) ** (hp%bpm(tp)/3.0) )  * 1E6
                 ! alternative is to comment out above two lines and use the following block
@@ -362,8 +362,8 @@
           endif
 
-        enddo	! end loop of tp (hydrometeor type)
+        enddo    ! end loop of tp (hydrometeor type)
 
       else
-!     :: volume is hydrometeor-free	
+!     :: volume is hydrometeor-free
         kr_vol(pr,k) = 0
         z_vol(pr,k)  = undef
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_init.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_init.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_init.F90	(revision 5158)
@@ -60,5 +60,5 @@
    integer, intent(in) :: nhclass       ! number of hydrometeor classes in use
    integer, intent(in) :: use_gas_abs,do_ray
-   real :: undef
+   REAL :: undef
    real,dimension(nhclass),intent(in)     ::    hclass_dmin,hclass_dmax, &
                                 hclass_apm,hclass_bpm,hclass_rho, &
@@ -90,5 +90,5 @@
         ! Store settings for hydrometeor types in hp (class_parameter) structure.   
 
-        do i = 1,nhclass
+        DO i = 1,nhclass
         hp%dtype(i) = hclass_type(i)
         hp%phase(i) = hclass_phase(i)
@@ -117,5 +117,5 @@
 
     hp%base_list(1)=0;
-    do j=1,Re_MAX_BIN
+    DO j=1,Re_MAX_BIN
         hp%step_list(j)=0.1+0.1*((j-1)**1.5);
         if(hp%step_list(j)>Re_BIN_LENGTH) then
@@ -129,9 +129,9 @@
     ! set up Temperature bin structure used for z scaling
 
-    do i=1,cnt_ice
+    DO i=1,cnt_ice
         hp%mt_tti(i)=(i-1)*5-90 + 273.15
     enddo
     
-    do i=1,cnt_liq
+    DO i=1,cnt_liq
         hp%mt_ttl(i)=(i-1)*5-60 + 273.15
     enddo 
@@ -143,5 +143,5 @@
 
         hp%D(1) = dmin
-        do i=2,nd
+        DO i=2,nd
           hp%D(i) = hp%D(i-1)*deltp
         enddo   
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_types.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_types.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator_types.F90	(revision 5158)
@@ -45,9 +45,9 @@
     
     ! defines location of radar relative to hgt_matrix.   
-    logical :: radar_at_layer_one	! if true radar is assume to be at the edge 
-    					! of the first layer, if the first layer is the
-    					! surface than a ground-based radar.   If the
-    					! first layer is the top-of-atmosphere, then
-    					! a space borne radar. 
+    logical :: radar_at_layer_one    ! if true radar is assume to be at the edge
+                        ! of the first layer, if the first layer is the
+                        ! surface than a ground-based radar.   If the
+                        ! first layer is the top-of-atmosphere, then
+                        ! a space borne radar.
     
     ! variables used to store Z scale factors
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/scale_luts_io.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/scale_luts_io.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/scale_luts_io.F90	(revision 5158)
@@ -42,7 +42,7 @@
         trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
     
-            do i=1,maxhclass
-            do j=1,mt_ntt
-            do k=1,nRe_types
+            DO i=1,maxhclass
+            DO j=1,mt_ntt
+            DO k=1,nRe_types
         
             ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
@@ -95,7 +95,7 @@
         trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
     
-        do i=1,maxhclass
-        do j=1,mt_ntt
-        do k=1,nRe_types
+        DO i=1,maxhclass
+        DO j=1,mt_ntt
+        DO k=1,nRe_types
         
             ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/zeff.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/zeff.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/zeff.F90	(revision 5158)
@@ -110,5 +110,5 @@
     sizep = (pi*D0)/wl
     dqv(1) = 0.
-    do i=1,nsizes
+    DO i=1,nsizes
       call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
         dg, xs1, xs2, dph, err)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/MISR_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/MISR_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/MISR_simulator.F90	(revision 5158)
@@ -78,9 +78,9 @@
     box_MISR_ztop(1:npoints,1:ncol) = 0._wp  
 
-    do j=1,npoints
+    DO j=1,npoints
 
        ! Estimate distribution of Model layer tops
        dist_model_layertops(j,:)=0
-       do ilev=1,nlev
+       DO ilev=1,nlev
           ! Define location of "layer top"
           if(ilev.eq.1 .or. ilev.eq.nlev) then
@@ -93,5 +93,5 @@
           ! *NOTE* the first MISR level is "no height" level
           iMISR_ztop=2
-          do loop=2,numMISRHgtBins
+          DO loop=2,numMISRHgtBins
              if ( ztest .gt. 1000*misr_histHgt(loop+1) ) then
                 iMISR_ztop=loop+1
@@ -103,10 +103,10 @@
 
        ! For each GCM cell or horizontal model grid point   
-       do ibox=1,ncol
+       DO ibox=1,ncol
           ! Compute optical depth as a cummulative distribution in the vertical (nlev).
           tauOUT(j,ibox)=sum(dtau(j,ibox,1:nlev))
 
           thres_crossed_MISR=0
-          do ilev=1,nlev
+          DO ilev=1,nlev
              ! If there a cloud, start the counter and store this height
              if(thres_crossed_MISR .eq. 0 .and. dtau(j,ibox,ilev) .gt. 0.) then
@@ -187,5 +187,5 @@
     ! This setup assumes the columns represent a about a 1 to 4 km scale
     ! it will need to be modified significantly, otherwise
-!	! DS2015: Add loop over gridpoints and index accordingly.
+!    ! DS2015: Add loop over gridpoints and index accordingly.
 !    if(ncol.eq.1) then
 !       ! Adjust based on neightboring points.
@@ -214,5 +214,5 @@
      
     ! Fill dark scenes 
-    do j=1,numMISRHgtBins
+    DO j=1,numMISRHgtBins
        where(sunlit .ne. 1) dist_model_layertops(1:npoints,j) = R_UNDEF
     enddo
@@ -254,5 +254,5 @@
     tauWRK(1:npoints,1:ncol)                      = tau(1:npoints,1:ncol)
     box_MISR_ztopWRK(1:npoints,1:ncol)            = box_MISR_ztop(1:npoints,1:ncol)
-    do j=1,npoints
+    DO j=1,npoints
 
        ! Subcolumns that are cloudy(true) and not(false)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp.F90	(revision 5158)
@@ -190,5 +190,5 @@
      real(wp),dimension(:),pointer :: &
           isccp_totalcldarea => null(), & ! The fraction of model grid box columns with cloud 
-           		                  ! somewhere in them. (%)
+                                     ! somewhere in them. (%)
           isccp_meantb => null(),       & ! Mean all-sky 10.5 micron brightness temperature. (K)
           isccp_meantbclr => null(),    & ! Mean clear-sky 10.5 micron brightness temperature. (K)
@@ -203,5 +203,5 @@
                                           ! the 49 ISCCP D level cloud types. (%)
      
-     ! MISR outptus  			    
+     ! MISR outptus
      real(wp),dimension(:,:,:),pointer ::   & !
           misr_fq => null()          ! Fraction of the model grid box covered by each of the MISR 
@@ -211,7 +211,7 @@
      real(wp),dimension(:),pointer ::   & !
           misr_meanztop => null(), & ! Mean MISR cloud top height
-          misr_cldarea => null()     ! Mean MISR cloud cover area         			    
-
-     ! MODIS outptus		    
+          misr_cldarea => null()     ! Mean MISR cloud cover area
+
+     ! MODIS outptus
      real(wp),pointer,dimension(:) ::      & !  
           modis_Cloud_Fraction_Total_Mean => null(),       & ! L3 MODIS retrieved cloud fraction (total) 
@@ -233,5 +233,5 @@
           modis_Ice_Water_Path_Mean => null()                ! L3 MODIS retrieved ice water path
      real(wp),pointer,dimension(:,:,:) ::  &
-          modis_Optical_Thickness_vs_Cloud_Top_Pressure => null(), & ! Tau/Pressure joint histogram          			    
+          modis_Optical_Thickness_vs_Cloud_Top_Pressure => null(), & ! Tau/Pressure joint histogram
           modis_Optical_Thickness_vs_ReffICE => null(),            & ! Tau/ReffICE joint histogram
           modis_Optical_Thickness_vs_ReffLIQ => null()               ! Tau/ReffLIQ joint histogram
@@ -239,5 +239,5 @@
      ! RTTOV outputs
      real(wp),pointer :: &
-          rttov_tbs(:,:) => null() ! Brightness Temperature	    
+          rttov_tbs(:,:) => null() ! Brightness Temperature
      
   end type cosp_outputs
@@ -683,5 +683,5 @@
        allocate(parasolPix_refl(parasolIN%Npoints,parasolIN%Ncolumns,PARASOL_NREFL))
        ! Call simulator
-       do icol=1,parasolIN%Ncolumns
+       DO icol=1,parasolIN%Ncolumns
           call parasol_subcolumn(parasolIN%npoints, PARASOL_NREFL,                       &
                                  parasolIN%tautot_S_liq(1:parasolIN%Npoints,icol),       &
@@ -700,5 +700,5 @@
        ! Allocate space for local variables
        allocate(cloudsatDBZe(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels))
-       do icol=1,cloudsatIN%ncolumns
+       DO icol=1,cloudsatIN%ncolumns
           call quickbeam_subcolumn(cloudsatIN%rcfg,cloudsatIN%Npoints,cloudsatIN%Nlevels,&
                                    cloudsatIN%hgt_matrix/1000._wp,                       &
@@ -721,5 +721,5 @@
                    modisRetrievedCloudTopPressure(modisIN%nSunlit,modisIN%nColumns))
           ! Call simulator
-          do i = 1, modisIN%nSunlit
+          DO i = 1, modisIN%nSunlit
              call modis_subcolumn(modisIN%Ncolumns,modisIN%Nlevels,modisIN%pres(i,:),    &
                                   modisIN%tau(int(modisIN%sunlit(i)),:,:),               &
@@ -1367,5 +1367,5 @@
        ! Other grid requested. Constant vertical spacing with top at 20 km
        if (.not. luseCSATvgrid) zstep = 20000._wp/Nvgrid
-       do i=1,Nvgrid
+       DO i=1,Nvgrid
           vgrid_zl(Nlvgrid-i+1) = (i-1)*zstep
           vgrid_zu(Nlvgrid-i+1) = i*zstep
@@ -1726,5 +1726,5 @@
     endif
 
-	! RTTOV Inputs
+    ! RTTOV Inputs
     if (cospgridIN%zenang .lt. -90. .OR. cospgridIN%zenang .gt. 90) then
        nError=nError+1
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_calipso_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_calipso_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_calipso_interface.F90	(revision 5158)
@@ -80,5 +80,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !	END MODULE
+  !    END MODULE
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_CALIPSO_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_cloudsat_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_cloudsat_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_cloudsat_interface.F90	(revision 5158)
@@ -123,5 +123,5 @@
     ! Set up Re bin "structure" for z_scaling
     rcfg%base_list(1)=0
-    do j=1,Re_MAX_BIN
+    DO j=1,Re_MAX_BIN
        rcfg%step_list(j)=0.1_wp+0.1_wp*((j-1)**1.5)
        if(rcfg%step_list(j)>Re_BIN_LENGTH) then
@@ -143,5 +143,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !                              	  END MODULE
+  !                                    END MODULE
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_CLOUDSAT_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_config.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_config.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_config.F90	(revision 5158)
@@ -177,5 +177,5 @@
                                    1.0,      0.909013, 0.709554, 0.430405, 0.121567/),   &
                                    shape=(/PARASOL_NREFL,PARASOL_NTAU/)),                & 
-         ! LUT for ice particles         			     
+         ! LUT for ice particles
          rlumB = reshape(source=(/ 0.03,     0.03,     0.03,     0.03,     0.03,         &
                                    0.092170, 0.087082, 0.083325, 0.084935, 0.054157,     &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_interface_v1p4.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_interface_v1p4.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_interface_v1p4.F90	(revision 5158)
@@ -436,5 +436,5 @@
   end type cosp_modis  
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  ! TYPE cosp_misr	
+  ! TYPE cosp_misr
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   TYPE COSP_MISR
@@ -445,5 +445,5 @@
      real(wp),dimension(:,:,:),pointer ::   & !
         fq_MISR          ! Fraction of the model grid box covered by each of the MISR 
-          				 ! cloud types
+                           ! cloud types
      real(wp),dimension(:,:),pointer ::   & !
         MISR_dist_model_layertops !  
@@ -474,5 +474,5 @@
      real(wp),dimension(:),pointer :: &
         totalcldarea, & ! The fraction of model grid box columns with cloud somewhere in 
-          				  ! them.
+                            ! them.
         meantb,       & ! Mean all-sky 10.5 micron brightness temperature.
         meantbclr,    & ! Mean clear-sky 10.5 micron brightness temperature.
@@ -485,5 +485,5 @@
      real(wp),dimension(:,:,:),pointer :: &
         fq_isccp        ! The fraction of the model grid box covered by each of the 49 
-          			    ! ISCCP D level cloud types.
+                          ! ISCCP D level cloud types.
   END TYPE COSP_ISCCP
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -589,5 +589,5 @@
     ! Outputs from COSP2
     type(cosp_outputs),target :: cospOUT  ! NEW derived type output that contains all 
-    					                  ! simulator information
+                                          ! simulator information
     ! Local variables
     integer :: i
@@ -596,5 +596,5 @@
          start_idx,  & ! Starting index when looping over points
          end_idx,    & ! Ending index when looping over points
-         Nptsperit     ! Number of points for current iteration				                  
+         Nptsperit     ! Number of points for current iteration
     logical :: &
          lsingle=.true., & ! True if using MMF_v3_single_moment CLOUDSAT microphysical scheme (default)
@@ -606,5 +606,5 @@
     character(len=256),dimension(100) :: cosp_status
 
-#ifdef MMF_V3_SINGLE_MOMENT    					  
+#ifdef MMF_V3_SINGLE_MOMENT
     character(len=64) :: &
          cloudsat_micro_scheme = 'MMF_v3_single_moment'
@@ -680,5 +680,5 @@
     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     num_chunks = gbx%Npoints/gbx%Npoints_it+1
-    do i=1,num_chunks
+    DO i=1,num_chunks
        !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
        ! Determine indices for "chunking" (again, if necessary)
@@ -1011,7 +1011,7 @@
        frac_cv(1:npoints,1:gbx%Nlevels) = 0._wp
        prec_cv(1:npoints,1:gbx%Nlevels) = 0._wp
-       do j=1,npoints,1
-          do k=1,gbx%Nlevels,1
-             do i=1,gbx%Ncolumns,1
+       DO j=1,npoints,1
+          DO k=1,gbx%Nlevels,1
+             DO i=1,gbx%Ncolumns,1
                 if (sgx%frac_out(start_idx+j-1,i,gbx%Nlevels+1-k) == I_LSC)              &
                      frac_ls(j,k) = frac_ls(j,k)+1._wp
@@ -1050,5 +1050,5 @@
        Reff(:,:,:,:)     = 0._wp
        Np(:,:,:,:)       = 0._wp
-       do k=1,gbx%Ncolumns
+       DO k=1,gbx%Ncolumns
           ! Subcolumn cloud fraction
           column_frac_out = sgx%frac_out(start_idx:end_idx,k,:)
@@ -1096,6 +1096,6 @@
        ! the fraction-based values
        !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-       do k=1,gbx%Nlevels
-          do j=1,npoints
+       DO k=1,gbx%Nlevels
+          DO j=1,npoints
              ! Clouds
              if (frac_ls(j,k) .ne. 0.) then
@@ -1238,5 +1238,5 @@
     if (cfg%Lradar_sim) then
        allocate(g_vol(nPoints,gbx%Nlevels))
-       do ij=1,gbx%Ncolumns
+       DO ij=1,gbx%Ncolumns
           if (ij .eq. 1) then
              cmpGases = .true.
@@ -1558,7 +1558,7 @@
          trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
     
-    do i=1,maxhclass
-       do j=1,mt_ntt
-          do k=1,nRe_types
+    DO i=1,maxhclass
+       DO j=1,mt_ntt
+          DO k=1,nRe_types
              ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
              if(.not.LUT_file_exists .or. hp%Z_scale_added_flag(i,j,k)) then
@@ -1592,5 +1592,5 @@
     ! Local variables
     integer :: i
-    real :: zstep
+    REAL :: zstep
     
     x%use_vgrid  = use_vgrid
@@ -1629,5 +1629,5 @@
           zstep = 20000.0/x%Nlvgrid
        endif
-       do i=1,x%Nlvgrid
+       DO i=1,x%Nlvgrid
           x%zl(i) = (i-1)*zstep
           x%zu(i) = i*zstep
@@ -1858,5 +1858,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !  					SUBROUTINE construct_cosp_misr
+  !                      SUBROUTINE construct_cosp_misr
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   SUBROUTINE CONSTRUCT_COSP_MISR(Npoints,x)
@@ -1968,5 +1968,5 @@
   END SUBROUTINE destroy_cosp_modis  
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !           					 SUBROUTINE construct_cosp_rttov
+  !                                SUBROUTINE construct_cosp_rttov
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   SUBROUTINE CONSTRUCT_COSP_RTTOV(Npoints,Nchan,x)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_isccp_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_isccp_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_isccp_interface.F90	(revision 5158)
@@ -67,5 +67,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !  							SUBROUTINE cosp_isccp_init
+  !                              SUBROUTINE cosp_isccp_init
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   SUBROUTINE COSP_ISCCP_INIT(top_height,top_height_direction)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_misr_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_misr_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_misr_interface.F90	(revision 5158)
@@ -36,5 +36,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  ! 								TYPE misr_in
+  !                                 TYPE misr_in
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   type misr_IN
@@ -56,5 +56,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !  							SUBROUTINE cosp_misr_init
+  !                              SUBROUTINE cosp_misr_init
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   SUBROUTINE COSP_MISR_INIT()
@@ -63,5 +63,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  ! 							    	END MODULE
+  !                                     END MODULE
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_MISR_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_optics.F90	(revision 5158)
@@ -69,5 +69,5 @@
     
     varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
-    do j=1,dim2
+    DO j=1,dim2
        where(flag(:,j,:) .eq. 1)
           varOUT(:,j,:) = varIN2
@@ -133,5 +133,5 @@
     
     
-    do i=1,npoints
+    DO i=1,npoints
        where(cloudIce(i,:, :) <= 0.) 
           fracL(:, :) = 1._wp
@@ -168,6 +168,6 @@
     w0(1:nPoints,1:nSubCols,1:nLevels) = 0._wp
     
-    do j =1,nPoints
-       do i=1,nSubCols
+    DO j =1,nPoints
+       DO i=1,nSubCols
           water_g(1:nLevels)  = get_g_nir(  phaseIsLiquid, sizeLIQ(j,i,1:nLevels)) 
           water_w0(1:nLevels) = get_ssa_nir(phaseIsLiquid, sizeLIQ(j,i,1:nLevels))
@@ -187,5 +187,5 @@
     
     ! Compute the total optical thickness and the proportion due to liquid in each cell
-    do i=1,npoints
+    DO i=1,npoints
        where(tauLIQ(i,1:nSubCols,1:nLevels) + tauICE(i,1:nSubCols,1:nLevels) > 0.) 
           fracLIQ(i,1:nSubCols,1:nLevels) = tauLIQ(i,1:nSubCols,1:nLevels)/ &
@@ -317,5 +317,5 @@
     ! Altitude at half pressure levels:
     zheight(1:npoints,nlev+1) = 0._wp
-    do k=nlev,1,-1
+    DO k=nlev,1,-1
        zheight(1:npoints,k) = zheight(1:npoints,k+1) &
             -(presf(1:npoints,k)-presf(1:npoints,k+1))/(rhoair(1:npoints,k)*grav)
@@ -349,5 +349,5 @@
     ! ##############################################################################
     ! Polynomials kp_lidar derived from Mie theory
-    do i = 1, npart
+    DO i = 1, npart
        where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
           kp_part(1:npoints,1:nlev,i) = &
@@ -363,5 +363,5 @@
     
     ! Loop over all subcolumns
-    do icol=1,ncolumns
+    DO icol=1,ncolumns
        ! ##############################################################################
        ! Mixing ratio particles in each subcolum
@@ -376,5 +376,5 @@
        ! ##############################################################################
        ! Alpha of particles in each subcolumn:
-       do i = 1, npart
+       DO i = 1, npart
           where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
              alpha_part(1:npoints,icol,1:nlev,i) = 3._wp/4._wp * Qscat &
@@ -388,10 +388,10 @@
        ! Optical thicknes
        tau_part(1:npoints,icol,1:nlev,1:npart) = rdiffm * alpha_part(1:npoints,icol,1:nlev,1:npart)
-       do i = 1, npart
+       DO i = 1, npart
           ! Optical thickness of each layer (particles)
           tau_part(1:npoints,icol,1:nlev,i) = tau_part(1:npoints,icol,1:nlev,i) &
                & * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
           ! Optical thickness from TOA to layer k (particles)
-          do k=2,nlev
+          DO k=2,nlev
              tau_part(1:npoints,icol,k,i) = tau_part(1:npoints,icol,k,i) + tau_part(1:npoints,icol,k-1,i)
           enddo
@@ -434,5 +434,5 @@
     tautot_S_liq(1:npoints,1:ncolumns) = 0._wp
     tautot_S_ice(1:npoints,1:ncolumns) = 0._wp
-    do icol=1,ncolumns    
+    DO icol=1,ncolumns
        tautot_S_liq(1:npoints,icol) = tautot_S_liq(1:npoints,icol)+tau_part(1:npoints,icol,nlev,1)+tau_part(1:npoints,icol,nlev,3)
        tautot_S_ice(1:npoints,icol) = tautot_S_ice(1:npoints,icol)+tau_part(1:npoints,icol,nlev,2)+tau_part(1:npoints,icol,nlev,4)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_mod.F90	(revision 5158)
@@ -75,5 +75,5 @@
          "clmcalipsoice", "CALIPSO Ice-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))	 	 
+         "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 
          "clhcalipsoice", "CALIPSO Ice-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /))  
@@ -83,5 +83,5 @@
          "cltcalipsoice", "CALIPSO Ice-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))	 	 
+         "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 
          "cllcalipsoun", "CALIPSO Undefined-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /))  
@@ -97,5 +97,5 @@
          "clcalipsoliq", "Lidar Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))	 
+         "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "clcalipsotmpice", "Lidar Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
@@ -118,7 +118,7 @@
          "clcalipsothin", "Lidar Thin profile Cloud Fraction", "%", (/ ('', i=1, 3) /))         !OPAQ
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsozopaque = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
-         "clcalipsozopaque", "Lidar z_opaque Fraction", "%", (/ ('', i=1, 3) /))	        !OPAQ
+         "clcalipsozopaque", "Lidar z_opaque Fraction", "%", (/ ('', i=1, 3) /))            !OPAQ
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsoopacity = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
-         "clcalipsoopacity", "Lidar opacity Fraction", "%", (/ ('', i=1, 3) /))	                !OPAQ
+         "clcalipsoopacity", "Lidar opacity Fraction", "%", (/ ('', i=1, 3) /))                    !OPAQ
 
   TYPE(ctrl_outcosp), SAVE :: o_proftemp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &         !TIBO
@@ -254,5 +254,5 @@
   integer                  :: Nlevlmdz, Ncolumns      ! Number of levels
   real,dimension(Nlevlmdz) :: presnivs
-  real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth 
+  REAL                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
   logical                  :: use_vgrid
   logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
@@ -262,5 +262,5 @@
 !!! Variables locales
   integer                   :: idayref, iff, ii
-  real                      :: zjulian,zjulian_start
+  REAL                      :: zjulian,zjulian_start
   real(wp),dimension(Ncolumns)  :: column_ax
   real(wp),dimension(DBZE_BINS) ::  dbze_ax
@@ -283,9 +283,9 @@
 
 !! Definition valeurs axes
-    do ii=1,Ncolumns
+    DO ii=1,Ncolumns
       column_ax(ii) = real(ii)
     enddo
 
-    do i=1,DBZE_BINS
+    DO i=1,DBZE_BINS
      dbze_ax(i) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(i - 0.5)
     enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_output_write_mod.F90	(revision 5158)
@@ -41,5 +41,5 @@
 !!! Variables d'entree
   integer               :: itap, Nlevlmdz, Ncolumns, Npoints
-  real                  :: freq_COSP, dtime, missing_val, missing_cosp
+  REAL                  :: freq_COSP, dtime, missing_val, missing_cosp
   type(cosp_config)     :: cfg     ! Control outputs
   type(cosp_gridbox)    :: gbx     ! Gridbox information. Input for COSP
@@ -172,5 +172,5 @@
   IF (using_xios) THEN
 
-    do icl=1,SR_BINS
+    DO icl=1,SR_BINS
       tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
     enddo
@@ -180,5 +180,5 @@
   ELSE
     if (cfg%LcfadLidarsr532) then
-      do icl=1,SR_BINS
+      DO icl=1,SR_BINS
         CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
       enddo
@@ -194,6 +194,6 @@
 
   if (cfg%LparasolRefl) then 
-    do k=1,PARASOL_NREFL
-     do ip=1, Npoints
+    DO k=1,PARASOL_NREFL
+     DO ip=1, Npoints
       if (stlidar%cldlayer(ip,4).gt.1.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
         parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)/100.))/ &
@@ -215,5 +215,5 @@
   ELSE
     if (cfg%Latb532) then  
-      do icl=1,Ncolumns 
+      DO icl=1,Ncolumns
         CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
       enddo
@@ -230,5 +230,5 @@
    where(stradar%cfad_ze == R_UNDEF) stradar%cfad_ze = missing_val
   IF (using_xios) THEN
-    do icl=1,DBZE_BINS
+    DO icl=1,DBZE_BINS
       tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
     enddo
@@ -238,10 +238,10 @@
   ELSE
     if (cfg%Ldbze94) then
-      do icl=1,Ncolumns
+      DO icl=1,Ncolumns
         CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
       enddo
      endif
      if (cfg%LcfadDbze94) then
-       do icl=1,DBZE_BINS
+       DO icl=1,DBZE_BINS
          CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
        enddo
@@ -278,5 +278,5 @@
   ELSE
     if (cfg%Lclisccp) then
-      do icl=1,7
+      DO icl=1,7
         CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl) 
       enddo
@@ -299,5 +299,5 @@
 
   IF (using_xios) THEN
-    do icl=1,numMISRHgtBins
+    DO icl=1,numMISRHgtBins
       tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
     enddo
@@ -306,5 +306,5 @@
   ELSE
     if (cfg%LclMISR) then
-      do icl=1,7 
+      DO icl=1,7
         CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
       enddo
@@ -379,5 +379,5 @@
   ELSE
     if (cfg%Lclmodis) then
-     do icl=1,7
+     DO icl=1,7
        CALL histwrite3d_cosp(o_clmodis, &
          modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
@@ -397,5 +397,5 @@
     ELSE
       if (cfg%Lclmodis) then
-        do icl=1,7
+        DO icl=1,7
           CALL histwrite3d_cosp(o_crimodis, &
              modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
@@ -403,5 +403,5 @@
       endif
       if (cfg%Lclmodis) then
-        do icl=1,7 
+        DO icl=1,7
            CALL histwrite3d_cosp(o_crlmodis, &
               modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_parasol_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_parasol_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_parasol_interface.F90	(revision 5158)
@@ -35,5 +35,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !									TYPE cosp_parasol
+  !                                    TYPE cosp_parasol
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   TYPE PARASOL_SGX
@@ -63,5 +63,5 @@
   END TYPE COSP_PARASOL
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !										TYPE parasol_in
+  !                                        TYPE parasol_in
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   TYPE parasol_IN
@@ -86,5 +86,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  ! 								    END MODULE
+  !                                     END MODULE
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 end module MOD_COSP_PARASOL_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_read_otputkeys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_read_otputkeys.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_read_otputkeys.F90	(revision 5158)
@@ -29,5 +29,5 @@
 
                 
-   do i=1,78
+   DO i=1,78
       cfg%out_list(i)=''
    enddo
@@ -132,5 +132,5 @@
 
 
-   do i=1,78
+   DO i=1,78
       cfg%out_list(i)=''
    enddo
@@ -271,5 +271,5 @@
              LprofSR,Lproftemp                                                                        !TIBO (2)
    
-  do i=1,78
+  DO i=1,78
     cfg%out_list(i)=''
   enddo
@@ -780,5 +780,5 @@
  IF (using_xios) THEN
 
-  do i=1,78
+  DO i=1,78
     cfg%out_list(i)=''
   enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_stats.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_stats.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_stats.F90	(revision 5158)
@@ -80,5 +80,5 @@
    r = 0._wp
 
-   do i=1,Npoints
+   DO i=1,Npoints
      ! Calculate tops and bottoms of new and old grids
      oldgrid_bot = zhalf(i,:)
@@ -87,9 +87,9 @@
      l = 0 ! Index of level in the old grid
      ! Loop over levels in the new grid
-     do k = 1,Nglevels
+     DO k = 1,Nglevels
        Nw = 0 ! Number of weigths
        wt = 0._wp ! Sum of weights
        ! Loop over levels in the old grid and accumulate total for weighted average
-       do
+       DO
          l = l + 1
          w = 0.0 ! Initialise weight to 0
@@ -118,5 +118,5 @@
              Nw = Nw + 1
              wt = wt + w
-             do j=1,Ncolumns
+             DO j=1,Ncolumns
                if (lunits) then
                  if (y(i,j,l) /= R_UNDEF) then
@@ -137,5 +137,5 @@
        ! Calculate average in new grid
        if (Nw > 0) then
-         do j=1,Ncolumns
+         DO j=1,Ncolumns
            r(i,j,k) = r(i,j,k)/wt
          enddo
@@ -145,7 +145,7 @@
 
    ! Set points under surface to R_UNDEF, and change to dBZ if necessary
-   do k=1,Nglevels
-     do j=1,Ncolumns
-       do i=1,Npoints
+   DO k=1,Nglevels
+     DO j=1,Ncolumns
+       DO i=1,Npoints
          if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level
            if (lunits) then
@@ -197,9 +197,9 @@
     lidar_only_freq_cloud = 0._wp
     tcc = 0._wp
-    do pr=1,Npoints
-       do i=1,Ncolumns
+    DO pr=1,Npoints
+       DO i=1,Ncolumns
           flag_sat = 0
           flag_cld = 0
-          do j=1,Nlevels
+          DO j=1,Nlevels
              sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
              if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
@@ -244,5 +244,5 @@
     integer :: ij
     
-    do ij=2,Nbins+1  
+    DO ij=2,Nbins+1
        hist1D(ij-1) = count(var .ge. bins(ij-1) .and. var .lt. bins(ij))
        if (count(var .eq. R_GROUND) .ge. 1) hist1D(ij-1)=R_UNDEF
@@ -276,6 +276,6 @@
     integer :: ij,ik
     
-    do ij=2,nbin1+1
-       do ik=2,nbin2+1
+    DO ij=2,nbin1+1
+       DO ik=2,nbin2+1
           jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
                var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))        
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_utils.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_utils.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp_utils.F90	(revision 5158)
@@ -67,7 +67,7 @@
         delta = (alpha_x + b_x + d_x - n_bx + 1._wp)
         
-        do k=1,Nlevels
-            do j=1,Ncolumns
-                do i=1,Npoints
+        DO k=1,Nlevels
+            DO j=1,Ncolumns
+                DO i=1,Npoints
                     if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
                         rho = p(i,k)/(287.05_wp*T(i,k))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/icarus.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/icarus.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/icarus.F90	(revision 5158)
@@ -135,8 +135,8 @@
     
     if (debugcol.ne.0) then
-       do j=1,npoints,debugcol
+       DO j=1,npoints,debugcol
           
           ! Produce character output
-          do ilev=1,nlev
+          DO ilev=1,nlev
              acc(ilev,1:ncol)=frac_out(j,1:ncol,ilev)*2
              where(levmatch(j,1:ncol) .eq. ilev) acc(ilev,1:ncol)=acc(ilev,1:ncol)+1
@@ -151,5 +151,5 @@
           write(9,'(a1)') ' '
           
-          do ibox=1,ncol
+          DO ibox=1,ncol
              write(9,'(40(a1),1x,40(a1))') &
                   (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev),&
@@ -231,5 +231,5 @@
        itrop(1:npoints)     = 1
 
-       do ilev=1,nlev
+       DO ilev=1,nlev
           where(pfull(1:npoints,ilev) .lt. 40000. .and. &
                 pfull(1:npoints,ilev) .gt.  5000. .and. &
@@ -242,5 +242,5 @@
        enddo
 
-       do ilev=1,nlev
+       DO ilev=1,nlev
           atmax(1:npoints) = merge(at(1:npoints,ilev),atmax(1:npoints),&
                at(1:npoints,ilev) .gt. atmax(1:npoints) .and. ilev  .ge. itrop(1:npoints))
@@ -256,5 +256,5 @@
        ! at a wavenumber of 955 cm-1, or 10.47 microns 
        ! ############################################################################
-       do ilev=1,nlev
+       DO ilev=1,nlev
           press(1:npoints)  = pfull(1:npoints,ilev)*10._wp
           dpress(1:npoints) = (phalf(1:npoints,ilev+1)-phalf(1:npoints,ilev))*10
@@ -273,5 +273,5 @@
        fluxtop_clrsky(1:npoints)            = 0._wp
        trans_layers_above_clrsky(1:npoints) = 1._wp
-       do ilev=1,nlev
+       DO ilev=1,nlev
           ! Black body emission at temperature of the layer
           bb(1:npoints) = 1._wp / ( exp(1307.27_wp/at(1:npoints,ilev)) - 1._wp )
@@ -300,9 +300,9 @@
        fluxtop(1:npoints,1:ncol)            = 0._wp
        trans_layers_above(1:npoints,1:ncol) = 1._wp
-       do ilev=1,nlev
+       DO ilev=1,nlev
           ! Black body emission at temperature of the layer
           bb=1._wp/(exp(1307.27_wp/at(1:npoints,ilev)) - 1._wp)
           
-          do ibox=1,ncol
+          DO ibox=1,ncol
              ! Emissivity
              dem(1:npoints,ibox) = merge(dem_wv(1:npoints,ilev), &
@@ -320,5 +320,5 @@
        ! Add in surface emission
        bb(1:npoints)=1._wp/( exp(1307.27_wp/skt(1:npoints)) - 1._wp )
-       do ibox=1,ncol
+       DO ibox=1,ncol
           fluxtop(1:npoints,ibox) = fluxtop(1:npoints,ibox) + emsfc_lw*bb(1:npoints)*trans_layers_above(1:npoints,ibox) 
        end do
@@ -344,10 +344,10 @@
        btcmin(1:npoints) = 1._wp /  ( exp(1307.27_wp/(attrop(1:npoints)-5._wp)) - 1._wp ) 
 
-       do ibox=1,ncol
+       DO ibox=1,ncol
           transmax(1:npoints) = (fluxtop(1:npoints,ibox)-btcmin) /(fluxtop_clrsky(1:npoints)-btcmin(1:npoints))
           tauir(1:npoints)    = tau(1:npoints,ibox)/2.13_wp
           taumin(1:npoints)   = -log(max(min(transmax(1:npoints),0.9999999_wp),0.001_wp))
           if (isccp_top_height .eq. 1) then
-             do j=1,npoints  
+             DO j=1,npoints
                 if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
                    fluxtopinit(j) = fluxtop(j,ibox)
@@ -355,6 +355,6 @@
                 endif
              enddo
-             do icycle=1,2
-                do j=1,npoints  
+             DO icycle=1,2
+                DO j=1,npoints
                    if (tau(j,ibox) .gt. (tauchk)) then 
                       if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
@@ -397,5 +397,5 @@
     ! pressure (isccp_top_height = 1 or 3)
     ! ####################################################################################
-    do ibox=1,ncol
+    DO ibox=1,ncol
        !segregate according to optical thickness
        if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then  
@@ -403,7 +403,7 @@
           ! Find level whose temperature most closely matches brightness temperature
           nmatch(1:npoints)=0
-          do k1=1,nlev-1
+          DO k1=1,nlev-1
              ilev = merge(nlev-k1,k1,isccp_top_height_direction .eq. 2)        
-             do j=1,npoints 
+             DO j=1,npoints
                 if (ilev           .ge. itrop(j)     .and. &
                      ((at(j,ilev)  .ge. tb(j,ibox)   .and. &  
@@ -417,5 +417,5 @@
           enddo
 
-          do j=1,npoints 
+          DO j=1,npoints
              if (nmatch(j) .ge. 1) then
                 k1 = match(j,nmatch(j))
@@ -440,5 +440,5 @@
        else
           ptop(1:npoints,ibox)=0.
-          do ilev=1,nlev
+          DO ilev=1,nlev
              where((ptop(1:npoints,ibox) .eq. 0. ) .and.(frac_out(1:npoints,ibox,ilev) .ne. 0))
                 ptop(1:npoints,ibox)=phalf(1:npoints,ilev)
@@ -458,6 +458,6 @@
     boxtau(1:npoints,1:ncol)  = output_missing_value
     boxptop(1:npoints,1:ncol) = output_missing_value
-    do ibox=1,ncol
-       do j=1,npoints 
+    DO ibox=1,ncol
+       DO j=1,npoints
           if (tau(j,ibox) .gt. (tauchk) .and. ptop(j,ibox) .gt. 0.) then
              if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
@@ -532,10 +532,10 @@
     ! Reset frequencies
     !fq_isccp = spread(spread(merge(0._wp,output_missing_value,sunlit .eq. 1 .or. isccp_top_height .eq. 3),2,7),2,7)
-    do ilev=1,7
-       do ilev2=1,7
-          do j=1,npoints ! 
+    DO ilev=1,7
+       DO ilev2=1,7
+          DO j=1,npoints !
              if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then 
                 fq_isccp(j,ilev,ilev2)= 0.
-	     else 
+         else
                 fq_isccp(j,ilev,ilev2)= output_missing_value
              end if
@@ -559,5 +559,5 @@
     
     ! Compute column quantities and joint-histogram
-    do j=1,npoints 
+    DO j=1,npoints
        ! Subcolumns that are cloudy(true) and not(false)
        box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) .gt. tauchk .and. boxptop(j,1:ncol) .gt. 0.)
@@ -633,5 +633,5 @@
     
     varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
-    do j=1,dim2
+    DO j=1,dim2
        where(flag(:,j,:) .eq. 1)
           varOUT(:,j,:) = varIN2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/lidar_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/lidar_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/lidar_simulator.F90	(revision 5158)
@@ -142,5 +142,5 @@
     ! PLANE PARRALLEL FIELDS
     ! ####################################################################################
-    do icol=1,ncolumns
+    DO icol=1,ncolumns
        ! #################################################################################
        ! *) Total Backscatter signal
@@ -165,5 +165,5 @@
     ! PERDENDICULAR FIELDS
     ! ####################################################################################
-    do icol=1,ncolumns
+    DO icol=1,ncolumns
 
        ! #################################################################################
@@ -172,5 +172,5 @@
        ! Computation of ATBperp,ice/liq from ATBice/liq including the multiple scattering 
        ! contribution (Cesana and Chepfer 2013, JGR)
-       do k=1,nlev
+       DO k=1,nlev
           ! Ice particles
           pnorm_perp_ice(1:npoints,icol,k) = Alpha * pnorm_ice(1:npoints,icol,k)
@@ -208,5 +208,5 @@
              
        ! Other layers
-       do k=2,nlev
+       DO k=2,nlev
           ! Optical thickness of layer k
           tautot_lay(1:npoints) = tautot(1:npoints,icol,k)-tautot(1:npoints,icol,k-1) 
@@ -316,5 +316,5 @@
     ! Compute LIDAR scattering ratio
     if (use_vgrid) then
-       do ic = 1, ncol
+       DO ic = 1, ncol
           pnorm_c = pnormFlip(:,ic,:)
           where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
@@ -331,5 +331,5 @@
                          lidarcld,cldlayer,lidarcldphase,cldlayerphase,lidarcldtmp)                           
     else
-       do ic = 1, ncol
+       DO ic = 1, ncol
           pnorm_c = pnorm(:,ic,:)
           where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
@@ -349,6 +349,6 @@
     if (ok_lidar_cfad) then
        ! CFADs of subgrid-scale lidar scattering ratios
-       do i=1,Npoints
-          do j=1,llm
+       DO i=1,Npoints
+          DO j=1,llm
              cfad2(i,:,j) = hist1D(ncol,x3d(i,:,j),SR_BINS,calipso_histBsct)
           enddo
@@ -387,5 +387,5 @@
 
     ! Other layers
-    do k=2,nlev
+    DO k=2,nlev
        tautot_lay(:) = tau(:,k)-tau(:,k-1) 
        WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. 0. )
@@ -416,5 +416,5 @@
 
     beta(:,1) = pnorm(:,1) * (2._wp*tau(:,1))/(1._wp-exp(-2._wp*tau(:,1)))
-    do k=2,nlev
+    DO k=2,nlev
        tautot_lay(:) = tau(:,k)-tau(:,k-1)       
        WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. 0. )
@@ -458,5 +458,5 @@
        zeta50    = -9.4776e-07_wp    ! 
        
-	! Inputs
+    ! Inputs
     integer,intent(in) :: &
        Npoints,  & ! Number of gridpoints
@@ -465,5 +465,5 @@
        Ncat,     & ! Number of cloud layer types
        Nphase      ! Number of cloud layer phase types
-	               ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
+                   ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
     real(wp),intent(in) :: &
        S_att,    & !
@@ -479,5 +479,5 @@
        pplay       ! Pressure
 
-	! Outputs
+    ! Outputs
     real(wp),intent(out),dimension(Npoints,Ntemp,5) :: &
        lidarcldtemp  ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq
@@ -514,5 +514,5 @@
              
     ! ####################################################################################
-	! 1) Initialize    
+    ! 1) Initialize
     ! ####################################################################################
     lidarcld              = 0._wp
@@ -537,5 +537,5 @@
     ! 2) Cloud detection
     ! ####################################################################################
-    do k=1,Nlevels
+    DO k=1,Nlevels
        ! Cloud detection at subgrid-scale:
        where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
@@ -560,12 +560,12 @@
     cldlay   = 0._wp
     nsublay  = 0._wp
-    do k=1,Nlevels
-       do ic = 1, Ncolumns
-          do ip = 1, Npoints
+    DO k=1,Nlevels
+       DO ic = 1, Ncolumns
+          DO ip = 1, Npoints
           
              ! Computation of the cloud fraction as a function of the temperature instead
              ! of height, for ice,liquid and all clouds
              if(srok(ip,ic,k).gt.0.)then
-                do itemp=1,Ntemp
+                DO itemp=1,Ntemp
                    if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
                       lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1._wp
@@ -575,5 +575,5 @@
              
              if(cldy(ip,ic,k).eq.1.)then
-                do itemp=1,Ntemp 
+                DO itemp=1,Ntemp
                    if( (tmp(ip,k) .ge. tempmod(itemp)).and.(tmp(ip,k) .lt. tempmod(itemp+1)) )then
                       lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1._wp
@@ -612,6 +612,6 @@
     cldlayer  = 0._wp
     nsublayer = 0._wp
-    do iz = 1, Ncat
-       do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO ic = 1, Ncolumns
           cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
@@ -631,7 +631,7 @@
     ! 4.1) For Cloudy pixels with 8.16km < z < 19.2km
     ! ####################################################################################
-    do ncol=1,Ncolumns
-       do i=1,Npoints          
-          do nlev=1,23 ! from 19.2km until 8.16km
+    DO ncol=1,Ncolumns
+       DO i=1,Npoints
+          DO nlev=1,23 ! from 19.2km until 8.16km
                p1 = pplay(1,nlev)
 
@@ -745,5 +745,5 @@
           ! ##############################################################################
           toplvlsat = 0
-          do nlev=24,Nlevels! from 8.16km until 0km
+          DO nlev=24,Nlevels! from 8.16km until 0km
              p1 = pplay(i,nlev)
 
@@ -868,5 +868,5 @@
           ! ##############################################################################
           if(toplvlsat.ne.0) then
-             do nlev = toplvlsat,Nlevels
+             DO nlev = toplvlsat,Nlevels
                 p1 = pplay(i,nlev)
                 if(cldy(i,ncol,nlev).eq.1.)then
@@ -920,7 +920,7 @@
 
     ! Compute Phase low mid high cloud fractions
-    do iz = 1, Ncat
-       do i=1,Nphase-3
-          do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO i=1,Nphase-3
+          DO ic = 1, Ncolumns
              cldlayerphase(:,iz,i)  = cldlayerphase(:,iz,i)  + cldlayphase(:,ic,iz,i)
              cldlayerphasesum(:,iz) = cldlayerphasesum(:,iz) + cldlayphase(:,ic,iz,i)
@@ -928,7 +928,7 @@
        enddo
     enddo
-    do iz = 1, Ncat
-       do i=4,5
-          do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO i=4,5
+          DO ic = 1, Ncolumns
              cldlayerphase(:,iz,i) = cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
           enddo
@@ -944,5 +944,5 @@
     ENDWHERE
     
-    do i=1,Nphase-1
+    DO i=1,Nphase-1
        WHERE ( cldlayerphasesum(:,:).gt.0.0 )
           cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
@@ -950,10 +950,10 @@
     enddo
     
-    do i=1,Npoints
-       do iz=1,Ncat
+    DO i=1,Npoints
+       DO iz=1,Ncat
           checkcldlayerphase=0.
           checkcldlayerphase2=0.
           if (cldlayerphasesum(i,iz) .gt. 0.0 )then
-             do ic=1,Nphase-3
+             DO ic=1,Nphase-3
                 checkcldlayerphase = checkcldlayerphase+cldlayerphase(i,iz,ic)
              enddo
@@ -964,5 +964,5 @@
     enddo
     
-    do i=1,Nphase-1
+    DO i=1,Nphase-1
        WHERE (nsublayer(:,:) .eq. 0.0)
           cldlayerphase(:,:,i) = undef
@@ -971,8 +971,8 @@
  
     ! Compute Phase 3D as a function of temperature
-    do nlev=1,Nlevels
-       do ncol=1,Ncolumns
-          do i=1,Npoints
-             do itemp=1,Ntemp
+    DO nlev=1,Nlevels
+       DO ncol=1,Ncolumns
+          DO i=1,Npoints
+             DO itemp=1,Ntemp
                 if(tmpi(i,ncol,nlev).gt.0.)then
                    if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
@@ -994,6 +994,6 @@
     
     ! Check temperature cloud fraction
-    do i=1,Npoints
-       do itemp=1,Ntemp
+    DO i=1,Npoints
+       DO itemp=1,Ntemp
           checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
           !if(checktemp .NE. lidarcldtemp(i,itemp,1))then
@@ -1013,5 +1013,5 @@
     ENDWHERE
     
-    do i=1,4
+    DO i=1,4
        WHERE(lidarcldtempind(:,:) .gt. 0.)
           lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/math_lib.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/math_lib.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/math_lib.F90	(revision 5158)
@@ -96,5 +96,5 @@
     else
        sumo = 0._wp
-       do j=i1,i2
+       DO j=i1,i2
           deltah = abs(s(i1+1)-s(i1))
           sumo = sumo + f(j)*deltah
@@ -204,5 +204,5 @@
     end if
     
-    do i = 2, ntab
+    DO i = 2, ntab
        if ( xtab(i) <= xtab(i-1) ) then
           lerror = .true.
@@ -239,5 +239,5 @@
     ihi = ntab
     
-    do i = 1, ntab
+    DO i = 1, ntab
        if ( a <= xtab(i) ) then
           exit
@@ -249,5 +249,5 @@
     ilo = min ( ilo, ntab - 1 )
     
-    do i = 1, ntab
+    DO i = 1, ntab
        if ( xtab(i) <= b ) then
           exit
@@ -263,5 +263,5 @@
 !ds    sum1 = 0.0D+00
     
-    do i = ilo, ihi
+    DO i = ilo, ihi
        
        x1 = xtab(i-1)
@@ -371,5 +371,5 @@
           ga=1._wp
           m1=x-1
-          do k=2,m1
+          DO k=2,m1
              ga=ga*k
           enddo
@@ -382,5 +382,5 @@
           m=int(z)
           r=1._wp
-          do k=1,m
+          DO k=1,m
              r=r*(z-k)
           enddo
@@ -390,5 +390,5 @@
        endif
        gr=g(26)
-       do k=25,1,-1
+       DO k=25,1,-1
           gr=gr*z+g(k)
        enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/modis_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/modis_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/modis_simulator.F90	(revision 5158)
@@ -163,5 +163,5 @@
     cloudMask = retrievedTau(1:nSubCols) >= min_OpticalThickness
     
-    do i = 1, nSubCols
+    DO i = 1, nSubCols
        if(cloudMask(i)) then 
           ! ##################################################################################
@@ -380,5 +380,5 @@
     reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
     reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
-    do j=1,nPoints
+    DO j=1,nPoints
 
        ! Fill clear and optically thin subcolumns with fill
@@ -439,5 +439,5 @@
     !   layers and use the trapezoidal rule.
     totalTau = 0._wp; totalProduct = 0._wp
-    do i = 2, size(tauIncrement)
+    DO i = 2, size(tauIncrement)
       if(totalTau + tauIncrement(i) > tauLimit) then 
         deltaX = tauLimit - totalTau
@@ -479,5 +479,5 @@
     ! Find the extinction-weighted value of f(tau), assuming constant f within each layer
     totalTau = 0._wp; totalProduct = 0._wp
-    do i = 1, size(tauIncrement)
+    DO i = 1, size(tauIncrement)
       if(totalTau + tauIncrement(i) > tauLimit) then 
         deltaX       = tauLimit - totalTau
@@ -713,5 +713,5 @@
     cloudMask(1:nLevels) = tau(1:nLevels) > 0. 
     cloudIndicies = pack((/ (i, i = 1, nLevels) /), mask = cloudMask) 
-    do i = 1, size(cloudIndicies)
+    DO i = 1, size(cloudIndicies)
        call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
     end do
@@ -893,5 +893,5 @@
     Tran_cumulative(1) = Tran(1)    
     
-    do i=2, npts
+    DO i=2, npts
        ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
        Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1._wp - Refl_cumulative(i-1) * Refl(i))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/optics_lib.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/optics_lib.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/optics_lib.F90	(revision 5158)
@@ -539,5 +539,5 @@
     if (alam < cutice) then
        ! Region from 0.045 microns to 167.0 microns - no temperature depend
-       do i=2,nwl
+       DO i=2,nwl
           if(alam < wl(i)) continue
        enddo
@@ -557,10 +557,10 @@
        if(tk > temref(1)) tk=temref(1)
        if(tk < temref(4)) tk=temref(4)
-       do i=2,4
+       DO i=2,4
           if(tk.ge.temref(i)) go to 12
        enddo
 12     lt1 = i
        lt2 = i-1
-       do i=2,nwlt
+       DO i=2,nwlt
           if(alam.le.wlt(i)) go to 14
        enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/parasol.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/parasol.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/parasol.F90	(revision 5158)
@@ -159,11 +159,11 @@
     ! Compute grid-box averaged Parasol reflectances
     parasolrefl(:,:) = 0._wp
-    do k = 1, nrefl
-       do ic = 1, ncol
+    DO k = 1, nrefl
+       DO ic = 1, ncol
           parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
        enddo
     enddo
     
-    do k = 1, nrefl
+    DO k = 1, nrefl
        parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
        ! if land=1 -> parasolrefl=R_UNDEF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/phys_cosp2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/phys_cosp2.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/phys_cosp2.F90	(revision 5158)
@@ -44,6 +44,6 @@
 ! mr_ozone,                             !Concentration ozone (Kg/Kg)
 ! dem_s                                 !Cloud optical emissivity
-! dtau_s               			!Cloud optical thickness
-! emsfc_lw = 1.        			!Surface emissivity dans radlwsw.F90
+! dtau_s                           !Cloud optical thickness
+! emsfc_lw = 1.                    !Surface emissivity dans radlwsw.F90
 
 !!! Outputs :
@@ -159,5 +159,5 @@
 ! Declaration necessaires pour les sorties IOIPSL
   integer :: ii
-  real    :: ecrit_day,ecrit_hf,ecrit_mth, missing_val
+  REAL    :: ecrit_day,ecrit_hf,ecrit_mth, missing_val
   logical :: ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, ok_all_xml
 
@@ -177,5 +177,5 @@
   real,dimension(Nlevlmdz)        :: presnivs
   integer                         :: itap,k,ip
-  real                            :: dtime,freq_cosp
+  REAL                            :: dtime,freq_cosp
   real,dimension(2)               :: time_bnds
 
@@ -312,6 +312,6 @@
 
         zlev_half(:,1) = phis(:)/9.81
-        do k = 2, Nlevels
-          do ip = 1, Npoints
+        DO k = 2, Nlevels
+          DO ip = 1, Npoints
            zlev_half(ip,k) = phi(ip,k)/9.81 + &
                (phi(ip,k)-phi(ip,k-1))/9.81 * (ph(ip,k)-p(ip,k)) / (p(ip,k)-p(ip,k-1))
@@ -330,5 +330,5 @@
         gbx%skt  = skt !Skin temperature (K)
 
-        do ip = 1, Npoints
+        DO ip = 1, Npoints
           if (fracTerLic(ip).ge.0.5) then
              gbx%land(ip) = 1.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/prec_scops.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/prec_scops.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/prec_scops.F90	(revision 5158)
@@ -66,7 +66,7 @@
       if (cv_col .eq. 0) cv_col=1
  
-      do ilev=1,nlev
-        do ibox=1,ncol
-          do j=1,npoints 
+      DO ilev=1,nlev
+        DO ibox=1,ncol
+          DO j=1,npoints
             prec_frac(j,ibox,ilev) = 0
           enddo
@@ -74,11 +74,11 @@
       enddo
       
-      do j=1,npoints
-       do ibox=1,ncol
+      DO j=1,npoints
+       DO ibox=1,ncol
         frac_out_ls(j,ibox)=0
         frac_out_cv(j,ibox)=0
         flag_ls=0
         flag_cv=0
-        do ilev=1,nlev
+        DO ilev=1,nlev
           if (frac_out(j,ibox,ilev) .eq. 1) then 
             flag_ls=1
@@ -98,10 +98,10 @@
 
 !      initialize the top layer      
-       do j=1,npoints
+       DO j=1,npoints
         flag_ls=0
         flag_cv=0
     
         if (ls_p_rate(j,1) .gt. 0.) then 
-            do ibox=1,ncol ! possibility ONE
+            DO ibox=1,ncol ! possibility ONE
                 if (frac_out(j,ibox,1) .eq. 1) then 
                     prec_frac(j,ibox,1) = 1
@@ -110,5 +110,5 @@
             enddo ! loop over ncol
             if (flag_ls .eq. 0) then ! possibility THREE
-                do ibox=1,ncol
+                DO ibox=1,ncol
                     if (frac_out(j,ibox,2) .eq. 1) then 
                         prec_frac(j,ibox,1) = 1
@@ -118,5 +118,5 @@
             endif
         if (flag_ls .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_ls(j,ibox) .eq. 1) then 
             prec_frac(j,ibox,1) = 1
@@ -126,5 +126,5 @@
         endif
         if (flag_ls .eq. 0) then ! possibility Five
-        do ibox=1,ncol
+        DO ibox=1,ncol
     !     prec_frac(j,1:ncol,1) = 1
         prec_frac(j,ibox,1) = 1
@@ -135,5 +135,5 @@
      
         if (cv_p_rate(j,1) .gt. 0.) then 
-         do ibox=1,ncol ! possibility ONE
+         DO ibox=1,ncol ! possibility ONE
           if (frac_out(j,ibox,1) .eq. 2) then 
            if (prec_frac(j,ibox,1) .eq. 0) then
@@ -146,5 +146,5 @@
         enddo ! loop over ncol
         if (flag_cv .eq. 0) then ! possibility THREE
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out(j,ibox,2) .eq. 2) then 
                 if (prec_frac(j,ibox,1) .eq. 0) then
@@ -158,5 +158,5 @@
         endif
         if (flag_cv .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_cv(j,ibox) .eq. 1) then 
                 if (prec_frac(j,ibox,1) .eq. 0) then
@@ -170,5 +170,5 @@
         endif
         if (flag_cv .eq. 0) then  ! possibility Five
-        do ibox=1,cv_col
+        DO ibox=1,cv_col
                 if (prec_frac(j,ibox,1) .eq. 0) then
             prec_frac(j,ibox,1) = 2
@@ -187,11 +187,11 @@
 
 !     working on the levels from top to surface
-      do ilev=2,nlev
-       do j=1,npoints
+      DO ilev=2,nlev
+       DO j=1,npoints
         flag_ls=0
         flag_cv=0
     
         if (ls_p_rate(j,ilev) .gt. 0.) then 
-         do ibox=1,ncol ! possibility ONE&TWO
+         DO ibox=1,ncol ! possibility ONE&TWO
           if ((frac_out(j,ibox,ilev) .eq. 1) .or. ((prec_frac(j,ibox,ilev-1) .eq. 1)     &
             .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
@@ -201,5 +201,5 @@
         enddo ! loop over ncol
         if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out(j,ibox,ilev+1) .eq. 1) then 
             prec_frac(j,ibox,ilev) = 1
@@ -209,5 +209,5 @@
         endif
         if (flag_ls .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_ls(j,ibox) .eq. 1) then 
             prec_frac(j,ibox,ilev) = 1
@@ -217,5 +217,5 @@
         endif
         if (flag_ls .eq. 0) then ! possibility Five
-        do ibox=1,ncol
+        DO ibox=1,ncol
 !     prec_frac(j,1:ncol,ilev) = 1
         prec_frac(j,ibox,ilev) = 1
@@ -225,5 +225,5 @@
     
         if (cv_p_rate(j,ilev) .gt. 0.) then 
-         do ibox=1,ncol ! possibility ONE&TWO
+         DO ibox=1,ncol ! possibility ONE&TWO
           if ((frac_out(j,ibox,ilev) .eq. 2) .or. ((prec_frac(j,ibox,ilev-1) .eq. 2)     &
             .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
@@ -237,5 +237,5 @@
        enddo ! loop over ncol
         if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out(j,ibox,ilev+1) .eq. 2) then 
                 if (prec_frac(j,ibox,ilev) .eq. 0) then
@@ -249,5 +249,5 @@
         endif
         if (flag_cv .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_cv(j,ibox) .eq. 1) then 
                 if (prec_frac(j,ibox,ilev) .eq. 0) then
@@ -261,5 +261,5 @@
         endif
         if (flag_cv .eq. 0) then  ! possibility Five 
-        do ibox=1,cv_col
+        DO ibox=1,cv_col
                 if (prec_frac(j,ibox,ilev) .eq. 0) then
             prec_frac(j,ibox,ilev) = 2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam.F90	(revision 5158)
@@ -153,7 +153,7 @@
        d_gate     = -1
     endif
-    do k=start_gate,end_gate,d_gate
+    DO k=start_gate,end_gate,d_gate
        ! Loop over each profile (nprof)
-       do pr=1,nprof
+       DO pr=1,nprof
           ! Attenuation due to hydrometeors between radar and volume
           
@@ -265,6 +265,6 @@
 
        ! Effective reflectivity histogram
-       do i=1,Npoints
-          do j=1,llm
+       DO i=1,Npoints
+          DO j=1,llm
              cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_totFlip(i,:,j),DBZE_BINS,cloudsat_histRef)
           enddo
@@ -274,6 +274,6 @@
     else
        ! Effective reflectivity histogram
-       do i=1,Npoints
-          do j=1,llm
+       DO i=1,Npoints
+          DO j=1,llm
              cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_tot(i,:,j),DBZE_BINS,cloudsat_histRef)
           enddo
@@ -315,7 +315,7 @@
             trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
        
-       do i=1,maxhclass
-          do j=1,mt_ntt
-             do k=1,nRe_types
+       DO i=1,maxhclass
+          DO j=1,mt_ntt
+             DO k=1,nRe_types
                 ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
                 read(12,rec=ind) rcfg%Z_scale_flag(i,j,k), &
@@ -351,7 +351,7 @@
          trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
     
-    do i=1,maxhclass
-       do j=1,mt_ntt
-          do k=1,nRe_types
+    DO i=1,maxhclass
+       DO j=1,mt_ntt
+          DO k=1,nRe_types
              ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
              if(.not.LUT_file_exists .or. rcfg%Z_scale_added_flag(i,j,k)) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam_optics.F90	(revision 5158)
@@ -71,5 +71,5 @@
     mt_ttl = (/ ((j-1)*5-60 + 273.15, j = 1, cnt_liq) /)
     D(1) = dmin
-    do j=2,nd
+    DO j=2,nd
        D(j) = D(j-1)*exp((log(dmax)-log(dmin))/(nd-1))
     enddo
@@ -152,6 +152,6 @@
     kr_vol   = 0._wp
 
-    do k=1,ngate       ! Loop over each profile (nprof)
-       do pr=1,nprof
+    DO k=1,ngate       ! Loop over each profile (nprof)
+       DO pr=1,nprof
           if (g_vol_in_present) then
              g_vol(pr,k) = g_vol_in(pr,k)
@@ -167,5 +167,5 @@
           ! Determine if hydrometeor(s) present in volume
           hydro = .false.
-          do j=1,rcfg%nhclass
+          DO j=1,rcfg%nhclass
              if ((hm_matrix(pr,k,j) > 1E-12) .and. (sd%dtype(j) > 0)) then
                 hydro = .true.
@@ -180,5 +180,5 @@
              
              ! Loop over hydrometeor type
-             do tp=1,rcfg%nhclass
+             DO tp=1,rcfg%nhclass
                 Re_internal = re_matrix(pr,k,tp)
 
@@ -368,5 +368,5 @@
     
     where(kr_vol(:,:) <= EPSILON(kr_vol)) 
-       ! Volume is hydrometeor-free	
+       ! Volume is hydrometeor-free
        !z_vol(:,:)  = undef
        z_ray(:,:)  = undef
@@ -820,5 +820,5 @@
        lidx = infind(D,dmin)
        uidx = infind(D,dmax)    
-       do k=lidx,uidx
+       DO k=lidx,uidx
           N(k) = (ahp*(D(k)*1E-3)**bhp) * 1E-12    
        enddo
@@ -1006,5 +1006,5 @@
        sizep = (pi*D0)/wl
        dqv(1) = 0._wp
-       do i=1,nsizes
+       DO i=1,nsizes
           call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
                dg, xs1, xs2, dph, err)
@@ -1209,5 +1209,5 @@
     sumo = 0._wp
     aux1 = 1.1_wp*e_th
-    do i=1,nbands_o2
+    DO i=1,nbands_o2
        aux2   = f/v0(i)
        aux3   = v0(i)-f
@@ -1233,5 +1233,5 @@
     sumo = 0._wp
     aux1 = 4.8_wp*e_th
-    do i=1,nbands_h2o
+    DO i=1,nbands_h2o
        aux2    = f/v1(i)
        aux3    = v1(i)-f
@@ -1298,5 +1298,5 @@
     ! 4 for monodisperse distribution,
     ! 5 for lognormal distribution.
-	!
+    !
     ! PHASE - Set to 0 for liquid, 1 for ice.
     ! DMIN  - The minimum drop size for this class (micron), ignored for monodisperse.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/scops.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/scops.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/scops.F90	(revision 5158)
@@ -94,5 +94,5 @@
     if (ncolprint.ne.0) then
        write (6,'(a)') 'frac_out_pp_rev:'
-       do j=1,npoints,1000
+       DO j=1,npoints,1000
           write(6,'(a10)') 'j='
           write(6,'(8I10)') j
@@ -104,5 +104,5 @@
     if (ncolprint.ne.0) then
        write (6,'(a)') 'last_frac_pp:'
-       do j=1,npoints,1000
+       DO j=1,npoints,1000
           write(6,'(a10)') 'j='
           write(6,'(8I10)') j
@@ -139,5 +139,5 @@
           IF (ncolprint.ne.0) then
              write (6,'(a)') 'threshold_nsf2:'
-             do j=1,npoints,1000
+             DO j=1,npoints,1000
                 write(6,'(a10)') 'j='
                 write(6,'(8I10)') j
@@ -156,5 +156,5 @@
           !maxocc(1:npoints,ibox) = merge(1,0,boxpos(1:npoints,ibox) .le. conv(1:npoints,ilev))
           !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox))
-          do j=1,npoints
+          DO j=1,npoints
              if (boxpos(j,ibox).le.conv(j,ilev)) then
                 maxocc(j,ibox) = 1
@@ -214,5 +214,5 @@
        ! Set last_frac to tca at this level, so as to be tca from last level next time round
        if (ncolprint.ne.0) then
-          do j=1,npoints ,1000
+          DO j=1,npoints ,1000
              write(6,'(a10)') 'j='
              write(6,'(8I10)') j
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/MISR_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/MISR_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/MISR_simulator.F90	(revision 5158)
@@ -78,9 +78,9 @@
     box_MISR_ztop(1:npoints,1:ncol) = 0._wp  
 
-    do j=1,npoints
+    DO j=1,npoints
 
        ! Estimate distribution of Model layer tops
        dist_model_layertops(j,:)=0
-       do ilev=1,nlev
+       DO ilev=1,nlev
           ! Define location of "layer top"
           if(ilev.eq.1 .or. ilev.eq.nlev) then
@@ -93,5 +93,5 @@
           ! *NOTE* the first MISR level is "no height" level
           iMISR_ztop=2
-          do loop=2,numMISRHgtBins
+          DO loop=2,numMISRHgtBins
              if ( ztest .gt. 1000*misr_histHgt(loop+1) ) then
                 iMISR_ztop=loop+1
@@ -103,10 +103,10 @@
 
        ! For each GCM cell or horizontal model grid point   
-       do ibox=1,ncol
+       DO ibox=1,ncol
           ! Compute optical depth as a cummulative distribution in the vertical (nlev).
           tauOUT(j,ibox)=sum(dtau(j,ibox,1:nlev))
 
           thres_crossed_MISR=0
-          do ilev=1,nlev
+          DO ilev=1,nlev
              ! If there a cloud, start the counter and store this height
              if(thres_crossed_MISR .eq. 0 .and. dtau(j,ibox,ilev) .gt. 0.) then
@@ -187,5 +187,5 @@
     ! This setup assumes the columns represent a about a 1 to 4 km scale
     ! it will need to be modified significantly, otherwise
-!	! DS2015: Add loop over gridpoints and index accordingly.
+!    ! DS2015: Add loop over gridpoints and index accordingly.
 !    if(ncol.eq.1) then
 !       ! Adjust based on neightboring points.
@@ -214,5 +214,5 @@
      
     ! Fill dark scenes 
-    do j=1,numMISRHgtBins
+    DO j=1,numMISRHgtBins
        where(sunlit .ne. 1) dist_model_layertops(1:npoints,j) = R_UNDEF
     enddo
@@ -254,5 +254,5 @@
     tauWRK(1:npoints,1:ncol)                      = tau(1:npoints,1:ncol)
     box_MISR_ztopWRK(1:npoints,1:ncol)            = box_MISR_ztop(1:npoints,1:ncol)
-    do j=1,npoints
+    DO j=1,npoints
 
        ! Subcolumns that are cloudy(true) and not(false)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp.F90	(revision 5158)
@@ -239,5 +239,5 @@
      real(wp),dimension(:),pointer :: &
           isccp_totalcldarea => null(), & ! The fraction of model grid box columns with cloud
-           		                  ! somewhere in them. (%)
+                                     ! somewhere in them. (%)
           isccp_meantb => null(),       & ! Mean all-sky 10.5 micron brightness temperature. (K)
           isccp_meantbclr => null(),    & ! Mean clear-sky 10.5 micron brightness temperature. (K)
@@ -837,5 +837,5 @@
        allocate(parasolPix_refl(parasolIN%Npoints,parasolIN%Ncolumns,PARASOL_NREFL))
        ! Call simulator
-       do icol=1,parasolIN%Ncolumns
+       DO icol=1,parasolIN%Ncolumns
           call parasol_subcolumn(parasolIN%npoints, PARASOL_NREFL,                       &
                                  parasolIN%tautot_S_liq(1:parasolIN%Npoints,icol),       &
@@ -855,5 +855,5 @@
        allocate(cloudsatDBZe(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels), &
                 cloudsatZe_non(cloudsatIN%Npoints,cloudsatIN%Ncolumns,cloudsatIN%Nlevels))
-       do icol=1,cloudsatIN%ncolumns
+       DO icol=1,cloudsatIN%ncolumns
           call quickbeam_subcolumn(cloudsatIN%rcfg,cloudsatIN%Npoints,cloudsatIN%Nlevels,&
                                    cloudsatIN%hgt_matrix/1000._wp,                       &
@@ -876,5 +876,5 @@
                    modisRetrievedCloudTopPressure(modisIN%nSunlit,modisIN%nColumns))
           ! Call simulator
-          do i = 1, modisIN%nSunlit
+          DO i = 1, modisIN%nSunlit
              call modis_subcolumn(modisIN%Ncolumns,modisIN%Nlevels,modisIN%pres(i,:),    &
                                   modisIN%tau(int(modisIN%sunlit(i)),:,:),               &
@@ -1246,5 +1246,5 @@
 !            cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half,                           & !PREC_BUG
             cospgridIN%land(:), cospgridIN%surfelev(:), cospgridIN%at(:,cospIN%Nlevels), & !PREC_BUG
-	    cospIN%fracPrecipIce, cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half,     & !PREC_BUG
+        cospIN%fracPrecipIce, cospgridIN%hgt_matrix, cospgridIN%hgt_matrix_half,     & !PREC_BUG
             cospOUT%cloudsat_cfad_ze(ij:ik,:,:), cospOUT%cloudsat_precip_cover,          &
             cospOUT%cloudsat_pia)
@@ -1691,5 +1691,5 @@
        ! Other grid requested. Constant vertical spacing with top at 20 km
        if (.not. luseCSATvgrid) zstep = 20000._wp/Nvgrid
-       do i=1,Nvgrid
+       DO i=1,Nvgrid
           vgrid_zl(Nlvgrid-i+1) = (i-1)*zstep
           vgrid_zu(Nlvgrid-i+1) = i*zstep
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_atlid_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_atlid_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_atlid_interface.F90	(revision 5158)
@@ -62,5 +62,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !	END MODULE
+  !    END MODULE
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_ATLID_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_calipso_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_calipso_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_calipso_interface.F90	(revision 5158)
@@ -81,5 +81,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !	END MODULE
+  !    END MODULE
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_CALIPSO_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_cloudsat_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_cloudsat_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_cloudsat_interface.F90	(revision 5158)
@@ -118,5 +118,5 @@
     ! Set up Re bin "structure" for z_scaling
     rcfg%base_list(1)=0
-    do j=1,Re_MAX_BIN
+    DO j=1,Re_MAX_BIN
        rcfg%step_list(j)=0.1_wp+0.1_wp*((j-1)**1.5)
        if(rcfg%step_list(j)>Re_BIN_LENGTH) then
@@ -138,5 +138,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !                              	  END MODULE
+  !                                    END MODULE
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_CLOUDSAT_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_config.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_config.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_config.F90	(revision 5158)
@@ -180,5 +180,5 @@
                                    1.0,      0.909013, 0.709554, 0.430405, 0.121567/),   &
                                    shape=(/PARASOL_NREFL,PARASOL_NTAU/)),                & 
-         ! LUT for ice particles         			     
+         ! LUT for ice particles
          rlumB = reshape(source=(/ 0.03,     0.03,     0.03,     0.03,     0.03,         &
                                    0.092170, 0.087082, 0.083325, 0.084935, 0.054157,     &
@@ -422,8 +422,8 @@
          vgrid_z_in = (/240.0, 720.0, 1200.0, 1680.0, 2160.0, 2640.0, 3120.0, 3600.0, &
                         4080.0, 4560.0, 5040.0, 5520.0, 6000.0, 6480.0, 6960.0, 7440.0, &
-			7920.0, 8400.0, 8880.0, 9360.0, 9840.0, 10320.0, 10800.0, &
-			11280.0, 11760.0, 12240.0, 12720.0, 13200.0, 13680.0, 14160.0, &
-			14640.0, 15120.0, 15600.0, 16080.0, 16560.0, 17040.0, 17520.0, &
-			18000.0, 18480.0, 18960.0/)
+            7920.0, 8400.0, 8880.0, 9360.0, 9840.0, 10320.0, 10800.0, &
+            11280.0, 11760.0, 12240.0, 12720.0, 13200.0, 13680.0, 14160.0, &
+            14640.0, 15120.0, 15600.0, 16080.0, 16560.0, 17040.0, 17520.0, &
+            18000.0, 18480.0, 18960.0/)
 
 END MODULE MOD_COSP_CONFIG
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_grLidar532_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_grLidar532_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_grLidar532_interface.F90	(revision 5158)
@@ -58,5 +58,5 @@
   
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !	END MODULE
+  !    END MODULE
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_GRLIDAR532_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_isccp_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_isccp_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_isccp_interface.F90	(revision 5158)
@@ -67,5 +67,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !  							SUBROUTINE cosp_isccp_init
+  !                              SUBROUTINE cosp_isccp_init
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   SUBROUTINE COSP_ISCCP_INIT(top_height,top_height_direction)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_misr_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_misr_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_misr_interface.F90	(revision 5158)
@@ -36,5 +36,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  ! 								TYPE misr_in
+  !                                 TYPE misr_in
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   type misr_IN
@@ -56,5 +56,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !  							SUBROUTINE cosp_misr_init
+  !                              SUBROUTINE cosp_misr_init
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   SUBROUTINE COSP_MISR_INIT()
@@ -63,5 +63,5 @@
 
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  ! 							    	END MODULE
+  !                                     END MODULE
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 END MODULE MOD_COSP_MISR_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_optics.F90	(revision 5158)
@@ -71,5 +71,5 @@
     
     varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
-    do j=1,dim2
+    DO j=1,dim2
        where(flag(:,j,:) .eq. 1)
           varOUT(:,j,:) = varIN2
@@ -135,5 +135,5 @@
     
     
-    do i=1,npoints
+    DO i=1,npoints
        where(cloudIce(i,:, :) <= 0.) 
           fracL(:, :) = 1._wp
@@ -170,6 +170,6 @@
     w0(1:nPoints,1:nSubCols,1:nLevels) = 0._wp
     
-    do j =1,nPoints
-       do i=1,nSubCols
+    DO j =1,nPoints
+       DO i=1,nSubCols
           water_g(1:nLevels)  = get_g_nir(  phaseIsLiquid, sizeLIQ(j,i,1:nLevels)) 
           water_w0(1:nLevels) = get_ssa_nir(phaseIsLiquid, sizeLIQ(j,i,1:nLevels))
@@ -189,5 +189,5 @@
     
     ! Compute the total optical thickness and the proportion due to liquid in each cell
-    do i=1,npoints
+    DO i=1,npoints
        where(tauLIQ(i,1:nSubCols,1:nLevels) + tauICE(i,1:nSubCols,1:nLevels) > 0.) 
           fracLIQ(i,1:nSubCols,1:nLevels) = tauLIQ(i,1:nSubCols,1:nLevels)/ &
@@ -358,5 +358,5 @@
     ! Altitude at half pressure levels:
     zheight(1:npoints,nlev+1) = 0._wp
-    do k=nlev,1,-1
+    DO k=nlev,1,-1
        zheight(1:npoints,k) = zheight(1:npoints,k+1) &
             -(presf(1:npoints,k)-presf(1:npoints,k+1))/(rhoair(1:npoints,k)*grav)
@@ -392,5 +392,5 @@
     ! ##############################################################################
     ! Polynomials kp_lidar derived from Mie theory
-    do i = 1, npart
+    DO i = 1, npart
        where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
           kp_part(1:npoints,1:nlev,i) = &
@@ -412,5 +412,5 @@
 
     ! Loop over all subcolumns
-    do icol=1,ncolumns
+    DO icol=1,ncolumns
        ! ##############################################################################
        ! Mixing ratio particles in each subcolum
@@ -425,5 +425,5 @@
        ! ##############################################################################
        ! Alpha of particles in each subcolumn:
-       do i = 1, npart
+       DO i = 1, npart
           where (rad_part(1:npoints,1:nlev,i) .gt. 0.0)
              alpha_part(1:npoints,1:nlev,i) = 3._wp/4._wp * Qscat &
@@ -437,10 +437,10 @@
        ! Optical thicknes
        tau_part(1:npoints,1:nlev,1:npart) = rdiffm * alpha_part(1:npoints,1:nlev,1:npart)
-       do i = 1, npart
+       DO i = 1, npart
           ! Optical thickness of each layer (particles)
           tau_part(1:npoints,1:nlev,i) = tau_part(1:npoints,1:nlev,i) &
                & * (zheight(1:npoints,1:nlev)-zheight(1:npoints,2:nlev+1) )
           ! Optical thickness from TOA to layer k (particles)
-          do k=zi,zf,zinc
+          DO k=zi,zf,zinc
              tau_part(1:npoints,k,i) = tau_part(1:npoints,k,i) + tau_part(1:npoints,k+zoffset,i)
           enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_parasol_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_parasol_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_parasol_interface.F90	(revision 5158)
@@ -35,5 +35,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !									TYPE cosp_parasol
+  !                                    TYPE cosp_parasol
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   TYPE PARASOL_SGX
@@ -63,5 +63,5 @@
   END TYPE COSP_PARASOL
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !										TYPE parasol_in
+  !                                        TYPE parasol_in
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   TYPE parasol_IN
@@ -86,5 +86,5 @@
 
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  ! 								    END MODULE
+  !                                     END MODULE
   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 end module MOD_COSP_PARASOL_INTERFACE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_stats.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_stats.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_stats.F90	(revision 5158)
@@ -81,5 +81,5 @@
    r = 0._wp
 
-   do i=1,Npoints
+   DO i=1,Npoints
      ! Calculate tops and bottoms of new and old grids
      oldgrid_bot = zhalf(i,:)
@@ -88,9 +88,9 @@
      l = 0 ! Index of level in the old grid
      ! Loop over levels in the new grid
-     do k = 1,Nglevels
+     DO k = 1,Nglevels
        Nw = 0 ! Number of weigths
        wt = 0._wp ! Sum of weights
        ! Loop over levels in the old grid and accumulate total for weighted average
-       do
+       DO
          l = l + 1
          w = 0.0 ! Initialise weight to 0
@@ -119,5 +119,5 @@
              Nw = Nw + 1
              wt = wt + w
-             do j=1,Ncolumns
+             DO j=1,Ncolumns
                if (lunits) then
                  if (y(i,j,l) /= R_UNDEF) then
@@ -138,5 +138,5 @@
        ! Calculate average in new grid
        if (Nw > 0) then
-         do j=1,Ncolumns
+         DO j=1,Ncolumns
            r(i,j,k) = r(i,j,k)/wt
          enddo
@@ -146,7 +146,7 @@
 
    ! Set points under surface to R_UNDEF, and change to dBZ if necessary
-   do k=1,Nglevels
-     do j=1,Ncolumns
-       do i=1,Npoints
+   DO k=1,Nglevels
+     DO j=1,Ncolumns
+       DO i=1,Npoints
          if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level
            if (lunits) then
@@ -202,6 +202,6 @@
     radar_tcc = 0._wp
     radar_tcc2 = 0._wp
-    do pr=1,Npoints
-       do i=1,Ncolumns
+    DO pr=1,Npoints
+       DO i=1,Ncolumns
           flag_sat = 0
           flag_cld = 0
@@ -210,10 +210,10 @@
           ! look for j_1km from bottom to top
           j = 1
-          do while (Ze_tot(pr,i,j) .eq. R_GROUND)
+          DO while (Ze_tot(pr,i,j) .eq. R_GROUND)
              j = j+1
           enddo
           j_1km = j+1  !this is the vertical index of 1km above surface  
           
-          do j=1,Nlevels
+          DO j=1,Nlevels
              sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
              if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
@@ -266,5 +266,5 @@
     integer :: ij
     
-    do ij=2,Nbins+1  
+    DO ij=2,Nbins+1
        hist1D(ij-1) = count(var .ge. bins(ij-1) .and. var .lt. bins(ij))
        if (count(var .eq. R_GROUND) .ge. 1) hist1D(ij-1)=R_UNDEF
@@ -298,6 +298,6 @@
     integer :: ij,ik
     
-    do ij=2,nbin1+1
-       do ik=2,nbin2+1
+    DO ij=2,nbin1+1
+       DO ik=2,nbin2+1
           jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
                var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))        
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_utils.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_utils.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_utils.F90	(revision 5158)
@@ -77,7 +77,7 @@
         delta = (alpha_x + b_x + d_x - n_bx + 1._wp)
         
-        do k=1,Nlevels
-            do j=1,Ncolumns
-                do i=1,Npoints
+        DO k=1,Nlevels
+            DO j=1,Ncolumns
+                DO i=1,Npoints
                     if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
                         rho = p(i,k)/(287.05_wp*T(i,k))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/icarus.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/icarus.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/icarus.F90	(revision 5158)
@@ -135,8 +135,8 @@
     
     if (debugcol.ne.0) then
-       do j=1,npoints,debugcol
+       DO j=1,npoints,debugcol
           
           ! Produce character output
-          do ilev=1,nlev
+          DO ilev=1,nlev
              acc(ilev,1:ncol)=frac_out(j,1:ncol,ilev)*2
              where(levmatch(j,1:ncol) .eq. ilev) acc(ilev,1:ncol)=acc(ilev,1:ncol)+1
@@ -151,5 +151,5 @@
           write(9,'(a1)') ' '
           
-          do ibox=1,ncol
+          DO ibox=1,ncol
              write(9,'(40(a1),1x,40(a1))') &
                   (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev),&
@@ -231,5 +231,5 @@
        itrop(1:npoints)     = 1
 
-       do ilev=1,nlev
+       DO ilev=1,nlev
           where(pfull(1:npoints,ilev) .lt. 40000. .and. &
                 pfull(1:npoints,ilev) .gt.  5000. .and. &
@@ -242,5 +242,5 @@
        enddo
 
-       do ilev=1,nlev
+       DO ilev=1,nlev
           atmax(1:npoints) = merge(at(1:npoints,ilev),atmax(1:npoints),&
                at(1:npoints,ilev) .gt. atmax(1:npoints) .and. ilev  .ge. itrop(1:npoints))
@@ -256,5 +256,5 @@
        ! at a wavenumber of 955 cm-1, or 10.47 microns 
        ! ############################################################################
-       do ilev=1,nlev
+       DO ilev=1,nlev
           press(1:npoints)  = pfull(1:npoints,ilev)*10._wp
           dpress(1:npoints) = (phalf(1:npoints,ilev+1)-phalf(1:npoints,ilev))*10
@@ -273,5 +273,5 @@
        fluxtop_clrsky(1:npoints)            = 0._wp
        trans_layers_above_clrsky(1:npoints) = 1._wp
-       do ilev=1,nlev
+       DO ilev=1,nlev
           ! Black body emission at temperature of the layer
           bb(1:npoints) = 1._wp / ( exp(1307.27_wp/at(1:npoints,ilev)) - 1._wp )
@@ -300,9 +300,9 @@
        fluxtop(1:npoints,1:ncol)            = 0._wp
        trans_layers_above(1:npoints,1:ncol) = 1._wp
-       do ilev=1,nlev
+       DO ilev=1,nlev
           ! Black body emission at temperature of the layer
           bb=1._wp/(exp(1307.27_wp/at(1:npoints,ilev)) - 1._wp)
           
-          do ibox=1,ncol
+          DO ibox=1,ncol
              ! Emissivity
              dem(1:npoints,ibox) = merge(dem_wv(1:npoints,ilev), &
@@ -320,5 +320,5 @@
        ! Add in surface emission
        bb(1:npoints)=1._wp/( exp(1307.27_wp/skt(1:npoints)) - 1._wp )
-       do ibox=1,ncol
+       DO ibox=1,ncol
           fluxtop(1:npoints,ibox) = fluxtop(1:npoints,ibox) + emsfc_lw*bb(1:npoints)*trans_layers_above(1:npoints,ibox) 
        end do
@@ -344,10 +344,10 @@
        btcmin(1:npoints) = 1._wp /  ( exp(1307.27_wp/(attrop(1:npoints)-5._wp)) - 1._wp ) 
 
-       do ibox=1,ncol
+       DO ibox=1,ncol
           transmax(1:npoints) = (fluxtop(1:npoints,ibox)-btcmin) /(fluxtop_clrsky(1:npoints)-btcmin(1:npoints))
           tauir(1:npoints)    = tau(1:npoints,ibox)/2.13_wp
           taumin(1:npoints)   = -log(max(min(transmax(1:npoints),0.9999999_wp),0.001_wp))
           if (isccp_top_height .eq. 1) then
-             do j=1,npoints  
+             DO j=1,npoints
                 if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
                    fluxtopinit(j) = fluxtop(j,ibox)
@@ -355,6 +355,6 @@
                 endif
              enddo
-             do icycle=1,2
-                do j=1,npoints  
+             DO icycle=1,2
+                DO j=1,npoints
                    if (tau(j,ibox) .gt. (tauchk)) then 
                       if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
@@ -397,5 +397,5 @@
     ! pressure (isccp_top_height = 1 or 3)
     ! ####################################################################################
-    do ibox=1,ncol
+    DO ibox=1,ncol
        !segregate according to optical thickness
        if (isccp_top_height .eq. 1 .or. isccp_top_height .eq. 3) then  
@@ -403,7 +403,7 @@
           ! Find level whose temperature most closely matches brightness temperature
           nmatch(1:npoints)=0
-          do k1=1,nlev-1
+          DO k1=1,nlev-1
              ilev = merge(nlev-k1,k1,isccp_top_height_direction .eq. 2)        
-             do j=1,npoints 
+             DO j=1,npoints
                 if (ilev           .ge. itrop(j)     .and. &
                      ((at(j,ilev)  .ge. tb(j,ibox)   .and. &  
@@ -417,5 +417,5 @@
           enddo
 
-          do j=1,npoints 
+          DO j=1,npoints
              if (nmatch(j) .ge. 1) then
                 k1 = match(j,nmatch(j))
@@ -440,5 +440,5 @@
        else
           ptop(1:npoints,ibox)=0.
-          do ilev=1,nlev
+          DO ilev=1,nlev
              where((ptop(1:npoints,ibox) .eq. 0. ) .and.(frac_out(1:npoints,ibox,ilev) .ne. 0))
                 ptop(1:npoints,ibox)=phalf(1:npoints,ilev)
@@ -458,6 +458,6 @@
     boxtau(1:npoints,1:ncol)  = output_missing_value
     boxptop(1:npoints,1:ncol) = output_missing_value
-    do ibox=1,ncol
-       do j=1,npoints 
+    DO ibox=1,ncol
+       DO j=1,npoints
           if (tau(j,ibox) .gt. (tauchk) .and. ptop(j,ibox) .gt. 0.) then
              if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
@@ -532,10 +532,10 @@
     ! Reset frequencies
     !fq_isccp = spread(spread(merge(0._wp,output_missing_value,sunlit .eq. 1 .or. isccp_top_height .eq. 3),2,7),2,7)
-    do ilev=1,7
-       do ilev2=1,7
-          do j=1,npoints ! 
+    DO ilev=1,7
+       DO ilev2=1,7
+          DO j=1,npoints !
              if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then 
                 fq_isccp(j,ilev,ilev2)= 0.
-	     else 
+         else
                 fq_isccp(j,ilev,ilev2)= output_missing_value
              end if
@@ -559,5 +559,5 @@
     
     ! Compute column quantities and joint-histogram
-    do j=1,npoints 
+    DO j=1,npoints
        ! Subcolumns that are cloudy(true) and not(false)
        box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) .gt. tauchk .and. boxptop(j,1:ncol) .gt. 0.)
@@ -633,5 +633,5 @@
     
     varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
-    do j=1,dim2
+    DO j=1,dim2
        where(flag(:,j,:) .eq. 1)
           varOUT(:,j,:) = varIN2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lidar_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lidar_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lidar_simulator.F90	(revision 5158)
@@ -175,5 +175,5 @@
     ! PLANE PARRALLEL FIELDS
     ! ####################################################################################
-    do icol=1,ncolumns
+    DO icol=1,ncolumns
        ! #################################################################################
        ! *) Total Backscatter signal
@@ -200,5 +200,5 @@
     ! ####################################################################################
     if (lphaseoptics) then
-       do icol=1,ncolumns
+       DO icol=1,ncolumns
           ! #################################################################################
           ! *) Ice/Liq Perpendicular Backscatter signal
@@ -206,5 +206,5 @@
           ! Computation of ATBperp,ice/liq from ATBice/liq including the multiple scattering 
           ! contribution (Cesana and Chepfer 2013, JGR)
-          do k=1,nlev
+          DO k=1,nlev
              ! Ice particles
              pnorm_perp_ice(1:npoints,icol,k) = Alpha * pnorm_ice(1:npoints,icol,k)
@@ -242,5 +242,5 @@
           
           ! Other layers
-          do k=2,nlev
+          DO k=2,nlev
              ! Optical thickness of layer k
              tautot_lay(1:npoints) = tautot(1:npoints,icol,k)-tautot(1:npoints,icol,k-1) 
@@ -398,5 +398,5 @@
     ! Compute LIDAR scattering ratio
     if (use_vgrid) then
-       do ic = 1, ncol
+       DO ic = 1, ncol
           pnorm_c = pnormFlip(:,ic,:)
           where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
@@ -427,5 +427,5 @@
        endif
     else
-       do ic = 1, ncol
+       DO ic = 1, ncol
           pnorm_c = pnorm(:,ic,:)
           where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
@@ -458,6 +458,6 @@
     if (ok_lidar_cfad) then
        ! CFADs of subgrid-scale lidar scattering ratios
-       do i=1,Npoints
-          do j=1,llm
+       DO i=1,Npoints
+          DO j=1,llm
              cfad2(i,:,j) = hist1D(ncol,x3d(i,:,j),SR_BINS,histBsct)
           enddo
@@ -499,5 +499,5 @@
 
     ! Other layers
-    do k=2,nlev
+    DO k=2,nlev
        tautot_lay(:) = tau(:,k)-tau(:,k-1) 
        WHERE (tautot_lay(:) .gt. 0.)
@@ -527,5 +527,5 @@
     epsrealwp = epsilon(1._wp)
     beta(:,1) = pnorm(:,1) * (2._wp*tau(:,1))/(1._wp-exp(-2._wp*tau(:,1)))
-    do k=2,nlev
+    DO k=2,nlev
        tautot_lay(:) = tau(:,k)-tau(:,k-1)       
        WHERE ( EXP(-2._wp*tau(:,k-1)) .gt. epsrealwp )
@@ -569,5 +569,5 @@
        zeta50    = -9.4776e-07_wp    ! 
        
-	! Inputs
+    ! Inputs
     integer,intent(in) :: &
        Npoints,  & ! Number of gridpoints
@@ -576,5 +576,5 @@
        Ncat,     & ! Number of cloud layer types
        Nphase      ! Number of cloud layer phase types
-	               ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
+                   ! [ice,liquid,undefined,false ice,false liquid,Percent of ice]
     real(wp),intent(in) :: &
        S_att,    & !
@@ -590,5 +590,5 @@
        pplay       ! Pressure
 
-	! Outputs
+    ! Outputs
     real(wp),intent(out),dimension(Npoints,Ntemp,5) :: &
        lidarcldtemp  ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq
@@ -625,5 +625,5 @@
              
     ! ####################################################################################
-	! 1) Initialize    
+    ! 1) Initialize
     ! ####################################################################################
     lidarcld              = 0._wp
@@ -648,5 +648,5 @@
     ! 2) Cloud detection
     ! ####################################################################################
-    do k=1,Nlevels
+    DO k=1,Nlevels
        ! Cloud detection at subgrid-scale:
        where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
@@ -671,12 +671,12 @@
     cldlay   = 0._wp
     nsublay  = 0._wp
-    do k=1,Nlevels
-       do ic = 1, Ncolumns
-          do ip = 1, Npoints
+    DO k=1,Nlevels
+       DO ic = 1, Ncolumns
+          DO ip = 1, Npoints
           
              ! Computation of the cloud fraction as a function of the temperature instead
              ! of height, for ice,liquid and all clouds
              if(srok(ip,ic,k).gt.0.)then
-                do itemp=1,Ntemp
+                DO itemp=1,Ntemp
                    if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
                       lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1._wp
@@ -686,5 +686,5 @@
              
              if(cldy(ip,ic,k).eq.1.)then
-                do itemp=1,Ntemp 
+                DO itemp=1,Ntemp
                    if( (tmp(ip,k) .ge. tempmod(itemp)).and.(tmp(ip,k) .lt. tempmod(itemp+1)) )then
                       lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1._wp
@@ -723,6 +723,6 @@
     cldlayer  = 0._wp
     nsublayer = 0._wp
-    do iz = 1, Ncat
-       do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO ic = 1, Ncolumns
           cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
@@ -742,7 +742,7 @@
     ! 4.1) For Cloudy pixels with 8.16km < z < 19.2km
     ! ####################################################################################
-    do ncol=1,Ncolumns
-       do i=1,Npoints          
-          do nlev=1,23 ! from 19.2km until 8.16km
+    DO ncol=1,Ncolumns
+       DO i=1,Npoints
+          DO nlev=1,23 ! from 19.2km until 8.16km
                p1 = pplay(1,nlev)
 
@@ -856,5 +856,5 @@
           ! ##############################################################################
           toplvlsat = 0
-          do nlev=24,Nlevels! from 8.16km until 0km
+          DO nlev=24,Nlevels! from 8.16km until 0km
              p1 = pplay(i,nlev)
 
@@ -979,5 +979,5 @@
           ! ##############################################################################
           if(toplvlsat.ne.0) then
-             do nlev = toplvlsat,Nlevels
+             DO nlev = toplvlsat,Nlevels
                 p1 = pplay(i,nlev)
                 if(cldy(i,ncol,nlev).eq.1.)then
@@ -1031,7 +1031,7 @@
 
     ! Compute Phase low mid high cloud fractions
-    do iz = 1, Ncat
-       do i=1,Nphase-3
-          do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO i=1,Nphase-3
+          DO ic = 1, Ncolumns
              cldlayerphase(:,iz,i)  = cldlayerphase(:,iz,i)  + cldlayphase(:,ic,iz,i)
              cldlayerphasesum(:,iz) = cldlayerphasesum(:,iz) + cldlayphase(:,ic,iz,i)
@@ -1039,7 +1039,7 @@
        enddo
     enddo
-    do iz = 1, Ncat
-       do i=4,5
-          do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO i=4,5
+          DO ic = 1, Ncolumns
              cldlayerphase(:,iz,i) = cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
           enddo
@@ -1055,5 +1055,5 @@
     ENDWHERE
     
-    do i=1,Nphase-1
+    DO i=1,Nphase-1
        WHERE ( cldlayerphasesum(:,:).gt.0.0 )
           cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:)
@@ -1061,10 +1061,10 @@
     enddo
     
-    do i=1,Npoints
-       do iz=1,Ncat
+    DO i=1,Npoints
+       DO iz=1,Ncat
           checkcldlayerphase=0.
           checkcldlayerphase2=0.
           if (cldlayerphasesum(i,iz) .gt. 0.0 )then
-             do ic=1,Nphase-3
+             DO ic=1,Nphase-3
                 checkcldlayerphase = checkcldlayerphase+cldlayerphase(i,iz,ic)
              enddo
@@ -1075,5 +1075,5 @@
     enddo
     
-    do i=1,Nphase-1
+    DO i=1,Nphase-1
        WHERE (nsublayer(:,:) .eq. 0.0)
           cldlayerphase(:,:,i) = undef
@@ -1082,8 +1082,8 @@
  
     ! Compute Phase 3D as a function of temperature
-    do nlev=1,Nlevels
-       do ncol=1,Ncolumns
-          do i=1,Npoints
-             do itemp=1,Ntemp
+    DO nlev=1,Nlevels
+       DO ncol=1,Ncolumns
+          DO i=1,Npoints
+             DO itemp=1,Ntemp
                 if(tmpi(i,ncol,nlev).gt.0.)then
                    if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
@@ -1105,6 +1105,6 @@
     
     ! Check temperature cloud fraction
-    do i=1,Npoints
-       do itemp=1,Ntemp
+    DO i=1,Npoints
+       DO itemp=1,Ntemp
           checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
           !if(checktemp .NE. lidarcldtemp(i,itemp,1))then
@@ -1124,5 +1124,5 @@
     ENDWHERE
     
-    do i=1,4
+    DO i=1,4
        WHERE(lidarcldtempind(:,:) .gt. 0.)
           lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
@@ -1191,5 +1191,5 @@
     ! 2) Cloud detection
     ! ####################################################################################
-    do k=1,Nlevels
+    DO k=1,Nlevels
        ! Cloud detection at subgrid-scale:
        where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
@@ -1210,7 +1210,7 @@
     ! 3) Grid-box 3D cloud fraction and layered cloud fractions(ISCCP pressure categories)
     ! ####################################################################################
-    do k=1,Nlevels
-       do ic = 1, Ncolumns
-          do ip = 1, Npoints
+    DO k=1,Nlevels
+       DO ic = 1, Ncolumns
+          DO ip = 1, Npoints
 
              iz=1
@@ -1244,6 +1244,6 @@
     cldlayer  = 0._wp
     nsublayer = 0._wp
-    do iz = 1, Ncat
-       do ic = 1, Ncolumns
+    DO iz = 1, Ncat
+       DO ic = 1, Ncolumns
           cldlayer(:,iz)  = cldlayer(:,iz)  + cldlay(:,ic,iz)
           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
@@ -1272,5 +1272,5 @@
        eta = 0.6_wp            ! Multiple-scattering factor (Vaillant de Guelis et al. 2017a, AMT)
 
-	! Inputs
+    ! Inputs
     integer,intent(in) :: &
        Npoints,  & ! Number of gridpoints
@@ -1291,5 +1291,5 @@
        surfelev    ! Surface Elevation (SE)
 
-	! Outputs
+    ! Outputs
     real(wp),intent(out),dimension(Npoints,Nlevels,Ntype+1) :: &
        lidarcldtype   ! 3D OPAQ product fraction (opaque clouds, thin clouds, z_opaque, opacity)
@@ -1324,5 +1324,5 @@
 
     ! ####################################################################################
-	! 1) Initialize    
+    ! 1) Initialize
     ! ####################################################################################
     cldtype(:,:)          = 0._wp
@@ -1342,5 +1342,5 @@
     ! 2) Cloud detection and Fully attenuated layer detection
     ! ####################################################################################
-    do k=1,Nlevels
+    DO k=1,Nlevels
        ! Cloud detection at subgrid-scale:
        where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
@@ -1375,7 +1375,7 @@
     ! ####################################################################################
 
-    do k=1,Nlevels
-       do ic = 1, Ncolumns
-          do ip = 1, Npoints
+    DO k=1,Nlevels
+       DO ic = 1, Ncolumns
+          DO ip = 1, Npoints
 
              cldlay(ip,ic,1)   = MAX(cldlay(ip,ic,1),cldyopaq(ip,ic,k)) ! Opaque cloud
@@ -1393,32 +1393,32 @@
 
 ! OPAQ variables
-     do ic = 1, Ncolumns
-        do ip = 1, Npoints
+     DO ic = 1, Ncolumns
+        DO ip = 1, Npoints
 
      ! Declaring non-opaque cloudy profiles as thin cloud profiles
-	   if ( cldlay(ip,ic,4).gt. 0. .and. cldlay(ip,ic,1) .eq. 0. ) then
-	      cldlay(ip,ic,2)  =  1._wp
- 	   endif
+       if ( cldlay(ip,ic,4).gt. 0. .and. cldlay(ip,ic,1) .eq. 0. ) then
+          cldlay(ip,ic,2)  =  1._wp
+        endif
 
      ! Filling in 3D and 2D variables
 
      ! Opaque cloud profiles
-	   if ( cldlay(ip,ic,1) .eq. 1. ) then
-	      zopac = 0._wp
-	      z_top = 0._wp
-	      do k=1,Nlevels-1
+       if ( cldlay(ip,ic,1) .eq. 1. ) then
+          zopac = 0._wp
+          z_top = 0._wp
+          DO k=1,Nlevels-1
      ! Declaring z_opaque altitude and opaque cloud fraction for 3D and 2D variables
      ! From SFC-2-TOA ( actually from vgrid_z(SFC+1) = vgrid_z(Nlevels-1) )
-	         if ( cldy(ip,ic,Nlevels-k) .eq. 1. .and. zopac .eq. 0. ) then
-		    lidarcldtype(ip,Nlevels-k + 1,3) = lidarcldtype(ip,Nlevels-k + 1,3) + 1._wp
-		    cldlay(ip,ic,3)                  = vgrid_z(Nlevels-k+1)      ! z_opaque altitude
-		    nsublay(ip,ic,3)                 = 1._wp
-		    zopac = Nlevels-k+1                        ! z_opaque vertical index on vgrid_z
-		 endif
-	         if ( cldy(ip,ic,Nlevels-k) .eq. 1. ) then
-		    lidarcldtype(ip,Nlevels-k ,1)    = lidarcldtype(ip,Nlevels-k ,1) + 1._wp
-		    z_top = Nlevels-k    ! top cloud layer vertical index on vgrid_z
+             if ( cldy(ip,ic,Nlevels-k) .eq. 1. .and. zopac .eq. 0. ) then
+            lidarcldtype(ip,Nlevels-k + 1,3) = lidarcldtype(ip,Nlevels-k + 1,3) + 1._wp
+            cldlay(ip,ic,3)                  = vgrid_z(Nlevels-k+1)      ! z_opaque altitude
+            nsublay(ip,ic,3)                 = 1._wp
+            zopac = Nlevels-k+1                        ! z_opaque vertical index on vgrid_z
+         endif
+             if ( cldy(ip,ic,Nlevels-k) .eq. 1. ) then
+            lidarcldtype(ip,Nlevels-k ,1)    = lidarcldtype(ip,Nlevels-k ,1) + 1._wp
+            z_top = Nlevels-k    ! top cloud layer vertical index on vgrid_z
                  endif
-	      enddo
+          enddo
      ! Summing opaque cloud mean temperatures and altitudes
      ! as defined in Vaillant de Guelis et al. 2017a, AMT
@@ -1432,44 +1432,44 @@
                  cldlay(ip,ic,1) = 0
               endif
-	   endif
+       endif
 
      ! Thin cloud profiles
-	   if ( cldlay(ip,ic,2) .eq. 1. ) then
-	      topcloud = 0._wp
-	      z_top = 0._wp
-	      z_base = 0._wp
-	      do k=1,Nlevels
+       if ( cldlay(ip,ic,2) .eq. 1. ) then
+          topcloud = 0._wp
+          z_top = 0._wp
+          z_base = 0._wp
+          DO k=1,Nlevels
      ! Declaring thin cloud fraction for 3D variable
      ! From TOA-2-SFC
                  if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 1. ) then
                     lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
-		    z_base = k ! bottom cloud layer
+            z_base = k ! bottom cloud layer
                  endif
-	         if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 0. ) then
+             if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 0. ) then
                     lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
-		    z_top = k  ! top cloud layer
-		    z_base = k ! bottom cloud layer
+            z_top = k  ! top cloud layer
+            z_base = k ! bottom cloud layer
                     topcloud = 1._wp
-		 endif
-	      enddo
+         endif
+          enddo
      ! Computing mean emissivity using layers below the bottom cloud layer to the surface
-     	      srmean = 0._wp
-	      srcount = 0._wp
-	      cloudemis = 0._wp
-     	      do k=z_base+1,Nlevels
-	         if (  (x(ip,ic,k) .gt. S_att_opaq) .and. (x(ip,ic,k) .lt. 1.0) .and. (x(ip,ic,k) .ne. undef)  ) then
-		    srmean = srmean + x(ip,ic,k)
-		    srcount = srcount + 1.
+               srmean = 0._wp
+          srcount = 0._wp
+          cloudemis = 0._wp
+               DO k=z_base+1,Nlevels
+             if (  (x(ip,ic,k) .gt. S_att_opaq) .and. (x(ip,ic,k) .lt. 1.0) .and. (x(ip,ic,k) .ne. undef)  ) then
+            srmean = srmean + x(ip,ic,k)
+            srcount = srcount + 1.
                  endif
-	      enddo
-	      ! If clear sky layers exist below bottom cloud layer
-	      if ( srcount .gt. 0. ) then
-	      	 trans2 = srmean/srcount              ! thin cloud transmittance**2
-	      	 tau_app = -(log(trans2))/2.          ! apparent cloud optical depth
-	      	 tau_vis = tau_app/eta                ! cloud visible optical depth (multiple scat.)
-	      	 tau_ir = tau_vis/2.                  ! approx. relation between visible and IR ODs
-	      	 cloudemis = 1. - exp(-tau_ir)        ! no diffusion in IR considered : emis = 1-T
-		 count_emis(ip) = count_emis(ip) + 1.
-	      endif
+          enddo
+          ! If clear sky layers exist below bottom cloud layer
+          if ( srcount .gt. 0. ) then
+               trans2 = srmean/srcount              ! thin cloud transmittance**2
+               tau_app = -(log(trans2))/2.          ! apparent cloud optical depth
+               tau_vis = tau_app/eta                ! cloud visible optical depth (multiple scat.)
+               tau_ir = tau_vis/2.                  ! approx. relation between visible and IR ODs
+               cloudemis = 1. - exp(-tau_ir)        ! no diffusion in IR considered : emis = 1-T
+         count_emis(ip) = count_emis(ip) + 1.
+          endif
      ! Summing thin cloud mean temperatures and altitudes
      ! as defined in Vaillant de Guelis et al. 2017a, AMT
@@ -1500,18 +1500,18 @@
     ! 3D opacity fraction (=4) !Summing z_opaque fraction from TOA(k=1) to SFC(k=Nlevels)
        lidarcldtype(:,1,4) = lidarcldtype(:,1,3) !top layer equal to 3D z_opaque fraction
-    do ip = 1, Npoints
-     	do k = 2, Nlevels
+    DO ip = 1, Npoints
+         DO k = 2, Nlevels
             if ( (lidarcldtype(ip,k,3) .ne. undef) .and. (lidarcldtype(ip,k-1,4) .ne. undef) ) then
-	        lidarcldtype(ip,k,4) = lidarcldtype(ip,k,3) + lidarcldtype(ip,k-1,4)
-	    else
-	        lidarcldtype(ip,k,4) = undef
-	    endif
-	enddo
+            lidarcldtype(ip,k,4) = lidarcldtype(ip,k,3) + lidarcldtype(ip,k-1,4)
+        else
+            lidarcldtype(ip,k,4) = undef
+        endif
     enddo
+    enddo
 
     ! Layered cloud types (opaque, thin and z_opaque 2D variables)
 
-    do iz = 1, Ntype
-       do ic = 1, Ncolumns
+    DO iz = 1, Ntype
+       DO ic = 1, Ncolumns
           cldtype(:,iz)  = cldtype(:,iz)  + cldlay(:,ic,iz)
           nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_construct_destroy_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_construct_destroy_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_construct_destroy_mod.F90	(revision 5158)
@@ -15,7 +15,7 @@
                               numMODISReffIceBins,reffICE_binCenters, &
                               numMODISReffLiqBins, reffLIQ_binCenters, &
-			      numISCCPTauBins,numISCCPPresBins, &
-			      numMISRTauBins,numMISRHgtBins, &
-			      numModisTauBins,numMODISPresBins
+                  numISCCPTauBins,numISCCPPresBins, &
+                  numMISRTauBins,numMISRHgtBins, &
+                  numModisTauBins,numMODISPresBins
 
   implicit none
@@ -297,7 +297,7 @@
     type(cosp_optical_inputs),intent(inout) :: y
 
-    if (allocated(y%tau_067))       	  deallocate(y%tau_067)
-    if (allocated(y%emiss_11))      	  deallocate(y%emiss_11)
-    if (allocated(y%frac_out))    	  deallocate(y%frac_out)
+    if (allocated(y%tau_067))             deallocate(y%tau_067)
+    if (allocated(y%emiss_11))            deallocate(y%emiss_11)
+    if (allocated(y%frac_out))          deallocate(y%frac_out)
     if (allocated(y%beta_mol_calipso))    deallocate(y%beta_mol_calipso)
     if (allocated(y%tau_mol_calipso))     deallocate(y%tau_mol_calipso)
@@ -308,12 +308,12 @@
     if (allocated(y%tautot_ice_calipso))  deallocate(y%tautot_ice_calipso)
     if (allocated(y%tautot_liq_calipso))  deallocate(y%tautot_liq_calipso)
-    if (allocated(y%tautot_S_liq))	  deallocate(y%tautot_S_liq)
-    if (allocated(y%tautot_S_ice))    	  deallocate(y%tautot_S_ice)
-    if (allocated(y%z_vol_cloudsat))  	  deallocate(y%z_vol_cloudsat)
-    if (allocated(y%kr_vol_cloudsat)) 	  deallocate(y%kr_vol_cloudsat)
-    if (allocated(y%g_vol_cloudsat)) 	  deallocate(y%g_vol_cloudsat)
-    if (allocated(y%asym))            	  deallocate(y%asym)
-    if (allocated(y%ss_alb))         	  deallocate(y%ss_alb)
-    if (allocated(y%fracLiq))       	  deallocate(y%fracLiq)
+    if (allocated(y%tautot_S_liq))      deallocate(y%tautot_S_liq)
+    if (allocated(y%tautot_S_ice))          deallocate(y%tautot_S_ice)
+    if (allocated(y%z_vol_cloudsat))        deallocate(y%z_vol_cloudsat)
+    if (allocated(y%kr_vol_cloudsat))       deallocate(y%kr_vol_cloudsat)
+    if (allocated(y%g_vol_cloudsat))       deallocate(y%g_vol_cloudsat)
+    if (allocated(y%asym))                  deallocate(y%asym)
+    if (allocated(y%ss_alb))               deallocate(y%ss_alb)
+    if (allocated(y%fracLiq))             deallocate(y%fracLiq)
     if (allocated(y%beta_mol_grLidar532)) deallocate(y%beta_mol_grLidar532)
     if (allocated(y%betatot_grLidar532))  deallocate(y%betatot_grLidar532)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90	(revision 5158)
@@ -53,6 +53,6 @@
 ! mr_ozone,                             !Concentration ozone (Kg/Kg)
 ! dem_s                                 !Cloud optical emissivity
-! dtau_s               			!Cloud optical thickness
-! emsfc_lw = 1.        			!Surface emissivity dans radlwsw.F90
+! dtau_s                           !Cloud optical thickness
+! emsfc_lw = 1.                    !Surface emissivity dans radlwsw.F90
 
 
@@ -95,40 +95,40 @@
 
   ! Local variables
-  character(len=64),PARAMETER	:: cosp_input_nl  = 'cospv2_input_nl.txt'
-  character(len=64),PARAMETER  	:: cosp_output_nl = 'cospv2_output_nl.txt'
-
-  integer, save 	       	:: isccp_topheight, isccp_topheight_direction, overlap
-  integer, save  	       	:: Ncolumns    	    	! Number of subcolumns in SCOPS
-  integer, save 	       	:: Npoints            	! Number of gridpoints
+  character(len=64),PARAMETER    :: cosp_input_nl  = 'cospv2_input_nl.txt'
+  character(len=64),PARAMETER      :: cosp_output_nl = 'cospv2_output_nl.txt'
+
+  integer, save                :: isccp_topheight, isccp_topheight_direction, overlap
+  integer, save                 :: Ncolumns                ! Number of subcolumns in SCOPS
+  integer, save                :: Npoints                ! Number of gridpoints
 !$OMP THREADPRIVATE(Npoints)
-  integer, save			:: Nlevels		! Number of model vertical levels
-  integer  			:: Nptslmdz, Nlevlmdz  	! Nb de points issus de physiq.F
-  integer, save 		:: Npoints_it   	! Max number of gridpoints to be 
-  	   			   			! processed in one iteration
-  type(cosp_config), save 	:: cfg          	! Variable qui contient les cles
-  		     		   			! logiques des simulateurs et des
-							! diagnostics, definie dans:
-							! lmdz_cosp_construct_destroy_mod
+  integer, save            :: Nlevels        ! Number of model vertical levels
+  integer              :: Nptslmdz, Nlevlmdz      ! Nb de points issus de physiq.F
+  integer, save         :: Npoints_it       ! Max number of gridpoints to be
+                                    ! processed in one iteration
+  type(cosp_config), save     :: cfg              ! Variable qui contient les cles
+                                      ! logiques des simulateurs et des
+                            ! diagnostics, definie dans:
+                            ! lmdz_cosp_construct_destroy_mod
 !$OMP THREADPRIVATE(cfg)
 
-  integer			:: t0, t1, count_rate, count_max
-  real(wp), save 		:: cloudsat_radar_freq, cloudsat_k2, rttov_ZenAng, co2, &
-  	    			   ch4, n2o, co, emsfc_lw
+  integer            :: t0, t1, count_rate, count_max
+  real(wp), save         :: cloudsat_radar_freq, cloudsat_k2, rttov_ZenAng, co2, &
+                         ch4, n2o, co, emsfc_lw
 !$OMP THREADPRIVATE(emsfc_lw)
 
-  integer, dimension(RTTOV_MAX_CHANNELS), save	 :: rttov_Channels
+  integer, dimension(RTTOV_MAX_CHANNELS), save     :: rttov_Channels
   real(wp), dimension(RTTOV_MAX_CHANNELS), save  :: rttov_Surfem
-  integer, save 			   	 :: surface_radar, use_mie_tables, &
-  	   					    cloudsat_use_gas_abs, cloudsat_do_ray, &
-						    melt_lay
-  integer, save 				 :: lidar_ice_type
-  integer, save 				 :: rttov_platform, rttov_satellite, &
-  	   					    rttov_Instrument, rttov_Nchannels
-  logical, save 				 :: use_vgrid_in, csat_vgrid_in, &
-  	   					    use_precipitation_fluxes
+  integer, save                     :: surface_radar, use_mie_tables, &
+                                 cloudsat_use_gas_abs, cloudsat_do_ray, &
+                            melt_lay
+  integer, save                  :: lidar_ice_type
+  integer, save                  :: rttov_platform, rttov_satellite, &
+                                 rttov_Instrument, rttov_Nchannels
+  logical, save                  :: use_vgrid_in, csat_vgrid_in, &
+                                 use_precipitation_fluxes
 
 ! Declaration necessaires pour les sorties IOIPSL
-  real        	:: ecrit_day, ecrit_hf, ecrit_mth, missing_val
-  logical 	:: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
+  REAL            :: ecrit_day, ecrit_hf, ecrit_mth, missing_val
+  logical     :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
   logical, save :: debut_cosp=.true.
 !$OMP THREADPRIVATE(debut_cosp)
@@ -142,19 +142,19 @@
 
 !-----------------------------  Input variables from LMDZ-GCM  -------------------------------
-  integer                             	     :: overlaplmdz   ! overlap type: 1=max, 
-  					       		      ! 2=rand, 3=max/rand
-  real, dimension(Nptslmdz,Nlevlmdz) 	     :: phi, p, ph, T, sh, rh, tca, cca, mr_lsliq,   &
-  					        mr_lsice, mr_ccliq, mr_ccice, fl_lsrain,     & 
-                                       	        fl_lssnow, fl_ccrain, fl_ccsnow, fl_lsgrpl,  &
-                                       	        zlev, zlev_half, mr_ozone, radliq, radice,   &
-					        dtau_s, dem_s, dtau_c, dem_c, ref_liq, ref_ice
-  real, dimension(Nptslmdz,Nlevlmdz) 	     :: fl_lsrainI, fl_lssnowI, fl_ccrainI, fl_ccsnowI
-  real, dimension(Nptslmdz)        	     :: lon, lat, skt, fracTerLic, u_wind, v_wind, &
-  					        phis, sunlit
-  real, dimension(Nptslmdz)        	     :: land ! variables intermediaire pour masque TerLic
-  real, dimension(Nlevlmdz)        	     :: presnivs
-  integer                         	     :: itap, k, ip
-  real                            	     :: dtime, freq_cosp
-  real, dimension(2)               	     :: time_bnds
+  integer                                      :: overlaplmdz   ! overlap type: 1=max,
+                                           ! 2=rand, 3=max/rand
+  real, dimension(Nptslmdz,Nlevlmdz)          :: phi, p, ph, T, sh, rh, tca, cca, mr_lsliq,   &
+                              mr_lsice, mr_ccliq, mr_ccice, fl_lsrain,     &
+                                                   fl_lssnow, fl_ccrain, fl_ccsnow, fl_lsgrpl,  &
+                                                   zlev, zlev_half, mr_ozone, radliq, radice,   &
+                            dtau_s, dem_s, dtau_c, dem_c, ref_liq, ref_ice
+  real, dimension(Nptslmdz,Nlevlmdz)          :: fl_lsrainI, fl_lssnowI, fl_ccrainI, fl_ccsnowI
+  real, dimension(Nptslmdz)                 :: lon, lat, skt, fracTerLic, u_wind, v_wind, &
+                              phis, sunlit
+  real, dimension(Nptslmdz)                 :: land ! variables intermediaire pour masque TerLic
+  real, dimension(Nlevlmdz)                 :: presnivs
+  integer                                  :: itap, k, ip
+  REAL                                     :: dtime, freq_cosp
+  real, dimension(2)                        :: time_bnds
 
   double precision                           :: d_dtime
@@ -169,20 +169,20 @@
   logical :: &
        Lsingle     = .true.,  & ! True if using MMF_v3_single_moment CLOUDSAT
-       		     	      	! microphysical scheme (default)
+                                  ! microphysical scheme (default)
        Ldouble     = .false.    ! True if using MMF_v3.5_two_moment CLOUDSAT 
-       		     		! microphysical scheme
-  type(size_distribution), save   	     :: sd            ! Hydrometeor description
+                            ! microphysical scheme
+  type(size_distribution), save            :: sd            ! Hydrometeor description
 !$OMP THREADPRIVATE(sd)
-  type(radar_cfg), save			     :: rcfg_cloudsat ! Radar configuration
+  type(radar_cfg), save                 :: rcfg_cloudsat ! Radar configuration
 !$OMP THREADPRIVATE(rcfg_cloudsat)
-  real, dimension(Nptslmdz,Nlevlmdz,N_HYDRO) :: Reff	      ! Liquid and Ice particles
-  					     		      ! effective radius
-  type(cosp_outputs)			     :: cospOUT       ! COSP simulator outputs
-  type(cosp_optical_inputs) 		     :: cospIN        ! COSP optical (or derived?)
-  					     		      ! fields needed by simulators
-  type(cosp_column_inputs) 		     :: cospstateIN   ! COSP model fields needed
-  					     		      ! by simulators
-  character(len=256), dimension(100)	     :: cosp_status
-  character(len=64), save      		     :: cloudsat_micro_scheme
+  real, dimension(Nptslmdz,Nlevlmdz,N_HYDRO) :: Reff          ! Liquid and Ice particles
+                                         ! effective radius
+  type(cosp_outputs)                 :: cospOUT       ! COSP simulator outputs
+  type(cosp_optical_inputs)              :: cospIN        ! COSP optical (or derived?)
+                                         ! fields needed by simulators
+  type(cosp_column_inputs)              :: cospstateIN   ! COSP model fields needed
+                                         ! by simulators
+  character(len=256), dimension(100)         :: cosp_status
+  character(len=64), save                   :: cloudsat_micro_scheme
 
   ! Indices to address arrays of LS and CONV hydrometeors
@@ -271,5 +271,5 @@
   print*,' Cles des differents simulateurs cosp a itap :',itap
   print*,'cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
-	cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
+    cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
         cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
         cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
@@ -340,7 +340,7 @@
 print*,' Cles des differents simulateurs cosp a itap :',itap
 print*,'cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
-	cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
+    cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov', &
         cfg%Lcloudsat, cfg%Lcalipso, cfg%LgrLidar532, cfg%Latlid, cfg%Lparasol, &
-	cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
+    cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
 
   endif !(itap.gt.1).and.(first_write)
@@ -369,6 +369,6 @@
 
         zlev_half(:,1) = phis(:)/9.81
-        do k = 2, Nlevels
-          do ip = 1, Npoints
+        DO k = 2, Nlevels
+          DO ip = 1, Npoints
            zlev_half(ip,k) = phi(ip,k)/9.81 + &
                (phi(ip,k)-phi(ip,k-1))/9.81 * (ph(ip,k)-p(ip,k)) / (p(ip,k)-p(ip,k-1))
@@ -383,5 +383,5 @@
 
 ! 3) Masque terre/mer a partir de la variable fracTerLic
-        do ip = 1, Npoints
+        DO ip = 1, Npoints
           if (fracTerLic(ip).ge.0.5) then
              land(ip) = 1.
@@ -445,19 +445,19 @@
     call construct_cospstateIN(Npoints,Nlevels,0,cospstateIN)
 
-    cospstateIN%lat                 		        = lat(1:Npoints)
-    cospstateIN%lon                     		= lon(1:Npoints) 
-    cospstateIN%at              	      		= t(1:Npoints,Nlevels:1:-1) 
-    cospstateIN%qv              	     		= sh(1:Npoints,Nlevels:1:-1)
-    cospstateIN%o3              	      		= mr_ozone(1:Npoints,Nlevels:1:-1)  
-    cospstateIN%sunlit          	      		= sunlit(1:Npoints)
-    cospstateIN%skt             	       		= skt(1:Npoints)
-    cospstateIN%land            	     		= land(1:Npoints)
-    cospstateIN%surfelev            	     		= zlev_half(1:Npoints,1)
-    cospstateIN%pfull           	      		= p(1:Npoints,Nlevels:1:-1)
-    cospstateIN%phalf(1:Npoints,1)	                = 0._wp
-    cospstateIN%phalf(1:Npoints,2:Nlevels+1)	        = ph(1:Npoints,Nlevels:1:-1)  
-    cospstateIN%hgt_matrix                  		= zlev(1:Npoints,Nlevels:1:-1) 
-    cospstateIN%hgt_matrix_half(1:Npoints,Nlevels+1) 	= 0._wp
-    cospstateIN%hgt_matrix_half(1:Npoints,1:Nlevels) 	= zlev_half(1:Npoints,Nlevels:1:-1) 
+    cospstateIN%lat                                 = lat(1:Npoints)
+    cospstateIN%lon                             = lon(1:Npoints)
+    cospstateIN%at                                = t(1:Npoints,Nlevels:1:-1)
+    cospstateIN%qv                               = sh(1:Npoints,Nlevels:1:-1)
+    cospstateIN%o3                                = mr_ozone(1:Npoints,Nlevels:1:-1)
+    cospstateIN%sunlit                            = sunlit(1:Npoints)
+    cospstateIN%skt                                = skt(1:Npoints)
+    cospstateIN%land                             = land(1:Npoints)
+    cospstateIN%surfelev                             = zlev_half(1:Npoints,1)
+    cospstateIN%pfull                             = p(1:Npoints,Nlevels:1:-1)
+    cospstateIN%phalf(1:Npoints,1)                    = 0._wp
+    cospstateIN%phalf(1:Npoints,2:Nlevels+1)            = ph(1:Npoints,Nlevels:1:-1)
+    cospstateIN%hgt_matrix                          = zlev(1:Npoints,Nlevels:1:-1)
+    cospstateIN%hgt_matrix_half(1:Npoints,Nlevels+1)     = 0._wp
+    cospstateIN%hgt_matrix_half(1:Npoints,1:Nlevels)     = zlev_half(1:Npoints,Nlevels:1:-1)
 
 
@@ -483,21 +483,21 @@
 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-    call subsample_and_optics(cfg, Npoints, Nlevels, Ncolumns, N_HYDRO,overlap,	&
-        		      use_precipitation_fluxes, lidar_ice_type, sd, &
-			      tca(1:Npoints,Nlevels:1:-1), cca(1:Npoints,Nlevels:1:-1), &
-           		      fl_lsrain(1:Npoints,Nlevels:1:-1), &
-			      fl_lssnow(1:Npoints,Nlevels:1:-1), &
-			      fl_lsgrpl(1:Npoints,Nlevels:1:-1), &
-			      fl_ccrain(1:Npoints,Nlevels:1:-1), &
-          		      fl_ccsnow(1:Npoints,Nlevels:1:-1), &
-			      mr_lsliq(1:Npoints,Nlevels:1:-1), &
-			      mr_lsice(1:Npoints,Nlevels:1:-1), &
-			      mr_ccliq(1:Npoints,Nlevels:1:-1), &
-			      mr_ccice(1:Npoints,Nlevels:1:-1), &
-             		      Reff(1:Npoints,Nlevels:1:-1,:), &
-			      dtau_c(1:Npoints,Nlevels:1:-1), &
-			      dtau_s(1:Npoints,Nlevels:1:-1), &
-			      dem_c(1:Npoints,Nlevels:1:-1), &
-			      dem_s(1:Npoints,Nlevels:1:-1), cospstateIN, cospIN)
+    call subsample_and_optics(cfg, Npoints, Nlevels, Ncolumns, N_HYDRO,overlap,    &
+                      use_precipitation_fluxes, lidar_ice_type, sd, &
+                  tca(1:Npoints,Nlevels:1:-1), cca(1:Npoints,Nlevels:1:-1), &
+                         fl_lsrain(1:Npoints,Nlevels:1:-1), &
+                  fl_lssnow(1:Npoints,Nlevels:1:-1), &
+                  fl_lsgrpl(1:Npoints,Nlevels:1:-1), &
+                  fl_ccrain(1:Npoints,Nlevels:1:-1), &
+                        fl_ccsnow(1:Npoints,Nlevels:1:-1), &
+                  mr_lsliq(1:Npoints,Nlevels:1:-1), &
+                  mr_lsice(1:Npoints,Nlevels:1:-1), &
+                  mr_ccliq(1:Npoints,Nlevels:1:-1), &
+                  mr_ccice(1:Npoints,Nlevels:1:-1), &
+                           Reff(1:Npoints,Nlevels:1:-1,:), &
+                  dtau_c(1:Npoints,Nlevels:1:-1), &
+                  dtau_s(1:Npoints,Nlevels:1:-1), &
+                  dem_c(1:Npoints,Nlevels:1:-1), &
+                  dem_s(1:Npoints,Nlevels:1:-1), cospstateIN, cospIN)
 
 
@@ -531,5 +531,5 @@
                                    ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml, &
                                    ecrit_mth, ecrit_day, ecrit_hf, use_vgrid_in,         &
-			           niv_sorties, vgrid_z_in, zlev(1,:))
+                       niv_sorties, vgrid_z_in, zlev(1,:))
 
       !$OMP END MASTER
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_mod.F90	(revision 5158)
@@ -88,5 +88,5 @@
          "clcalipsoliq", "CALIPSO Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "clcalipsoun", "CALIPSO Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))	 
+         "clcalipsoun", "CALIPSO Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "clcalipsotmpice", "CALIPSO Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
@@ -109,5 +109,5 @@
          "clcalipsothin", "CALIPSO Thin profile Cloud Fraction", "%", (/ ('', i=1, 3) /))      
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsozopaque = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
-         "clcalipsozopaque", "CALIPSO z_opaque Fraction", "%", (/ ('', i=1, 3) /))	   
+         "clcalipsozopaque", "CALIPSO z_opaque Fraction", "%", (/ ('', i=1, 3) /))
   TYPE(ctrl_outcosp), SAVE :: o_clcalipsoopacity = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "clcalipsoopacity", "CALIPSO opacity Fraction", "%", (/ ('', i=1, 3) /))
@@ -311,5 +311,5 @@
                               ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml,  &
                               ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, Nlvgrid, vgrid_z_loc, &
-			      vgrid_mz)
+                  vgrid_mz)
 
   use mod_cosp_config, only : CLOUDSAT_DBZE_BINS, SR_BINS, CLOUDSAT_CFAD_ZE_MIN, PARASOL_NREFL, &
@@ -319,5 +319,5 @@
                               numMODISReffIceBins,reffICE_binCenters, &
                               numMODISReffLiqBins, reffLIQ_binCenters, pres_binCenters, &
-			      cloudsat_binCenters, calipso_binCenters
+                  cloudsat_binCenters, calipso_binCenters
 
   USE iophy
@@ -335,5 +335,5 @@
   real,dimension(Nlevlmdz) :: presnivs, vgrid_mz
   real,dimension(Nlvgrid)  :: vgrid_z_loc
-  real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth 
+  REAL                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
   logical                  :: use_vgrid
   logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml
@@ -341,5 +341,5 @@
 !!! Variables locales
   integer                   :: idayref, iff, ii
-  real                      :: zjulian,zjulian_start
+  REAL                      :: zjulian,zjulian_start
   real(wp),dimension(Ncolumns)  :: column_ax
   CHARACTER(LEN=20), DIMENSION(3)  :: chfreq = (/ '1day', '1d  ', '3h  ' /)            
@@ -359,5 +359,5 @@
 
 !! Definition valeurs axes
-    do ii=1,Ncolumns
+    DO ii=1,Ncolumns
       column_ax(ii) = real(ii)
     enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90	(revision 5158)
@@ -46,5 +46,5 @@
 !!! Variables d'entree
   integer               :: itap, Nlevlmdz, Ncolumns, Npoints, Nlvgrid
-  real                  :: freq_COSP, dtime, missing_val, missing_cosp
+  REAL                  :: freq_COSP, dtime, missing_val, missing_cosp
   type(cosp_config)     :: cfg     ! Control outputs
   type(cosp_outputs)    :: &
@@ -257,7 +257,7 @@
      where(cospOUT%calipso_cfad_sr == R_UNDEF) cospOUT%calipso_cfad_sr = missing_val
     
-     do icl=1,SR_BINS
-      do k=1,Nlvgrid
-       do ip=1,Npoints
+     DO icl=1,SR_BINS
+      DO k=1,Nlvgrid
+       DO ip=1,Npoints
         tmp_fi4da_cfadL(ip,k,icl)=cospOUT%calipso_cfad_sr(ip,icl,k)
        enddo
@@ -312,7 +312,7 @@
    if (cfg%LcfadLidarsr532gr) then
      where(cospOUT%grLidar532_cfad_sr == R_UNDEF) cospOUT%grLidar532_cfad_sr = missing_val
-     do icl=1,SR_BINS
-      do k=1,Nlvgrid
-       do ip=1,Npoints
+     DO icl=1,SR_BINS
+      DO k=1,Nlvgrid
+       DO ip=1,Npoints
          tmp_fi4da_cfadLgr(ip,k,icl)=cospOUT%grLidar532_cfad_sr(ip,icl,k)
        enddo
@@ -360,7 +360,7 @@
    if (cfg%LcfadLidarsr355) then
      where(cospOUT%atlid_cfad_sr == R_UNDEF) cospOUT%atlid_cfad_sr = missing_val
-     do icl=1,SR_BINS
-      do k=1,Nlvgrid
-       do ip=1,Npoints
+     DO icl=1,SR_BINS
+      DO k=1,Nlvgrid
+       DO ip=1,Npoints
           tmp_fi4da_cfadLatlid(ip,k,icl)=cospOUT%atlid_cfad_sr(ip,icl,k)
        enddo
@@ -456,7 +456,7 @@
    if (cfg%LcfadDbze94)  then
      where(cospOUT%cloudsat_cfad_ze == R_UNDEF) cospOUT%cloudsat_cfad_ze = missing_val  
-     do icl=1,CLOUDSAT_DBZE_BINS
-      do k=1,Nlvgrid
-       do ip=1,Npoints
+     DO icl=1,CLOUDSAT_DBZE_BINS
+      DO k=1,Nlvgrid
+       DO ip=1,Npoints
          tmp_fi4da_cfadR(ip,k,icl)=cospOUT%cloudsat_cfad_ze(ip,icl,k)
        enddo
@@ -531,7 +531,7 @@
    where(cospOUT%misr_cldarea == R_UNDEF) cospOUT%misr_cldarea = missing_val
 
-   do icl=1,numMISRHgtBins
-      do k=1,Nlvgrid
-       do ip=1,Npoints    
+   DO icl=1,numMISRHgtBins
+      DO k=1,Nlvgrid
+       DO ip=1,Npoints
       tmp_fi4da_misr(ip,icl,k)=cospOUT%misr_fq(ip,k,icl)
        enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_read_outputkeys.F90	(revision 5158)
@@ -29,5 +29,5 @@
          Lcloudsat,        & ! CLOUDSAT simulator on/off switch 
          Lcalipso,         & ! CALIPSO simulator on/off switch 
-	 LgrLidar532,      & ! GROUND LIDAR simulator on/off switch
+     LgrLidar532,      & ! GROUND LIDAR simulator on/off switch
          Latlid,           & ! ATLID simulator on/off switch
          Lisccp,           & ! ISCCP simulator on/off switch
@@ -161,5 +161,5 @@
   integer :: i
                 
-   do i=1,107
+   DO i=1,107
       cfg%out_list(i)=''
    enddo
@@ -295,5 +295,5 @@
   integer :: i
 
-   do i=1,107
+   DO i=1,107
       cfg%out_list(i)=''
    enddo
@@ -490,5 +490,5 @@
                        Lptradarflag8,Lptradarflag9,Lradarpia
 
-  do i=1,107
+  DO i=1,107
     cfg%out_list(i)=''
   enddo
@@ -1062,5 +1062,5 @@
  IF (using_xios) THEN
 
-  do i=1,107
+  DO i=1,107
     cfg%out_list(i)=''
   enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_subsample_and_optics_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_subsample_and_optics_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_subsample_and_optics_mod.F90	(revision 5158)
@@ -142,7 +142,7 @@
        frac_cv(1:nPoints,1:nLevels) = 0._wp
        prec_cv(1:nPoints,1:nLevels) = 0._wp
-       do j=1,nPoints
-          do k=1,nLevels
-             do i=1,nColumns
+       DO j=1,nPoints
+          DO k=1,nLevels
+             DO i=1,nColumns
                 if (cospIN%frac_out(j,i,k)  .eq. 1)  frac_ls(j,k) = frac_ls(j,k)+1._wp
                 if (cospIN%frac_out(j,i,k)  .eq. 2)  frac_cv(j,k) = frac_cv(j,k)+1._wp
@@ -171,5 +171,5 @@
        Reff(:,:,:,:)     = 0._wp
        Np(:,:,:,:)       = 0._wp
-       do k=1,nColumns
+       DO k=1,nColumns
           ! Subcolumn cloud fraction
           column_frac_out = cospIN%frac_out(:,k,:)
@@ -214,6 +214,6 @@
        fl_ccrain(:,:) = 0._wp
        fl_ccsnow(:,:) = 0._wp
-       do k=1,nLevels
-          do j=1,nPoints
+       DO k=1,nLevels
+          DO j=1,nPoints
              ! In-cloud mixing ratios.
              if (frac_ls(j,k) .ne. 0.) then
@@ -359,6 +359,6 @@
        allocate(g_vol(nPoints,nLevels))
        g_vol(:,:)=0._wp
-       do i=1,nPoints
-          do j=1,nLevels
+       DO i=1,nPoints
+          DO j=1,nLevels
              if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. (cospIN%rcfg_cloudsat%use_gas_abs == 2 .and. j .eq. 1)) then
                 g_vol(i,j) = gases(cospstateIN%pfull(i,j), cospstateIN%at(i,j),cospstateIN%qv(i,j),cospIN%rcfg_cloudsat%freq)
@@ -371,5 +371,5 @@
        allocate(fracPrecipIce(nPoints,nColumns,nLevels))
        fracPrecipIce(:,:,:) = 0._wp
-       do k=1,nColumns
+       DO k=1,nColumns
           call quickbeam_optics(sd, cospIN%rcfg_cloudsat, nPoints, nLevels, R_UNDEF,  &
                mr_hydro(:,k,:,1:nHydro)*1000._wp, Reff(:,k,:,1:nHydro)*1.e6_wp,&
@@ -406,6 +406,6 @@
 
        ! For near-surface diagnostics, we only need the frozen fraction at one layer.
-       do i=1,nPoints                                                                       !PREC_BUG
-	  cospIN%fracPrecipIce(i,:) = fracPrecipIce_statGrid(i,:,cloudsat_preclvl_index(i)) !PREC_BUG
+       DO i=1,nPoints                                                                       !PREC_BUG
+      cospIN%fracPrecipIce(i,:) = fracPrecipIce_statGrid(i,:,cloudsat_preclvl_index(i)) !PREC_BUG
        enddo                                                                                !PREC_BUG
 !       cospIN%fracPrecipIce(:,:) = fracPrecipIce_statGrid(:,:,cloudsat_preclvl)      !!! ORIGINAL
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/math_lib.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/math_lib.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/math_lib.F90	(revision 5158)
@@ -96,5 +96,5 @@
     else
        sumo = 0._wp
-       do j=i1,i2
+       DO j=i1,i2
           deltah = abs(s(i1+1)-s(i1))
           sumo = sumo + f(j)*deltah
@@ -204,5 +204,5 @@
     end if
     
-    do i = 2, ntab
+    DO i = 2, ntab
        if ( xtab(i) <= xtab(i-1) ) then
           lerror = .true.
@@ -239,5 +239,5 @@
     ihi = ntab
     
-    do i = 1, ntab
+    DO i = 1, ntab
        if ( a <= xtab(i) ) then
           exit
@@ -249,5 +249,5 @@
     ilo = min ( ilo, ntab - 1 )
     
-    do i = 1, ntab
+    DO i = 1, ntab
        if ( xtab(i) <= b ) then
           exit
@@ -263,5 +263,5 @@
 !ds    sum1 = 0.0D+00
     
-    do i = ilo, ihi
+    DO i = ilo, ihi
        
        x1 = xtab(i-1)
@@ -371,5 +371,5 @@
           ga=1._wp
           m1=x-1
-          do k=2,m1
+          DO k=2,m1
              ga=ga*k
           enddo
@@ -382,5 +382,5 @@
           m=int(z)
           r=1._wp
-          do k=1,m
+          DO k=1,m
              r=r*(z-k)
           enddo
@@ -390,5 +390,5 @@
        endif
        gr=g(26)
-       do k=25,1,-1
+       DO k=25,1,-1
           gr=gr*z+g(k)
        enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/modis_simulator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/modis_simulator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/modis_simulator.F90	(revision 5158)
@@ -163,5 +163,5 @@
     cloudMask = retrievedTau(1:nSubCols) >= min_OpticalThickness
     
-    do i = 1, nSubCols
+    DO i = 1, nSubCols
        if(cloudMask(i)) then 
           ! ##################################################################################
@@ -380,5 +380,5 @@
     reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
     reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
-    do j=1,nPoints
+    DO j=1,nPoints
 
        ! Fill clear and optically thin subcolumns with fill
@@ -439,5 +439,5 @@
     !   layers and use the trapezoidal rule.
     totalTau = 0._wp; totalProduct = 0._wp
-    do i = 2, size(tauIncrement)
+    DO i = 2, size(tauIncrement)
       if(totalTau + tauIncrement(i) > tauLimit) then 
         deltaX = tauLimit - totalTau
@@ -479,5 +479,5 @@
     ! Find the extinction-weighted value of f(tau), assuming constant f within each layer
     totalTau = 0._wp; totalProduct = 0._wp
-    do i = 1, size(tauIncrement)
+    DO i = 1, size(tauIncrement)
       if(totalTau + tauIncrement(i) > tauLimit) then 
         deltaX       = tauLimit - totalTau
@@ -712,5 +712,5 @@
     cloudMask(1:nLevels) = tau(1:nLevels) > 0. 
     cloudIndicies = pack((/ (i, i = 1, nLevels) /), mask = cloudMask) 
-    do i = 1, size(cloudIndicies)
+    DO i = 1, size(cloudIndicies)
        call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
     end do
@@ -892,5 +892,5 @@
     Tran_cumulative(1) = Tran(1)    
     
-    do i=2, npts
+    DO i=2, npts
        ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
        Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1._wp - Refl_cumulative(i-1) * Refl(i))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/optics_lib.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/optics_lib.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/optics_lib.F90	(revision 5158)
@@ -539,5 +539,5 @@
     if (alam < cutice) then
        ! Region from 0.045 microns to 167.0 microns - no temperature depend
-       do i=2,nwl
+       DO i=2,nwl
           if(alam < wl(i)) continue
        enddo
@@ -557,10 +557,10 @@
        if(tk > temref(1)) tk=temref(1)
        if(tk < temref(4)) tk=temref(4)
-       do i=2,4
+       DO i=2,4
           if(tk.ge.temref(i)) go to 12
        enddo
 12     lt1 = i
        lt2 = i-1
-       do i=2,nwlt
+       DO i=2,nwlt
           if(alam.le.wlt(i)) go to 14
        enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/parasol.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/parasol.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/parasol.F90	(revision 5158)
@@ -159,11 +159,11 @@
     ! Compute grid-box averaged Parasol reflectances
     parasolrefl(:,:) = 0._wp
-    do k = 1, nrefl
-       do ic = 1, ncol
+    DO k = 1, nrefl
+       DO ic = 1, ncol
           parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
        enddo
     enddo
     
-    do k = 1, nrefl
+    DO k = 1, nrefl
        parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
        ! if land=1 -> parasolrefl=R_UNDEF
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/prec_scops.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/prec_scops.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/prec_scops.F90	(revision 5158)
@@ -66,7 +66,7 @@
       if (cv_col .eq. 0) cv_col=1
  
-      do ilev=1,nlev
-        do ibox=1,ncol
-          do j=1,npoints 
+      DO ilev=1,nlev
+        DO ibox=1,ncol
+          DO j=1,npoints
             prec_frac(j,ibox,ilev) = 0
           enddo
@@ -74,11 +74,11 @@
       enddo
       
-      do j=1,npoints
-       do ibox=1,ncol
+      DO j=1,npoints
+       DO ibox=1,ncol
         frac_out_ls(j,ibox)=0
         frac_out_cv(j,ibox)=0
         flag_ls=0
         flag_cv=0
-        do ilev=1,nlev
+        DO ilev=1,nlev
           if (frac_out(j,ibox,ilev) .eq. 1) then 
             flag_ls=1
@@ -98,10 +98,10 @@
 
 !      initialize the top layer      
-       do j=1,npoints
+       DO j=1,npoints
         flag_ls=0
         flag_cv=0
     
         if (ls_p_rate(j,1) .gt. 0.) then 
-            do ibox=1,ncol ! possibility ONE
+            DO ibox=1,ncol ! possibility ONE
                 if (frac_out(j,ibox,1) .eq. 1) then 
                     prec_frac(j,ibox,1) = 1
@@ -110,5 +110,5 @@
             enddo ! loop over ncol
             if (flag_ls .eq. 0) then ! possibility THREE
-                do ibox=1,ncol
+                DO ibox=1,ncol
                     if (frac_out(j,ibox,2) .eq. 1) then 
                         prec_frac(j,ibox,1) = 1
@@ -118,5 +118,5 @@
             endif
         if (flag_ls .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_ls(j,ibox) .eq. 1) then 
             prec_frac(j,ibox,1) = 1
@@ -126,5 +126,5 @@
         endif
         if (flag_ls .eq. 0) then ! possibility Five
-        do ibox=1,ncol
+        DO ibox=1,ncol
     !     prec_frac(j,1:ncol,1) = 1
         prec_frac(j,ibox,1) = 1
@@ -135,5 +135,5 @@
      
         if (cv_p_rate(j,1) .gt. 0.) then 
-         do ibox=1,ncol ! possibility ONE
+         DO ibox=1,ncol ! possibility ONE
           if (frac_out(j,ibox,1) .eq. 2) then 
            if (prec_frac(j,ibox,1) .eq. 0) then
@@ -146,5 +146,5 @@
         enddo ! loop over ncol
         if (flag_cv .eq. 0) then ! possibility THREE
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out(j,ibox,2) .eq. 2) then 
                 if (prec_frac(j,ibox,1) .eq. 0) then
@@ -158,5 +158,5 @@
         endif
         if (flag_cv .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_cv(j,ibox) .eq. 1) then 
                 if (prec_frac(j,ibox,1) .eq. 0) then
@@ -170,5 +170,5 @@
         endif
         if (flag_cv .eq. 0) then  ! possibility Five
-        do ibox=1,cv_col
+        DO ibox=1,cv_col
                 if (prec_frac(j,ibox,1) .eq. 0) then
             prec_frac(j,ibox,1) = 2
@@ -187,11 +187,11 @@
 
 !     working on the levels from top to surface
-      do ilev=2,nlev
-       do j=1,npoints
+      DO ilev=2,nlev
+       DO j=1,npoints
         flag_ls=0
         flag_cv=0
     
         if (ls_p_rate(j,ilev) .gt. 0.) then 
-         do ibox=1,ncol ! possibility ONE&TWO
+         DO ibox=1,ncol ! possibility ONE&TWO
           if ((frac_out(j,ibox,ilev) .eq. 1) .or. ((prec_frac(j,ibox,ilev-1) .eq. 1)     &
             .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
@@ -201,5 +201,5 @@
         enddo ! loop over ncol
         if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out(j,ibox,ilev+1) .eq. 1) then 
             prec_frac(j,ibox,ilev) = 1
@@ -209,5 +209,5 @@
         endif
         if (flag_ls .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_ls(j,ibox) .eq. 1) then 
             prec_frac(j,ibox,ilev) = 1
@@ -217,5 +217,5 @@
         endif
         if (flag_ls .eq. 0) then ! possibility Five
-        do ibox=1,ncol
+        DO ibox=1,ncol
 !     prec_frac(j,1:ncol,ilev) = 1
         prec_frac(j,ibox,ilev) = 1
@@ -225,5 +225,5 @@
     
         if (cv_p_rate(j,ilev) .gt. 0.) then 
-         do ibox=1,ncol ! possibility ONE&TWO
+         DO ibox=1,ncol ! possibility ONE&TWO
           if ((frac_out(j,ibox,ilev) .eq. 2) .or. ((prec_frac(j,ibox,ilev-1) .eq. 2)     &
             .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
@@ -237,5 +237,5 @@
        enddo ! loop over ncol
         if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out(j,ibox,ilev+1) .eq. 2) then 
                 if (prec_frac(j,ibox,ilev) .eq. 0) then
@@ -249,5 +249,5 @@
         endif
         if (flag_cv .eq. 0) then ! possibility Four
-        do ibox=1,ncol
+        DO ibox=1,ncol
         if (frac_out_cv(j,ibox) .eq. 1) then 
                 if (prec_frac(j,ibox,ilev) .eq. 0) then
@@ -261,5 +261,5 @@
         endif
         if (flag_cv .eq. 0) then  ! possibility Five 
-        do ibox=1,cv_col
+        DO ibox=1,cv_col
                 if (prec_frac(j,ibox,ilev) .eq. 0) then
             prec_frac(j,ibox,ilev) = 2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam.F90	(revision 5158)
@@ -150,7 +150,7 @@
        d_gate     = -1
     endif
-    do k=start_gate,end_gate,d_gate
+    DO k=start_gate,end_gate,d_gate
        ! Loop over each profile (nprof)
-       do pr=1,nprof
+       DO pr=1,nprof
           ! Attenuation due to hydrometeors between radar and volume
           
@@ -284,6 +284,6 @@
           
           ! Effective reflectivity histogram
-          do i=1,Npoints
-             do j=1,llm
+          DO i=1,Npoints
+             DO j=1,llm
                 cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_toti(i,:,j),DBZE_BINS,cloudsat_histRef)
              enddo
@@ -301,6 +301,6 @@
        else
           ! Effective reflectivity histogram
-          do i=1,Npoints
-             do j=1,llm
+          DO i=1,Npoints
+             DO j=1,llm
                 cfad_ze(i,:,j) = hist1D(Ncolumns,Ze_tot(i,:,j),DBZE_BINS,cloudsat_histRef)
              enddo
@@ -395,10 +395,10 @@
     ! SUBCOLUMN processing
     ! ######################################################################################
-    do i=1, Npoints
+    DO i=1, Npoints
 
        cloudsat_preclvl = cloudsat_preclvl_index(i) !PREC_BUG
 !       print*, 'i, surfelev(i), cloudsat_preclvl : ', i, surfelev(i), cloudsat_preclvl !PREC_BUG
 
-       do pr=1,Ncolumns
+       DO pr=1,Ncolumns
           ! 1) Compute the PIA in all profiles containing hydrometeors
           if ( (Ze_non_out(i,pr,cloudsat_preclvl).gt.-100) .and. (Ze_out(i,pr,cloudsat_preclvl).gt.-100) ) then
@@ -523,7 +523,7 @@
 
     ! Aggregate subcolumns
-    do i=1,Npoints
+    DO i=1,Npoints
        ! Gridmean precipitation fraction for each precipitation type
-       do k=1,nCloudsatPrecipClass
+       DO k=1,nCloudsatPrecipClass
           if (any(cloudsat_pflag(i,:) .eq. k-1)) then
              cloudsat_precip_cover(i,k) = count(cloudsat_pflag(i,:) .eq. k-1)
@@ -571,7 +571,7 @@
             trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
        
-       do i=1,maxhclass
-          do j=1,mt_ntt
-             do k=1,nRe_types
+       DO i=1,maxhclass
+          DO j=1,mt_ntt
+             DO k=1,nRe_types
                 ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
                 read(12,rec=ind) rcfg%Z_scale_flag(i,j,k), &
@@ -607,7 +607,7 @@
          trim(rcfg%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
     
-    do i=1,maxhclass
-       do j=1,mt_ntt
-          do k=1,nRe_types
+    DO i=1,maxhclass
+       DO j=1,mt_ntt
+          DO k=1,nRe_types
              ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
              if(.not.LUT_file_exists .or. rcfg%Z_scale_added_flag(i,j,k)) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90	(revision 5158)
@@ -71,5 +71,5 @@
     mt_ttl = (/ ((j-1)*5-60 + 273.15, j = 1, cnt_liq) /)
     D(1) = dmin
-    do j=2,nd
+    DO j=2,nd
        D(j) = D(j-1)*exp((log(dmax)-log(dmin))/(nd-1))
     enddo
@@ -140,9 +140,9 @@
     kr_vol   = 0._wp
 
-    do k=1,ngate       ! Loop over each profile (nprof)
-       do pr=1,nprof
+    DO k=1,ngate       ! Loop over each profile (nprof)
+       DO pr=1,nprof
           ! Determine if hydrometeor(s) present in volume
           hydro = .false.
-          do j=1,rcfg%nhclass
+          DO j=1,rcfg%nhclass
              if ((hm_matrix(pr,k,j) > 1E-12) .and. (sd%dtype(j) > 0)) then
                 hydro = .true.
@@ -157,5 +157,5 @@
              
              ! Loop over hydrometeor type
-             do tp=1,rcfg%nhclass
+             DO tp=1,rcfg%nhclass
                 Re_internal = re_matrix(pr,k,tp)
 
@@ -342,5 +342,5 @@
     
     where(kr_vol(:,:) <= EPSILON(kr_vol)) 
-       ! Volume is hydrometeor-free	
+       ! Volume is hydrometeor-free
        !z_vol(:,:)  = undef
        z_ray(:,:)  = undef
@@ -794,5 +794,5 @@
        lidx = infind(D,dmin)
        uidx = infind(D,dmax)    
-       do k=lidx,uidx
+       DO k=lidx,uidx
           N(k) = (ahp*(D(k)*1E-3)**bhp) * 1E-12    
        enddo
@@ -980,5 +980,5 @@
        sizep = (pi*D0)/wl
        dqv(1) = 0._wp
-       do i=1,nsizes
+       DO i=1,nsizes
           call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
                dg, xs1, xs2, dph, err)
@@ -1183,5 +1183,5 @@
     sumo = 0._wp
     aux1 = 1.1_wp*e_th
-    do i=1,nbands_o2
+    DO i=1,nbands_o2
        aux2   = f/v0(i)
        aux3   = v0(i)-f
@@ -1207,5 +1207,5 @@
     sumo = 0._wp
     aux1 = 4.8_wp*e_th
-    do i=1,nbands_h2o
+    DO i=1,nbands_h2o
        aux2    = f/v1(i)
        aux3    = v1(i)-f
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/scops.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/scops.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/scops.F90	(revision 5158)
@@ -94,5 +94,5 @@
     if (ncolprint.ne.0) then
        write (6,'(a)') 'frac_out_pp_rev:'
-       do j=1,npoints,1000
+       DO j=1,npoints,1000
           write(6,'(a10)') 'j='
           write(6,'(8I10)') j
@@ -104,5 +104,5 @@
     if (ncolprint.ne.0) then
        write (6,'(a)') 'last_frac_pp:'
-       do j=1,npoints,1000
+       DO j=1,npoints,1000
           write(6,'(a10)') 'j='
           write(6,'(8I10)') j
@@ -139,5 +139,5 @@
           IF (ncolprint.ne.0) then
              write (6,'(a)') 'threshold_nsf2:'
-             do j=1,npoints,1000
+             DO j=1,npoints,1000
                 write(6,'(a10)') 'j='
                 write(6,'(8I10)') j
@@ -156,5 +156,5 @@
           !maxocc(1:npoints,ibox) = merge(1,0,boxpos(1:npoints,ibox) .le. conv(1:npoints,ilev))
           !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox))
-          do j=1,npoints
+          DO j=1,npoints
              if (boxpos(j,ibox).le.conv(j,ilev)) then
                 maxocc(j,ibox) = 1
@@ -214,5 +214,5 @@
        ! Set last_frac to tca at this level, so as to be tca from last level next time round
        if (ncolprint.ne.0) then
-          do j=1,npoints ,1000
+          DO j=1,npoints ,1000
              write(6,'(a10)') 'j='
              write(6,'(8I10)') j
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_buoy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_buoy.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_buoy.F90	(revision 5158)
@@ -11,8 +11,7 @@
   USE lmdz_cvthermo
   USE lmdz_cv3param
+  USE lmdz_yomcst2
 
   IMPLICIT NONE
-
-  include "YOMCST2.h"
 
   ! input:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inicp.F90	(revision 5158)
@@ -10,27 +10,28 @@
   ! **************************************************************
   USE lmdz_abort_physic, ONLY: abort_physic
+  USE lmdz_yomcst2
+
   IMPLICIT NONE
-  include "YOMCST2.h"
 
   INTEGER iflag_clos
-  CHARACTER (LEN=20) :: modname = 'cv3_inicp'
-  CHARACTER (LEN=80) :: abort_message
+  CHARACTER (LEN = 20) :: modname = 'cv3_inicp'
+  CHARACTER (LEN = 80) :: abort_message
 
   ! --   Mixing probability distribution functions
 
   REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
-  REAL :: sumcoef,sigma,aire,pdf,mu,df,ff
+  REAL :: sumcoef, sigma, aire, pdf, mu, df, ff
 
-  qcoef1(f) = tanh(f/gammas)
-  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
-  qff(f) = max(min(f,1.), 0.)
+  qcoef1(f) = tanh(f / gammas)
+  qcoef2(f) = (tanh(f / gammas) + gammas * log(cosh((1. - f) / gammas) / cosh(f / gammas)))
+  qff(f) = max(min(f, 1.), 0.)
   qfff(f) = min(qff(f), scut)
-  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
-  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
-    qcoef2max
-  qmix2(f) = -log(1.-qfff(f))/scut
-  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
-  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
-  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
+  qmix1(f) = (tanh((qff(f) - fmax) / gammas) + qcoef1max) / qcoef2max
+  rmix1(f) = (gammas * log(cosh((qff(f) - fmax) / gammas)) + qff(f) * qcoef1max) / &
+          qcoef2max
+  qmix2(f) = -log(1. - qfff(f)) / scut
+  rmix2(f) = (qfff(f) + (1. - qff(f)) * log(1. - qfff(f))) / scut
+  qmix(f) = qqa1 * qmix1(f) + qqa2 * qmix2(f)
+  rmix(f) = qqa1 * rmix1(f) + qqa2 * rmix2(f)
 
   ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
@@ -76,6 +77,6 @@
 
     sumcoef = qqa1 + qqa2
-    qqa1 = qqa1/sumcoef
-    qqa2 = qqa2/sumcoef
+    qqa1 = qqa1 / sumcoef
+    qqa2 = qqa2 / sumcoef
 
     qcoef1max = qcoef1(fmax)
@@ -90,8 +91,8 @@
     ! do ff = 0.0 + df, 1.0 - 2.*df, df
     ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff)
-      mu = mu + pdf*ff*df
+    DO WHILE (ff<=1.0 - 2. * df)
+      pdf = (qmix(ff + df) - qmix(ff)) * (1. - ff) / df
+      aire = aire + (qmix(ff + df) - qmix(ff)) * (1. - ff)
+      mu = mu + pdf * ff * df
       ! c              WRITE(*,*) pdf,  Qmix(ff), aire, ff
       ff = ff + df
@@ -100,12 +101,12 @@
     ! do ff=0.0+df,1.0 - 2.*df,df
     ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      sigma = sigma + pdf*(ff-mu)*(ff-mu)*df
+    DO WHILE (ff<=1.0 - 2. * df)
+      pdf = (qmix(ff + df) - qmix(ff)) * (1. - ff) / df
+      sigma = sigma + pdf * (ff - mu) * (ff - mu) * df
       ff = ff + df
     END DO
     sigma = sqrt(sigma)
 
-    IF (abs(aire-1.0)>0.02) THEN
+    IF (abs(aire - 1.0)>0.02) THEN
       PRINT *, 'WARNING:: AREA OF MIXING PDF IS::', aire
       abort_message = ''
@@ -116,4 +117,3 @@
   END IF !  (iflag_mix .gt. 0)
 
-
 END SUBROUTINE cv3_inicp
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inip.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_inip.F90	(revision 5157)
+++ 	(revision )
@@ -1,147 +1,0 @@
-SUBROUTINE cv3_inip()
-  ! *******************************************************************
-  ! *                                                                  *
-  ! CV3_INIP Input = choice of mixing probability laws                 *
-  !          Output = normalized coefficients of the probability laws. *
-  ! *                                                                  *
-  ! written by   : Jean-Yves Grandpeix, 06/06/2006, 19.39.27           *
-  ! modified by :                                                      *
-  ! *******************************************************************
-
-!----------------------------------------------
-!  INPUT (from Common YOMCST2 in "YOMCST2.h") : 
-! iflag_mix
-! gammas    
-! alphas
-! betas
-! Fmax
-! scut
-
-!----------------------------------------------
-!  INPUT/OUTPUT (from and to Common YOMCST2 in "YOMCST2.h") : 
-! qqa1
-! qqa2
-
-!----------------------------------------------
-!  OUTPUT (to Common YOMCST2 in "YOMCST2.h") :
-! Qcoef1max
-! Qcoef2max
-
-!----------------------------------------------
-
-  USE lmdz_print_control, ONLY: prt_level, lunout
-  USE lmdz_abort_physic, ONLY: abort_physic
-  IMPLICIT NONE
-
-  include "YOMCST2.h"
-
-!----------------------------------------------
-! Local variables :
-   CHARACTER (LEN=20) :: modname = 'cv3_inip'
-   CHARACTER (LEN=80) :: abort_message
-
-   REAL               :: sumcoef
-   REAL               :: sigma, aire, pdf, mu, df
-   REAL               :: ff
-
-
-  ! --   Mixing probability distribution functions
-
-  REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
-
-  qcoef1(f) = tanh(f/gammas)
-  qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
-  qff(f) = max(min(f,1.), 0.)
-  qfff(f) = min(qff(f), scut)
-  qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
-  rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
-    qcoef2max
-  qmix2(f) = -log(1.-qfff(f))/scut
-  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
-  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
-  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
-
-  ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-  ! ===========================================================================
-  ! READ IN PARAMETERS FOR THE MIXING DISTRIBUTION
-  ! AND PASS THESE THROUGH A COMMON BLOCK TO SUBROUTINE CONVECT etc.
-  ! (Written by V.T.J. Phillips, 20-30/Jan/99)
-  ! ===========================================================================
-
-  ! line 1:  a flag (0 or 1) to decide whether P(F) = 1 or the general P(F)
-  ! is to be
-  ! used, followed by SCUT, which is the cut-off value of F in CONVECT
-  ! line 2:  blank
-  ! line 3:  the coefficients for the linear combination of P(F)s to
-  ! make the general P(F)
-  ! line 4:  blank
-  ! line 5:  gammas, Fmax for the cosh^2 component of P(F)
-  ! line 6:  blank
-  ! line 7:  alphas for the 1st irrational P(F)
-  ! line 8:  blank
-  ! line 9:  betas  for the 2nd irrational P(F)
-
-
-  ! c$$$        open(57,file='parameter_mix.data')
-  ! c$$$
-  ! c$$$        read(57,*) iflag_mix, scut
-  ! c$$$        read(57,*)
-  ! c$$$        IF(iflag_mix .gt. 0) THEN
-  ! c$$$	      read(57,*) qqa1, qqa2
-  ! c$$$              read(57,*)
-  ! c$$$              read(57,*) gammas, Fmax
-  ! c$$$              read(57,*)
-  ! c$$$              read(57,*) alphas
-  ! c$$$         endif
-  ! c$$$	 close(57)
-
-
-  IF (iflag_mix>0) THEN
-
-    ! --      Normalize Pdf weights
-
-    sumcoef = qqa1 + qqa2
-    qqa1 = qqa1/sumcoef
-    qqa2 = qqa2/sumcoef
-
-    qcoef1max = qcoef1(fmax)
-    qcoef2max = qcoef2(fmax)
-
-    sigma = 0.
-    aire = 0.0
-    pdf = 0.0
-    mu = 0.0
-    df = 0.0001
-
-    ! do ff = 0.0 + df, 1.0 - 2.*df, df
-    ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff)
-      mu = mu + pdf*ff*df
-      IF (prt_level>9) WRITE (lunout, *) pdf, qmix(ff), aire, ff
-      ff = ff + df
-    END DO
-
-    ! do ff=0.0+df,1.0 - 2.*df,df
-    ff = df
-    DO WHILE (ff<=1.0-2.*df)
-      pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
-      sigma = sigma + pdf*(ff-mu)*(ff-mu)*df
-      ff = ff + df
-    END DO
-    sigma = sqrt(sigma)
-
-    IF (abs(aire-1.0)>0.02) THEN
-      WRITE (lunout, *) 'WARNING:: AREA OF MIXING PDF IS::', aire
-      abort_message = ''
-      CALL abort_physic(modname, abort_message, 1)
-    ELSE
-      PRINT *, 'Area, mean & std deviation are ::', aire, mu, sigma
-    END IF
-  END IF !  (iflag_mix .gt. 0)
-
-
-END SUBROUTINE cv3_inip
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90	(revision 5158)
@@ -1127,4 +1127,5 @@
   USE lmdz_cvthermo
   USE lmdz_cv3param
+  USE lmdz_yomcst2
 
   IMPLICIT NONE
@@ -1147,6 +1148,4 @@
   !   - no inb1, ONLY inb in output
   ! ---------------------------------------------------------------------
-
-  include "YOMCST2.h"
 
   !inputs:
@@ -1312,5 +1311,5 @@
       DO j = 1, 4
         DO i = 1, ncum
-          ! ori	    IF(k.ge.(icb(i)+1))THEN
+          ! ori        IF(k.ge.(icb(i)+1))THEN
           IF (k>=(icbs(i) + 1)) THEN                                ! convect3
             tg = tp(i, k)
@@ -1420,5 +1419,5 @@
       DO j = 1, 4
         DO i = 1, ncum
-          ! ori	    IF(k.ge.(icb(i)+1))THEN
+          ! ori        IF(k.ge.(icb(i)+1))THEN
           IF (k>=(icbs(i) + 1)) THEN                                ! convect3
             tg = tp(i, k)
@@ -1534,52 +1533,52 @@
     DO k = minorig + 1, nl
       DO i = 1, ncum
-        ! ori	    IF(k.ge.(icb(i)+1))THEN
+        ! ori        IF(k.ge.(icb(i)+1))THEN
         IF (k>=(icbs(i) + 1)) THEN                                ! convect3
           tg = t(i, k)
           qg = qs(i, k)
-          ! debug	      alv=lv0-clmcpv*(t(i,k)-t0)
+          ! debug          alv=lv0-clmcpv*(t(i,k)-t0)
           alv = lv0 - clmcpv * (t(i, k) - 273.15)
 
           ! First iteration.
 
-          ! ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+          ! ori           s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
           s = cpd * (1. - qnk(i)) + cl * qnk(i) + &                   ! convect3
                   alv * alv * qg / (rrv * t(i, k) * t(i, k))                    ! convect3
           s = 1. / s
-          ! ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+          ! ori           ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
           ahg = cpd * tg + (cl - cpd) * qnk(i) * tg + alv * qg + gz(i, k) ! convect3
           tg = tg + s * (ah0(i) - ahg)
-          ! ori	       tg=max(tg,35.0)
-          ! debug	       tc=tg-t0
+          ! ori           tg=max(tg,35.0)
+          ! debug           tc=tg-t0
           tc = tg - 273.15
           denom = 243.5 + tc
           denom = max(denom, 1.0)                               ! convect3
-          ! ori	       IF(tc.ge.0.0)THEN
+          ! ori           IF(tc.ge.0.0)THEN
           es = 6.112 * exp(17.67 * tc / denom)
-          ! ori	       else
-          ! ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          ! ori	       endif
+          ! ori           else
+          ! ori            es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori           endif
           qg = eps * es / (p(i, k) - es * (1. - eps))
 
           ! Second iteration.
 
-          ! ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-          ! ori	       s=1./s
-          ! ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+          ! ori           s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+          ! ori           s=1./s
+          ! ori           ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
           ahg = cpd * tg + (cl - cpd) * qnk(i) * tg + alv * qg + gz(i, k) ! convect3
           tg = tg + s * (ah0(i) - ahg)
-          ! ori	       tg=max(tg,35.0)
-          ! debug	       tc=tg-t0
+          ! ori           tg=max(tg,35.0)
+          ! debug           tc=tg-t0
           tc = tg - 273.15
           denom = 243.5 + tc
           denom = max(denom, 1.0)                               ! convect3
-          ! ori	       IF(tc.ge.0.0)THEN
+          ! ori           IF(tc.ge.0.0)THEN
           es = 6.112 * exp(17.67 * tc / denom)
-          ! ori	       else
-          ! ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          ! ori	       endif
+          ! ori           else
+          ! ori            es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori           endif
           qg = eps * es / (p(i, k) - es * (1. - eps))
 
-          ! debug	       alv=lv0-clmcpv*(t(i,k)-t0)
+          ! debug           alv=lv0-clmcpv*(t(i,k)-t0)
           alv = lv0 - clmcpv * (t(i, k) - 273.15)
           ! PRINT*,'cpd dans convect2 ',cpd
@@ -4382,5 +4381,5 @@
   !AC!       do il=1,ncum
   !AC!        IF (iflag(il) .le. 1) THEN
-  !AC!	IF (cvflag_grav) THEN
+  !AC!    IF (cvflag_grav) THEN
   !AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
   !AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
@@ -4390,5 +4389,5 @@
   !AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
   !AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
-  !AC!	else
+  !AC!    else
   !AC!        ex=0.1*ment(il,inb(il),inb(il))
   !AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
@@ -5131,6 +5130,6 @@
 
     !        WRITE(*,*) 'cv3_routines check 4303'
-    do i = 1, ncum
-      do k = 1, nd
+    DO i = 1, ncum
+      DO k = 1, nd
         sig_loc(i, k) = sig(i, k)
         w0_loc(i, k) = w0(i, k)
@@ -5148,10 +5147,10 @@
     !        WRITE(*,*) 'cv3_routines check 4316'
     !        WRITE(*,*) 'ep(1,:)=',ep(1,:)
-    do i = 1, ncum
+    DO i = 1, ncum
       epmax_diag(i) = epmax - coef_epmax_cape * sqrt(cape(i))
       epmax_diag(i) = amax1(epmax_diag(i), 0.0)
       !           WRITE(*,*) 'i,icb,inb,cape,epmax_diag=', &
       !                i,icb(i),inb(i),cape(i),epmax_diag(i)
-      do k = 1, nl
+      DO k = 1, nl
         ep(i, k) = ep(i, k) / epmax * epmax_diag(i)
         ep(i, k) = amax1(ep(i, k), 0.0)
@@ -5165,9 +5164,9 @@
     !      do k=1,nl
     !        do i=1,ncum
-    !	  hp_bak(i,k)=hp(i,k)
-    !	enddo
+    !      hp_bak(i,k)=hp(i,k)
+    !    enddo
     !      enddo
-    do k = 1, nl
-      do i = 1, ncum
+    DO k = 1, nl
+      DO i = 1, ncum
         hp(i, k) = h(i, k)
       enddo
@@ -5176,6 +5175,6 @@
     IF (cvflag_ice) THEN
 
-      do k = minorig + 1, nl
-        do i = 1, ncum
+      DO k = minorig + 1, nl
+        DO i = 1, ncum
           IF((k>=icb(i)).AND.(k<=inb(i)))THEN
             hp(i, k) = hnk(i) + (lv(i, k) + (cpd - cpv) * t(i, k) + frac(i, k) * lf(i, k)) * &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p1_closure.F90	(revision 5158)
@@ -25,8 +25,7 @@
   USE lmdz_cv3param
   USE lmdz_yomcst
+  USE lmdz_yomcst2
 
   IMPLICIT NONE
-
-  include "YOMCST2.h"
 
   ! input:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p2_closure.F90	(revision 5158)
@@ -25,8 +25,7 @@
   USE lmdz_cv3param
   USE lmdz_yomcst
+  USE lmdz_yomcst2
 
   IMPLICIT NONE
-
-  include "YOMCST2.h"
 
   ! input:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv3p_mixing.F90	(revision 5158)
@@ -19,8 +19,7 @@
   USE lmdz_cvthermo
   USE lmdz_cv3param
+  USE lmdz_yomcst2
 
   IMPLICIT NONE
-
-  include "YOMCST2.h"
 
 !inputs:
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cv_driver.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cv_driver.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cv_driver.F90	(revision 5158)
@@ -94,5 +94,5 @@
   ! - iflag_con=3: version lmd  (previously named convect3)
   ! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
-  ! + tard: 	- iflag_con=5: version lmd with ice (previously named convectg)
+  ! + tard:     - iflag_con=5: version lmd with ice (previously named convectg)
   ! S. Bony, Oct 2002:
   ! * Vectorization of convect3 (ie version lmd)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr.F90	(revision 5158)
@@ -117,5 +117,5 @@
 ! var tmp tests
   REAL                           :: conserv
-  real                           :: conservMA
+  REAL                           :: conservMA
 
 ! coefficient lessivage
@@ -147,6 +147,6 @@
 ! ======================================================
 !initialisation
-  do j=1,klev
-   do i=1,klon
+  DO j=1,klev
+   DO i=1,klon
      imp(i,j)=0.
    enddo
@@ -159,6 +159,6 @@
 ! Par la suite, I est tout le temps multiplié par sig_d pour avoir l'impaction sur la surface de la maille
 ! on le néglige ici pour simplifier le code
-  do j=1,klev-1
-   do i=1,klon
+  DO j=1,klev-1
+   DO i=1,klon
     imp(i,j) = coefcoli*0.75e-3/rdrop *&
              0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_scav.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_scav.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_scav.F90	(revision 5158)
@@ -121,5 +121,5 @@
   ! var tmp tests
   REAL                           :: conserv
-  real                           :: conservMA
+  REAL                           :: conservMA
 
 !jyg<
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_spl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_spl.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/cvltr_spl.F90	(revision 5158)
@@ -122,5 +122,5 @@
 ! var tmp tests
   REAL                           :: conserv
-  real                           :: conservMA
+  REAL                           :: conservMA
 ! JE SPLA adaptation
 
@@ -190,6 +190,6 @@
 ! ======================================================
 !initialisation
-  do j=1,klev
-   do i=1,klon
+  DO j=1,klev
+   DO i=1,klon
      imp(i,j)=0.
    enddo
@@ -381,6 +381,6 @@
 ! Par la suite, I est tout le temps multiplié par sig_d pour avoir l'impaction sur la surface de la maille
 ! on le néglige ici pour simplifier le code
-  do j=1,klev-1
-   do i=1,klon
+  DO j=1,klev-1
+   DO i=1,klon
 !JE    imp(i,j) = coefcoli*0.75e-3/rdrop *&
 !JE             0.5*(pmflxr(i,j+1)+pmflxs(i,j+1)+pmflxr(i,j)+pmflxs(i,j))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h	(revision 5158)
@@ -13,8 +13,8 @@
         REAL dt_toga
         parameter (dt_toga=6.*3600.)
-!!
+
         INTEGER year_print, month_print, day_print
         real    sec_print
-!!
+
         REAL ts_toga(nt_toga)
         REAL plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
@@ -33,11 +33,8 @@
         REAL w_mod(llm), t_mod(llm),q_mod(llm)
         REAL u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
-	    real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)       
+        real temp_nudg_mod(llm),qv_nudg_mod(llm),u_nudg_mod(llm),v_nudg_mod(llm)
         REAL hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
         REAL th_mod(llm)
 
-! EV comment these lines
-!        real ts_cur
-!        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas RICO
@@ -188,7 +185,4 @@
         real  dtime_frcg
         LOGICAL :: Turb_fcg_gcssold
-
-        common /turb_forcing/                                                   &
-        dtime_frcg,hthturb_gcssold, hqturb_gcssold,Turb_fcg_gcssold
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Declarations specifiques au cas Arm_cu
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_interp_cases.h	(revision 5158)
@@ -88,5 +88,5 @@
       else
          DO l=2,llm-1
-	    IF (omega(l)>0.) THEN
+        IF (omega(l)>0.) THEN
              d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
              d_th_z(l)=(teta(l+1)-teta(l))/(play(l+1)-play(l))
@@ -94,5 +94,5 @@
              d_u_z(l)=(u(l+1)-u(l))/(play(l+1)-play(l))
              d_v_z(l)=(v(l+1)-v(l))/(play(l+1)-play(l))
-	    ELSE
+        ELSE
              d_t_z(l)=(temp(l-1)-temp(l))/(play(l-1)-play(l))
              d_th_z(l)=(teta(l-1)-teta(l))/(play(l-1)-play(l))
@@ -100,6 +100,6 @@
              d_u_z(l)=(u(l-1)-u(l))/(play(l-1)-play(l))
              d_v_z(l)=(v(l-1)-v(l))/(play(l-1)-play(l))
-	    ENDIF
-	 ENDDO
+        ENDIF
+     ENDDO
       endif
       d_t_z(1)=d_t_z(2)
@@ -116,8 +116,8 @@
 
 ! TRAVAIL : PRENDRE DES NOTATIONS COHERENTES POUR W
-      do l = 1, llm
+      DO l = 1, llm
 ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
-	PRINT*, l, llm
-	PRINT*, play(l), temp(l)
+    PRINT*, l, llm
+    PRINT*, play(l), temp(l)
        omega(l) = -w_mod_cas(l)*play(l)*rg/(rd*temp(l))
       enddo
@@ -133,5 +133,5 @@
 !geostrophic wind 
       IF (forc_geo.EQ.1) THEN
-        do l=1,llm
+        DO l=1,llm
         ug(l) = ug_mod_cas(l) 
         vg(l) = vg_mod_cas(l) 
@@ -139,5 +139,5 @@
       endif
 
-      do l = 1, llm
+      DO l = 1, llm
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_read_forc_cases.h	(revision 5158)
@@ -16,5 +16,5 @@
          CALL read_SCM_cas
          WRITE(*,*) 'Forcing read'
-	 PRINT*,'PS ps_cas',ps_cas
+     PRINT*,'PS ps_cas',ps_cas
 
 !Time interpolation for initial conditions using interpolation routine
@@ -44,5 +44,5 @@
              ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas)
 
-      do l = 1, nlev_cas
+      DO l = 1, nlev_cas
       print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
       enddo
@@ -92,5 +92,5 @@
 
 
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod_cas(l)
        q(l,1) = qv_mod_cas(l)
@@ -119,5 +119,5 @@
 ! Etienne pour initialisation de TKE
 
-       do l=1,llm+1
+       DO l=1,llm+1
        pbl_tke(:,l,:)=tke_mod_cas(l)
        enddo     
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/compar1d.h	(revision 5157)
+++ 	(revision )
@@ -1,71 +1,0 @@
-
-! $Id: compar1d.h 2010-08-04 17:02:56Z lahellec $
-
-      INTEGER :: forcing_type
-      INTEGER :: tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo
-      REAL :: nudge_u,nudge_v,nudge_w,nudge_t,nudge_q
-      INTEGER :: iflag_nudge
-      REAL :: nat_surf
-      REAL :: tsurf
-      REAL :: beta_surf
-      REAL :: rugos
-      REAL :: rugosh
-      REAL :: xqsol(1:2)
-      REAL :: qsurf
-      REAL :: psurf
-      REAL :: zsurf
-      REAL :: albedo
-      REAL :: snowmass
-
-      REAL :: time
-      REAL :: time_ini
-      REAL :: xlat
-      REAL :: xlon
-      REAL :: airefi
-      REAL :: wtsurf
-      REAL :: wqsurf
-      REAL :: restart_runoff
-      REAL :: xagesno
-      REAL :: qsolinp
-      REAL :: zpicinp
-
-      LOGICAL :: restart
-      LOGICAL :: ok_old_disvert
-
-! Pour les forcages communs: ces entiers valent 0 ou 1
-! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
-! idem pour l advection en theta
-! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
-! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
-! forcages en omega, w, vent geostrophique ou ustar
-! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
-
-      INTEGER :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
-      INTEGER :: forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar
-      real    :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_qv
-      real    :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
-      common/com_par1d/                                                 &
-       nat_surf,tsurf,beta_surf,rugos,rugosh,                           &
-       xqsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,   &
-       wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
-       forcing_type,tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo,       &
-       nudge_u,nudge_v,nudge_w,nudge_t,nudge_q,                         &
-       iflag_nudge,snowmass,                                            &
-       restart,ok_old_disvert,                                          &
-       tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh,   &
-       trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar,  &
-       nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w,          &
-       p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w
-
-!$OMP THREADPRIVATE(/com_par1d/)
-
-
-
-
-
-
-
-
-
-
-
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/date_cas.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/date_cas.h	(revision 5157)
+++ 	(revision )
@@ -1,9 +1,0 @@
-      INTEGER :: year_ini_cas    ! initial year of the case
-      INTEGER :: mth_ini_cas     ! initial month of the case
-      INTEGER :: day_deb         ! initial day of the case
-      REAL :: heure_ini_cas      ! start time of the case
-      REAL :: pdt_cas            ! forcing_frequency
-      REAL :: day_ju_ini_cas     ! julian day of initial day of the case
-
-      common /date_cas/year_ini_cas,mth_ini_cas,day_deb,heure_ini_cas,pdt_cas,day_ju_ini_cas
-
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h	(revision 5157)
+++ 	(revision )
@@ -1,45 +1,0 @@
-
-! $Id: fcg_racmo.h 2011-02-16 17:02:56Z cheruy $
-
-      real   :: a_guide 
-      LOGICAL :: ok_invertp
-      INTEGER :: forc_trb
-      CHARACTER*31 :: fich_racmo
-
-      common /fcg_racmo/forc_trb,ok_invertp,a_guide,fich_racmo
-
-!$OMP THREADPRIVATE(/fcg_racmo/)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90	(revision 5158)
@@ -4,4 +4,5 @@
           disvert0, advect_vert, advect_va, lstendh, nudge_rht_init, nudge_uv_init, &
           nudge_rht, nudge_uv, interp2_case_vertical
+
 CONTAINS
   REAL FUNCTION fq_sat(kelvin, millibar)
@@ -67,18 +68,9 @@
     USE lmdz_fcs_gcssold, ONLY: imp_fcg_gcssold, ts_fcg_gcssold, Tp_fcg_gcssold, Tp_ini_gcssold, xTurb_fcg_gcssold
     USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
+    USE lmdz_compar1d
+
+    IMPLICIT NONE
     !-----------------------------------------------------------------------
     !     Auteurs :   A. Lahellec  .
-
-    !   Declarations :
-    !   --------------
-
-    include "compar1d.h"
-    include "fcg_racmo.h"
-
-
-    !   local:
-    !   ------
-
-    !      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
 
     !  -------------------------------------------------------------------
@@ -1148,5 +1140,5 @@
     !---------------------------------------------------------------
 
-    do l = 1, llm
+    DO l = 1, llm
       zw(l) = dt * w(l)
       zm(l) = plev(l) - plev(l + 1)
@@ -1156,5 +1148,5 @@
     zw(llm + 1) = 0.
 
-    do l = 1, llm
+    DO l = 1, llm
       qold = q(l)
       q(l) = (q(l) * zm(l) + zwq(l + 1) - zwq(l)) / (zm(l) + zw(l + 1) - zw(l))
@@ -1186,5 +1178,5 @@
     REAL alpha, omgdown, omgup
 
-    do l = 1, llm
+    DO l = 1, llm
       IF(l==1) THEN
         !si omgup pour la couche 1, alors tendance nulle
@@ -1271,5 +1263,5 @@
     cor(:) = rkappa * temp * (1. + q(:, 1) * rv / rd) / (play * (1. + q(:, 1)))
 
-    do k = 2, llm - 1
+    DO k = 2, llm - 1
 
       dph  (k - 1) = (play(k) - play(k - 1))
@@ -1286,5 +1278,5 @@
     dtdp (llm) = dtdp (llm - 1)
 
-    do k = 2, llm - 1
+    DO k = 2, llm - 1
       omdn = max(0.0, omega(k + 1))
       omup = min(0.0, omega(k))
@@ -1325,5 +1317,5 @@
 
     IMPLICIT NONE
- INCLUDE "FCTTRE.h"
+    INCLUDE "FCTTRE.h"
 
     ! ========================================================
@@ -1399,5 +1391,5 @@
 
     IMPLICIT NONE
- INCLUDE "FCTTRE.h"
+    INCLUDE "FCTTRE.h"
 
     ! ========================================================
@@ -1593,5 +1585,5 @@
     !      enddo
 
-    do l = 1, llm
+    DO l = 1, llm
 
       IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
@@ -1602,5 +1594,5 @@
 
         IF (play(l)<=plev_prof_cas(1)) THEN
-          do k = 1, nlev_cas - 1
+          DO k = 1, nlev_cas - 1
             IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k + 1)) THEN
               k1 = k
@@ -1612,5 +1604,5 @@
             WRITE(*, *) 'PB! k1, k2 = ', k1, k2
             WRITE(*, *) 'l,play(l) = ', l, play(l) / 100
-            do k = 1, nlev_cas - 1
+            DO k = 1, nlev_cas - 1
               WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
             enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_compar1d.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_compar1d.f90	(revision 5158)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_compar1d.f90	(revision 5158)
@@ -0,0 +1,72 @@
+MODULE lmdz_compar1d
+  IMPLICIT NONE; PRIVATE
+  PUBLIC  nat_surf, tsurf, beta_surf, rugos, rugosh, &
+          xqsol, qsurf, psurf, zsurf, albedo, time, time_ini, xlat, xlon, airefi, &
+          wtsurf, wqsurf, restart_runoff, xagesno, qsolinp, zpicinp, &
+          forcing_type, tend_u, tend_v, tend_w, tend_t, tend_q, tend_rayo, &
+          nudge_u, nudge_v, nudge_w, nudge_t, nudge_q, &
+          iflag_nudge, snowmass, &
+          restart, ok_old_disvert, &
+          tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
+          trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &
+          nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w, &
+          p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w
+
+  INTEGER :: forcing_type
+  INTEGER :: tend_u, tend_v, tend_w, tend_t, tend_q, tend_rayo
+  REAL :: nudge_u, nudge_v, nudge_w, nudge_t, nudge_q
+  INTEGER :: iflag_nudge
+  REAL :: nat_surf
+  REAL :: tsurf
+  REAL :: beta_surf
+  REAL :: rugos
+  REAL :: rugosh
+  REAL :: xqsol(1:2)
+  REAL :: qsurf
+  REAL :: psurf
+  REAL :: zsurf
+  REAL :: albedo
+  REAL :: snowmass
+
+  REAL :: time
+  REAL :: time_ini
+  REAL :: xlat
+  REAL :: xlon
+  REAL :: airefi
+  REAL :: wtsurf
+  REAL :: wqsurf
+  REAL :: restart_runoff
+  REAL :: xagesno
+  REAL :: qsolinp
+  REAL :: zpicinp
+
+  LOGICAL :: restart
+  LOGICAL :: ok_old_disvert
+
+  ! Pour les forcages communs: ces entiers valent 0 ou 1
+  ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
+  ! idem pour l advection en theta
+  ! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
+  ! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
+  ! forcages en omega, w, vent geostrophique ou ustar
+  ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
+
+  INTEGER :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
+  INTEGER :: forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar
+  REAL :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_qv
+  REAL :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
+
+
+  !$OMP THREADPRIVATE(nat_surf, tsurf, beta_surf, rugos, rugosh, &
+  !$OMP      xqsol, qsurf, psurf, zsurf, albedo, time, time_ini, xlat, xlon, airefi, &
+  !$OMP      wtsurf, wqsurf, restart_runoff, xagesno, qsolinp, zpicinp, &
+  !$OMP      forcing_type, tend_u, tend_v, tend_w, tend_t, tend_q, tend_rayo, &
+  !$OMP      nudge_u, nudge_v, nudge_w, nudge_t, nudge_q, &
+  !$OMP      iflag_nudge, snowmass, &
+  !$OMP      restart, ok_old_disvert, &
+  !$OMP      tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
+  !$OMP      trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &
+  !$OMP      nudging_u, nudging_v, nudging_t, nudging_qv, nudging_w, &
+  !$OMP      p_nudging_u, p_nudging_v, p_nudging_t, p_nudging_qv, p_nudging_w)
+
+END MODULE lmdz_compar1d
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_date_cas.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_date_cas.f90	(revision 5158)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_date_cas.f90	(revision 5158)
@@ -0,0 +1,12 @@
+MODULE lmdz_date_cas
+  IMPLICIT NONE; PRIVATE
+  PUBLIC year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
+  INTEGER :: year_ini_cas    ! initial year of the case
+  INTEGER :: mth_ini_cas     ! initial month of the case
+  INTEGER :: day_deb         ! initial day of the case
+  REAL :: heure_ini_cas      ! start time of the case
+  REAL :: pdt_cas            ! forcing_frequency
+  REAL :: day_ju_ini_cas     ! julian day of initial day of the case
+END MODULE lmdz_date_cas
+
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90	(revision 5158)
@@ -2,4 +2,16 @@
   PRIVATE  ! -- We'd love to put IMPLICIT NONE;  here...
   PUBLIC get_uvd, copie, get_uvd2, rdgrads, spaces
+
+  REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+  INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
+  REAL coef1(100) !coefficient d interpolation
+  REAL coef2(100) !coefficient d interpolation
+  INTEGER klev
+
+  INTEGER nblvlm !nombre de niveau de pression du mesoNH
+  REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
+  REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
+
+
 CONTAINS
 
@@ -16,21 +28,6 @@
     ! pouvoir calculer la convergence et le cisaillement dans la physiq
     !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-    INTEGER klev
-    REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-    INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
-    REAL coef1(100) !coefficient d interpolation
-    REAL coef2(100) !coefficient d interpolation
-
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
-    REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
-
     INTEGER i, j, k, ll, in
-
     CHARACTER*80 file_forctl, file_fordat
-
-    COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
 
     !======================================================================
@@ -162,5 +159,5 @@
     !*** precedent en format gcm                                     ***
     IF(pas>pasprev)THEN
-      do i = 1, klev
+      DO i = 1, klev
         htbef(i) = htaft(i)
         hqbef(i) = hqaft(i)
@@ -192,10 +189,10 @@
       IF(Tp_fcg) THEN
         !     (le forcage est donne en temperature potentielle)
-        do i = 1, nblvlm
+        DO i = 1, nblvlm
           ht_mes(i) = ht_mes(i) * (hplaym(i) / 1000.)**rkappa
         enddo
       endif ! Tp_fcg
       IF(Turb_fcg) THEN
-        do i = 1, nblvlm
+        DO i = 1, nblvlm
           hThTurb_mes(i) = hThTurb_mes(i) * (hplaym(i) / 1000.)**rkappa
         enddo
@@ -216,5 +213,5 @@
       !*** on interpole les champs meso_NH sur les niveaux de pression***
       !*** gcm . on obtient le nouveau champ after                    ***
-      do k = 1, klev
+      DO k = 1, klev
         IF (JM(k) == 0) THEN
           htaft(k) = ht_mes(jm(k) + 1)
@@ -254,5 +251,5 @@
     !*** on conserve les derniers champs calcules                    ***
     IF(temps>=pasmax)THEN
-      do ll = 1, klev
+      DO ll = 1, klev
         ht(ll) = htaft(ll)
         hq(ll) = hqaft(ll)
@@ -267,5 +264,5 @@
       !*** on interpole sur les pas de temps de 10mn du gcm a partir   ***
       !** des pas de temps de 1h du meso_NH                            ***
-      do j = 1, klev
+      DO j = 1, klev
         ht(j) = ((timeaft - time) * htbef(j) + (time - timebef) * htaft(j)) / dt
         hq(j) = ((timeaft - time) * hqbef(j) + (time - timebef) * hqaft(j)) / dt
@@ -287,10 +284,10 @@
     print *, ' time,timebef,timeaft', time, timebef, timeaft
     print *, ' ht,htbef,htaft,hthturb,hthturbbef,hthturbaft'
-    do j = 1, klev
+    DO j = 1, klev
       print *, j, ht(j), htbef(j), htaft(j), &
               &             hthturb(j), hthturbbef(j), hthturbaft(j)
     enddo
     print *, ' hq,hqbef,hqaft,hqturb,hqturbbef,hqturbaft'
-    do j = 1, klev
+    DO j = 1, klev
       print *, j, hq(j), hqbef(j), hqaft(j), &
               &             hqturb(j), hqturbbef(j), hqturbaft(j)
@@ -317,5 +314,5 @@
 
     !------------------
-    do i = 1, 1000
+    DO i = 1, 1000
       read(97, 1000, end = 999) string
       1000 format (a4)
@@ -373,5 +370,5 @@
     !------------------------------------------------------------------------
     IF(Tp_fcg) THEN
-      do i = 1, nblvlm
+      DO i = 1, nblvlm
         ht_mes(i) = ht_mes(i) * (hplaym(i) / 1000.)**rkappa
       enddo
@@ -393,5 +390,5 @@
     ! on interpole sur les niveaux du gcm(niveau pression bien sur!)
     !-----------------------------------------------------------------------
-    do k = 1, klev
+    DO k = 1, klev
       IF (JM(k) == 0) THEN
         !FKC bug? ne faut il pas convertir tsol en tendance ????
@@ -426,5 +423,5 @@
     tsaft = ts_subr
     ! valeurs initiales des champs de convergence
-    do k = 1, klev
+    DO k = 1, klev
       ht(k) = htaft(k)
       hq(k) = hqaft(k)
@@ -473,5 +470,5 @@
     data alx, aly /100000., 150000./
 
-    do k = 1, klev
+    DO k = 1, klev
       du = abs(vu_f(k) - cx) / alx
       dv = abs(vv_f(k) - cy) / aly
@@ -489,21 +486,4 @@
     IMPLICIT NONE
 
-    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-    ! cette routine remplit les COMMON com1_phys_gcss et com2_phys_gcss.h
-    !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-    INTEGER klev !nombre de niveau de pression du GCM
-    REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-    INTEGER JM(100)
-    REAL coef1(100)   !coefficient d interpolation
-    REAL coef2(100)   !coefficient d interpolation
-
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100) !pression en Pa au milieu de chaque couche Meso-NH
-    REAL hplaym(100)!pression en hecto-Pa des milieux de couche Meso-NH
-
-    COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
-
     INTEGER k, klevgcm
     REAL playgcm(klevgcm) ! pression en milieu de couche du gcm
@@ -518,5 +498,5 @@
     !---------------------------------------------------------------------
 
-    do k = 1, klev
+    DO k = 1, klev
       play(k) = playgcm(k)
       PRINT*, 'la pression gcm est:', play(k)
@@ -526,5 +506,4 @@
     ! lecture du descripteur des donnees Meso-NH (forcing.ctl):
     !  -> nb niveaux du meso.NH (nblvlm) + pressions meso.NH
-    ! (on remplit le COMMON com2_phys_gcss)
     !----------------------------------------------------------------------
 
@@ -536,5 +515,4 @@
     ! etude de la correspondance entre les niveaux meso.NH et GCM;
     ! calcul des coefficients d interpolation coef1 et coef2
-    ! (on remplit le COMMON com1_phys_gcss)
     !----------------------------------------------------------------------
 
@@ -549,9 +527,9 @@
     WRITE(*, *) '--------------------------------------'
     WRITE(*, *) 'GCM: nb niveaux:', klev, ' et pression, coeffs:'
-    do k = 1, klev
+    DO k = 1, klev
       WRITE(*, *) play(k), coef1(k), coef2(k)
     enddo
     WRITE(*, *) 'MESO-NH: nb niveaux:', nblvlm, ' et pression:'
-    do k = 1, nblvlm
+    DO k = 1, nblvlm
       WRITE(*, *) playm(k), hplaym(k)
     enddo
@@ -570,9 +548,4 @@
     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
-    REAL hplaym(100) !pression en hPa des milieux de couche Meso-NH
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
-
     INTEGER i, lu, mlz, mlzh
 
@@ -586,5 +559,5 @@
     open(lu, file = file_forctl, form = 'formatted')
 
-    do i = 1, 1000
+    DO i = 1, 1000
       read(lu, 1000, end = 999) a
       IF (a == 'ZDEF') go to 100
@@ -608,5 +581,5 @@
     !      Si la pression est en HPa, la multiplier par 100
     IF (playm(1) < 10000.) THEN
-      do mlz = 1, nblvlm
+      DO mlz = 1, nblvlm
         playm(mlz) = playm(mlz) * 100.
       enddo
@@ -617,5 +590,5 @@
 
     PRINT*, ' '
-    do mlzh = 1, nblvlm
+    DO mlzh = 1, nblvlm
       hplaym(mlzh) = playm(mlzh) / 100.
     enddo
@@ -644,15 +617,15 @@
     icomp = icount
 
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)z(k)
       print *, 'icomp,k,z(k) ', icomp, k, z(k)
     enddo
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)hT(k)
       PRINT*, hT(k), k
     enddo
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)hQ(k)
@@ -660,9 +633,9 @@
 
     IF(turb_fcg) THEN
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hThTur(k)
       enddo
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hqTur(k)
@@ -672,9 +645,9 @@
 
     IF(imp_fcg) THEN
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hu(k)
       enddo
-      do k = 1, nl
+      DO k = 1, nl
         icomp = icomp + 1
         read(itape, rec = icomp)hv(k)
@@ -683,5 +656,5 @@
     endif
 
-    do k = 1, nl
+    DO k = 1, nl
       icomp = icomp + 1
       read(itape, rec = icomp)hw(k)
@@ -707,22 +680,9 @@
     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 
-    INTEGER klev    !nombre de niveau de pression du GCM
-    REAL play(100)  !pression en Pa au milieu de chaque couche GCM
-    INTEGER JM(100)
-    REAL coef1(100) !coefficient d interpolation
-    REAL coef2(100) !coefficient d interpolation
-
-    INTEGER nblvlm !nombre de niveau de pression du mesoNH
-    REAL playm(100) !pression en Pa milieu de chaque couche Meso-NH
-    REAL hplaym(100)!pression en hPa des milieux de couche Meso-NH
-
-    COMMON/com1_phys_gcss/play, coef1, coef2, JM, klev
-    COMMON/com2_phys_gcss/playm, hplaym, nblvlm
-
     REAL psol
     REAL val
     INTEGER k, mlz
 
-    do k = 1, klev
+    DO k = 1, klev
       val = play(k)
       IF (val > playm(1)) THEN
@@ -732,5 +692,5 @@
         coef2(1) = (val - psol) / (playm(mlz + 1) - psol)
       ELSE IF (val > playm(nblvlm)) THEN
-        do mlz = 1, nblvlm
+        DO mlz = 1, nblvlm
           IF (val <= playm(mlz).AND. val > playm(mlz + 1))THEN
             JM(k) = mlz
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90	(revision 5158)
@@ -57,9 +57,11 @@
     USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
     USE lmdz_yomcst
+    USE lmdz_compar1d
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
+    IMPLICIT NONE
 
     INCLUDE "dimensions.h"
     INCLUDE "dimsoil.h"
-    INCLUDE "compar1d.h"
-    INCLUDE "date_cas.h"
 
     !=====================================================================
@@ -454,5 +456,5 @@
     ! Initialization of the LOGICAL switch for nudging
     jcode = iflag_nudge
-    do i = 1, nudge_max
+    DO i = 1, nudge_max
       nudge(i) = mod(jcode, 10) >= 1
       jcode = jcode / 10
@@ -696,5 +698,5 @@
       ! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
       WRITE(*, *) '***********************'
-      do l = 1, llm
+      DO l = 1, llm
         WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
         IF (trouve_700 .AND. play(l)<=70000) THEN
@@ -1004,5 +1006,5 @@
                 PRINT*, temp(1), q(1, 1), u(1), v(1), plev(1), phis
         ! raz for safety
-        do l = 1, llm
+        DO l = 1, llm
                 dq_dyn(l, 1) = 0.
         enddo
@@ -1049,5 +1051,5 @@
 
         phi(1) = RD * temp(1) * (plev(1) - play(1)) / (.5 * (plev(1) + play(1)))
-                do l = 1, llm - 1
+                DO l = 1, llm - 1
                 phi(l + 1) = phi(l) + RD * (temp(l) + temp(l + 1)) * &
         (play(l) - play(l + 1)) / (play(l) + play(l + 1))
@@ -1151,5 +1153,5 @@
 
         !on calcule dt_cooling
-        do l = 1, llm
+        DO l = 1, llm
         IF (play(l)>=20000.) THEN
         dt_cooling(l) = -1.5 / 86400.
@@ -1219,5 +1221,5 @@
         d_t_adv = 0.
         d_q_adv = 0.
-        do l = 2, llm - 1
+        DO l = 2, llm - 1
         IF (zlay(l)<=1100) THEN
         wwww = -0.00001 * zlay(l)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90	(revision 5158)
@@ -50,9 +50,9 @@
     USE lmdz_tsoilnudge, ONLY: nudge_tsoil, isoil_nudge, Tsoil_nudge, tau_soil_nudge
     USE lmdz_yomcst
+    USE lmdz_compar1d
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
 
     INCLUDE "dimensions.h"
     INCLUDE "dimsoil.h"
-    INCLUDE "compar1d.h"
-    INCLUDE "date_cas.h"
 
     !=====================================================================
@@ -280,5 +280,5 @@
 
     jcode = iflag_nudge
-    do i = 1, nudge_max
+    DO i = 1, nudge_max
       nudge(i) = mod(jcode, 10) >= 1
       jcode = jcode / 10
@@ -459,5 +459,5 @@
       ! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
       WRITE(*, *) '***********************'
-      do l = 1, llm
+      DO l = 1, llm
         WRITE(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
         IF (trouve_700 .AND. play(l)<=70000) THEN
@@ -717,5 +717,5 @@
         !        phy_fter,phy_foce,phy_flic,phy_fsic)
                 !------------------------------------------------------------------------
-                do i = 1, year_len
+                DO i = 1, year_len
                 phy_nat(i)  = nat_surf
                 phy_alb(i)  = albedo
@@ -759,5 +759,5 @@
                 PRINT*, temp(1), q(1, 1), u(1), v(1), plev(1), phis(1)
                 ! raz for safety
-                do l = 1, llm
+                DO l = 1, llm
                 d_q_vert_adv(l, 1) = 0.
                 enddo
@@ -780,5 +780,5 @@
 
         it_end = nint(fnday*day_step)
-                do while(it<=it_end)
+                DO while(it<=it_end)
 
                 IF (prt_level>=1) THEN
@@ -804,5 +804,5 @@
         phi(1)= RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
 
-                do l = 1, llm-1
+                DO l = 1, llm-1
                 phi(l+1)= phi(l)+RD*(temp(l)+temp(l+1))*                           &
         (play(l)-play(l+1))/(play(l)+play(l+1))
@@ -824,5 +824,5 @@
 
         teta = temp*(pzero/play)**rkappa
-        do l = 2, llm-1
+        DO l = 2, llm-1
         ! vertical tendencies computed as d X / d t = -W  d X / d z
         d_u_vert_adv(l)= -w_adv(l)*(u(l+1)-u(l-1))/(z_adv(l+1)-z_adv(l-1))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90	(revision 5158)
@@ -1,457 +1,453 @@
 MODULE mod_1D_amma_read
-        USE netcdf, ONLY: nf90_get_var,nf90_open,nf90_noerr,nf90_open,nf90_nowrite,&
-                nf90_inq_dimid,nf90_inquire_dimension,nf90_strerror,nf90_inq_varid
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!Declarations specifiques au cas AMMA
-        CHARACTER*80 :: fich_amma
-! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
-        INTEGER nlev_amma, nt_amma
-
-        INTEGER year_ini_amma, day_ini_amma, mth_ini_amma
-        REAL heure_ini_amma
-        REAL day_ju_ini_amma   ! Julian day of amma first day
-        parameter (year_ini_amma=2006)
-        parameter (mth_ini_amma=7)
-        parameter (day_ini_amma=10)  ! 10 = 10Juil2006
-        parameter (heure_ini_amma=0.) !0h en secondes
-        REAL dt_amma
-        parameter (dt_amma=1800.)
-
-!profils initiaux:
-        REAL, ALLOCATABLE::  plev_amma(:)
-
-        REAL, ALLOCATABLE::  z_amma(:)
-        REAL, ALLOCATABLE::  th_amma(:),q_amma(:)
-        REAL, ALLOCATABLE::  u_amma(:)
-        REAL, ALLOCATABLE::  v_amma(:)
-
-        REAL, ALLOCATABLE::  th_ammai(:),q_ammai(:)
-        REAL, ALLOCATABLE::  u_ammai(:)
-        REAL, ALLOCATABLE::  v_ammai(:)
-        REAL, ALLOCATABLE::  vitw_ammai(:)
-        REAL, ALLOCATABLE::  ht_ammai(:)
-        REAL, ALLOCATABLE::  hq_ammai(:)
-        REAL, ALLOCATABLE::  vt_ammai(:)
-        REAL, ALLOCATABLE::  vq_ammai(:)
-
-!forcings
-        REAL, ALLOCATABLE::  ht_amma(:,:)
-        REAL, ALLOCATABLE::  hq_amma(:,:)
-        REAL, ALLOCATABLE::  vitw_amma(:,:)
-        REAL, ALLOCATABLE::  lat_amma(:),sens_amma(:)
-
-!champs interpoles
-        REAL, ALLOCATABLE::  vitw_profamma(:)
-        REAL, ALLOCATABLE::  ht_profamma(:)
-        REAL, ALLOCATABLE::  hq_profamma(:)
-        REAL lat_profamma,sens_profamma
-        REAL, ALLOCATABLE::  vt_profamma(:)
-        REAL, ALLOCATABLE::  vq_profamma(:)
-        REAL, ALLOCATABLE::  th_profamma(:)
-        REAL, ALLOCATABLE::  q_profamma(:)
-        REAL, ALLOCATABLE::  u_profamma(:)
-        REAL, ALLOCATABLE::  v_profamma(:)
+  USE netcdf, ONLY: nf90_get_var, nf90_open, nf90_noerr, nf90_open, nf90_nowrite, &
+          nf90_inq_dimid, nf90_inquire_dimension, nf90_strerror, nf90_inq_varid
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !Declarations specifiques au cas AMMA
+  CHARACTER*80 :: fich_amma
+  ! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
+  INTEGER nlev_amma, nt_amma
+
+  INTEGER year_ini_amma, day_ini_amma, mth_ini_amma
+  REAL heure_ini_amma
+  REAL day_ju_ini_amma   ! Julian day of amma first day
+  parameter (year_ini_amma = 2006)
+  parameter (mth_ini_amma = 7)
+  parameter (day_ini_amma = 10)  ! 10 = 10Juil2006
+  parameter (heure_ini_amma = 0.) !0h en secondes
+  REAL dt_amma
+  parameter (dt_amma = 1800.)
+
+  !profils initiaux:
+  REAL, ALLOCATABLE :: plev_amma(:)
+
+  REAL, ALLOCATABLE :: z_amma(:)
+  REAL, ALLOCATABLE :: th_amma(:), q_amma(:)
+  REAL, ALLOCATABLE :: u_amma(:)
+  REAL, ALLOCATABLE :: v_amma(:)
+
+  REAL, ALLOCATABLE :: th_ammai(:), q_ammai(:)
+  REAL, ALLOCATABLE :: u_ammai(:)
+  REAL, ALLOCATABLE :: v_ammai(:)
+  REAL, ALLOCATABLE :: vitw_ammai(:)
+  REAL, ALLOCATABLE :: ht_ammai(:)
+  REAL, ALLOCATABLE :: hq_ammai(:)
+  REAL, ALLOCATABLE :: vt_ammai(:)
+  REAL, ALLOCATABLE :: vq_ammai(:)
+
+  !forcings
+  REAL, ALLOCATABLE :: ht_amma(:, :)
+  REAL, ALLOCATABLE :: hq_amma(:, :)
+  REAL, ALLOCATABLE :: vitw_amma(:, :)
+  REAL, ALLOCATABLE :: lat_amma(:), sens_amma(:)
+
+  !champs interpoles
+  REAL, ALLOCATABLE :: vitw_profamma(:)
+  REAL, ALLOCATABLE :: ht_profamma(:)
+  REAL, ALLOCATABLE :: hq_profamma(:)
+  REAL lat_profamma, sens_profamma
+  REAL, ALLOCATABLE :: vt_profamma(:)
+  REAL, ALLOCATABLE :: vq_profamma(:)
+  REAL, ALLOCATABLE :: th_profamma(:)
+  REAL, ALLOCATABLE :: q_profamma(:)
+  REAL, ALLOCATABLE :: u_profamma(:)
+  REAL, ALLOCATABLE :: v_profamma(:)
 
 
 CONTAINS
 
-SUBROUTINE read_1D_cases
-      IMPLICIT NONE
-
-      INTEGER nid,rid,ierr
-
-      fich_amma='amma.nc'
-      PRINT*,'fich_amma ',fich_amma
-      ierr = nf90_open(fich_amma,nf90_nowrite,nid)
-      PRINT*,'fich_amma,nf90_nowrite,nid ',fich_amma,nf90_nowrite,nid
-      IF (ierr/=nf90_noerr) THEN
-         WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
-         WRITE(*,*) nf90_strerror(ierr)
-         stop ""
+  SUBROUTINE read_1D_cases
+    IMPLICIT NONE
+
+    INTEGER nid, rid, ierr
+
+    fich_amma = 'amma.nc'
+    PRINT*, 'fich_amma ', fich_amma
+    ierr = nf90_open(fich_amma, nf90_nowrite, nid)
+    PRINT*, 'fich_amma,nf90_nowrite,nid ', fich_amma, nf90_nowrite, nid
+    IF (ierr/=nf90_noerr) THEN
+      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
+      WRITE(*, *) nf90_strerror(ierr)
+      stop ""
+    endif
+    !.......................................................................
+    ierr = nf90_inq_dimid(nid, 'lev', rid)
+    IF (ierr/=nf90_noerr) THEN
+      PRINT*, 'Oh probleme lecture dimension zz'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nlev_amma)
+    PRINT*, 'OK nid,rid,nlev_amma', nid, rid, nlev_amma
+    !.......................................................................
+    ierr = nf90_inq_dimid(nid, 'time', rid)
+    PRINT*, 'nid,rid', nid, rid
+    nt_amma = 0
+    IF (ierr/=nf90_noerr) THEN
+      stop 'probleme lecture dimension sens'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nt_amma)
+    PRINT*, 'nid,rid,nlev_amma', nid, rid, nt_amma
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !profils initiaux:
+    allocate(plev_amma(nlev_amma))
+
+    allocate(z_amma(nlev_amma))
+    allocate(th_amma(nlev_amma), q_amma(nlev_amma))
+    allocate(u_amma(nlev_amma))
+    allocate(v_amma(nlev_amma))
+
+    !forcings
+    allocate(ht_amma(nlev_amma, nt_amma))
+    allocate(hq_amma(nlev_amma, nt_amma))
+    allocate(vitw_amma(nlev_amma, nt_amma))
+    allocate(lat_amma(nt_amma), sens_amma(nt_amma))
+
+    !profils initiaux:
+    allocate(th_ammai(nlev_amma), q_ammai(nlev_amma))
+    allocate(u_ammai(nlev_amma))
+    allocate(v_ammai(nlev_amma))
+    allocate(vitw_ammai(nlev_amma))
+    allocate(ht_ammai(nlev_amma))
+    allocate(hq_ammai(nlev_amma))
+    allocate(vt_ammai(nlev_amma))
+    allocate(vq_ammai(nlev_amma))
+
+    !champs interpoles
+    allocate(vitw_profamma(nlev_amma))
+    allocate(ht_profamma(nlev_amma))
+    allocate(hq_profamma(nlev_amma))
+    allocate(vt_profamma(nlev_amma))
+    allocate(vq_profamma(nlev_amma))
+    allocate(th_profamma(nlev_amma))
+    allocate(q_profamma(nlev_amma))
+    allocate(u_profamma(nlev_amma))
+    allocate(v_profamma(nlev_amma))
+
+    PRINT*, 'Allocations OK'
+    CALL read_amma(nid, nlev_amma, nt_amma                                  &
+            , z_amma, plev_amma, th_amma, q_amma, u_amma, v_amma, vitw_amma         &
+            , ht_amma, hq_amma, sens_amma, lat_amma)
+
+  END SUBROUTINE read_1D_cases
+
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE deallocate_1D_cases
+    !profils initiaux:
+    deallocate(plev_amma)
+
+    deallocate(z_amma)
+    deallocate(th_amma, q_amma)
+    deallocate(u_amma)
+    deallocate(v_amma)
+
+    deallocate(th_ammai, q_ammai)
+    deallocate(u_ammai)
+    deallocate(v_ammai)
+    deallocate(vitw_ammai)
+    deallocate(ht_ammai)
+    deallocate(hq_ammai)
+    deallocate(vt_ammai)
+    deallocate(vq_ammai)
+
+    !forcings
+    deallocate(ht_amma)
+    deallocate(hq_amma)
+    deallocate(vitw_amma)
+    deallocate(lat_amma, sens_amma)
+
+    !champs interpoles
+    deallocate(vitw_profamma)
+    deallocate(ht_profamma)
+    deallocate(hq_profamma)
+    deallocate(vt_profamma)
+    deallocate(vq_profamma)
+    deallocate(th_profamma)
+    deallocate(q_profamma)
+    deallocate(u_profamma)
+    deallocate(v_profamma)
+  END SUBROUTINE deallocate_1D_cases
+
+
+  !=====================================================================
+  SUBROUTINE read_amma(nid, nlevel, ntime                          &
+          , zz, pp, temp, qv, u, v, dw                   &
+          , dt, dq, sens, flat)
+
+    !program reading forcings of the AMMA case study
+    IMPLICIT NONE
+
+    INTEGER ntime, nlevel
+
+    REAL zz(nlevel)
+    REAL temp(nlevel), pp(nlevel)
+    REAL qv(nlevel), u(nlevel)
+    REAL v(nlevel)
+    REAL dw(nlevel, ntime)
+    REAL dt(nlevel, ntime)
+    REAL dq(nlevel, ntime)
+    REAL flat(ntime), sens(ntime)
+
+    INTEGER nid, ierr, rid
+    INTEGER nbvar3d
+    parameter(nbvar3d = 30)
+    INTEGER var3didin(nbvar3d)
+
+    ierr = nf90_inq_varid(nid, "zz", var3didin(1))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'lev'
+    endif
+
+    ierr = nf90_inq_varid(nid, "temp", var3didin(2))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'temp'
+    endif
+
+    ierr = nf90_inq_varid(nid, "qv", var3didin(3))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'qv'
+    endif
+
+    ierr = nf90_inq_varid(nid, "u", var3didin(4))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'u'
+    endif
+
+    ierr = nf90_inq_varid(nid, "v", var3didin(5))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'v'
+    endif
+
+    ierr = nf90_inq_varid(nid, "dw", var3didin(6))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'dw'
+    endif
+
+    ierr = nf90_inq_varid(nid, "dt", var3didin(7))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'dt'
+    endif
+
+    ierr = nf90_inq_varid(nid, "dq", var3didin(8))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'dq'
+    endif
+
+    ierr = nf90_inq_varid(nid, "sens", var3didin(9))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'sens'
+    endif
+
+    ierr = nf90_inq_varid(nid, "flat", var3didin(10))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'flat'
+    endif
+
+    ierr = nf90_inq_varid(nid, "pp", var3didin(11))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+    endif
+
+    !dimensions lecture
+    !      CALL catchaxis(nid,ntime,nlevel,time,z,ierr)
+
+    ierr = nf90_get_var(nid, var3didin(1), zz)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture z ok',zz
+
+    ierr = nf90_get_var(nid, var3didin(2), temp)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture th ok',temp
+
+    ierr = nf90_get_var(nid, var3didin(3), qv)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture qv ok',qv
+
+    ierr = nf90_get_var(nid, var3didin(4), u)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture u ok',u
+
+    ierr = nf90_get_var(nid, var3didin(5), v)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture v ok',v
+
+    ierr = nf90_get_var(nid, var3didin(6), dw)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture w ok',dw
+
+    ierr = nf90_get_var(nid, var3didin(7), dt)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dt ok',dt
+
+    ierr = nf90_get_var(nid, var3didin(8), dq)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dq ok',dq
+
+    ierr = nf90_get_var(nid, var3didin(9), sens)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture sens ok',sens
+
+    ierr = nf90_get_var(nid, var3didin(10), flat)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture flat ok',flat
+
+    ierr = nf90_get_var(nid, var3didin(11), pp)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture pp ok',pp
+
+  END SUBROUTINE  read_amma
+  !======================================================================
+  SUBROUTINE interp_amma_time(day, day1, annee_ref                     &
+          , year_ini_amma, day_ini_amma, nt_amma, dt_amma, nlev_amma       &
+          , vitw_amma, ht_amma, hq_amma, lat_amma, sens_amma               &
+          , vitw_prof, ht_prof, hq_prof, lat_prof, sens_prof)
+
+    USE lmdz_compar1d
+
+    IMPLICIT NONE
+
+    !---------------------------------------------------------------------------------------
+    ! Time interpolation of a 2D field to the timestep corresponding to day
+
+    ! day: current julian day (e.g. 717538.2)
+    ! day1: first day of the simulation
+    ! nt_amma: total nb of data in the forcing (e.g. 48 for AMMA)
+    ! dt_amma: total time interval (in sec) between 2 forcing data (e.g. 30min for AMMA)
+    !---------------------------------------------------------------------------------------
+
+    ! inputs:
+    INTEGER annee_ref
+    INTEGER nt_amma, nlev_amma
+    INTEGER year_ini_amma
+    REAL day, day1, day_ini_amma, dt_amma
+    REAL vitw_amma(nlev_amma, nt_amma)
+    REAL ht_amma(nlev_amma, nt_amma)
+    REAL hq_amma(nlev_amma, nt_amma)
+    REAL lat_amma(nt_amma)
+    REAL sens_amma(nt_amma)
+    ! outputs:
+    REAL vitw_prof(nlev_amma)
+    REAL ht_prof(nlev_amma)
+    REAL hq_prof(nlev_amma)
+    REAL lat_prof, sens_prof
+    ! local:
+    INTEGER it_amma1, it_amma2, k
+    REAL timeit, time_amma1, time_amma2, frac
+
+    IF (forcing_type==6) THEN
+      ! Check that initial day of the simulation consistent with AMMA case:
+      IF (annee_ref/=2006) THEN
+        PRINT*, 'Pour AMMA, annee_ref doit etre 2006'
+        PRINT*, 'Changer annee_ref dans run.def'
+        stop
       endif
-!.......................................................................
-      ierr=nf90_inq_dimid(nid,'lev',rid)
-      IF (ierr/=nf90_noerr) THEN
-         PRINT*, 'Oh probleme lecture dimension zz'
-      ENDIF
-      ierr=nf90_inquire_dimension(nid,rid,len=nlev_amma)
-      PRINT*,'OK nid,rid,nlev_amma',nid,rid,nlev_amma
-!.......................................................................
-      ierr=nf90_inq_dimid(nid,'time',rid)
-      PRINT*,'nid,rid',nid,rid
-      nt_amma=0
-      IF (ierr/=nf90_noerr) THEN
-        stop 'probleme lecture dimension sens'
-      ENDIF
-      ierr=nf90_inquire_dimension(nid,rid,len=nt_amma)
-      PRINT*,'nid,rid,nlev_amma',nid,rid,nt_amma
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!profils initiaux:
-        allocate(plev_amma(nlev_amma))
-        
-        allocate(z_amma(nlev_amma))
-        allocate(th_amma(nlev_amma),q_amma(nlev_amma))
-        allocate(u_amma(nlev_amma))
-        allocate(v_amma(nlev_amma))
-
-!forcings
-        allocate(ht_amma(nlev_amma,nt_amma))
-        allocate(hq_amma(nlev_amma,nt_amma))
-        allocate(vitw_amma(nlev_amma,nt_amma))
-        allocate(lat_amma(nt_amma),sens_amma(nt_amma))
-
-!profils initiaux:
-        allocate(th_ammai(nlev_amma),q_ammai(nlev_amma))
-        allocate(u_ammai(nlev_amma))
-        allocate(v_ammai(nlev_amma))
-        allocate(vitw_ammai(nlev_amma) )
-        allocate(ht_ammai(nlev_amma))
-        allocate(hq_ammai(nlev_amma))
-        allocate(vt_ammai(nlev_amma))
-        allocate(vq_ammai(nlev_amma))
-
-!champs interpoles
-        allocate(vitw_profamma(nlev_amma))
-        allocate(ht_profamma(nlev_amma))
-        allocate(hq_profamma(nlev_amma))
-        allocate(vt_profamma(nlev_amma))
-        allocate(vq_profamma(nlev_amma))
-        allocate(th_profamma(nlev_amma))
-        allocate(q_profamma(nlev_amma))
-        allocate(u_profamma(nlev_amma))
-        allocate(v_profamma(nlev_amma))
-
-        PRINT*,'Allocations OK'
-        CALL read_amma(nid,nlev_amma,nt_amma                                  &
-       ,z_amma,plev_amma,th_amma,q_amma,u_amma,v_amma,vitw_amma         &
-       ,ht_amma,hq_amma,sens_amma,lat_amma)
-
-END SUBROUTINE read_1D_cases
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-SUBROUTINE deallocate_1D_cases
-!profils initiaux:
-        deallocate(plev_amma)
-        
-        deallocate(z_amma)
-        deallocate(th_amma,q_amma)
-        deallocate(u_amma)
-        deallocate(v_amma)
-
-        deallocate(th_ammai,q_ammai)
-        deallocate(u_ammai)
-        deallocate(v_ammai)
-        deallocate(vitw_ammai )
-        deallocate(ht_ammai)
-        deallocate(hq_ammai)
-        deallocate(vt_ammai)
-        deallocate(vq_ammai)
-        
-!forcings
-        deallocate(ht_amma)
-        deallocate(hq_amma)
-        deallocate(vitw_amma)
-        deallocate(lat_amma,sens_amma)
-
-!champs interpoles
-        deallocate(vitw_profamma)
-        deallocate(ht_profamma)
-        deallocate(hq_profamma)
-        deallocate(vt_profamma)
-        deallocate(vq_profamma)
-        deallocate(th_profamma)
-        deallocate(q_profamma)
-        deallocate(u_profamma)
-        deallocate(v_profamma)
-END SUBROUTINE deallocate_1D_cases
-
-
-!=====================================================================
-      SUBROUTINE read_amma(nid,nlevel,ntime                          &
-       ,zz,pp,temp,qv,u,v,dw                   &
-       ,dt,dq,sens,flat)
-
-!program reading forcings of the AMMA case study
-      IMPLICIT NONE
-
-      INTEGER ntime,nlevel
-
-      REAL zz(nlevel)
-      REAL temp(nlevel),pp(nlevel)
-      REAL qv(nlevel),u(nlevel)
-      REAL v(nlevel)
-      REAL dw(nlevel,ntime)
-      REAL dt(nlevel,ntime)
-      REAL dq(nlevel,ntime)
-      REAL flat(ntime),sens(ntime)
-
-
-      INTEGER nid, ierr,rid
-      INTEGER nbvar3d
-      parameter(nbvar3d=30)
-      INTEGER var3didin(nbvar3d)
-
-       ierr=nf90_inq_varid(nid,"zz",var3didin(1))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'lev'
-         endif
-
-
-      ierr=nf90_inq_varid(nid,"temp",var3didin(2))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'temp'
-         endif
-
-      ierr=nf90_inq_varid(nid,"qv",var3didin(3))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'qv'
-         endif
-
-      ierr=nf90_inq_varid(nid,"u",var3didin(4))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'u'
-         endif
-
-      ierr=nf90_inq_varid(nid,"v",var3didin(5))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'v'
-         endif
-
-      ierr=nf90_inq_varid(nid,"dw",var3didin(6))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'dw'
-         endif
-
-      ierr=nf90_inq_varid(nid,"dt",var3didin(7))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'dt'
-         endif
-
-      ierr=nf90_inq_varid(nid,"dq",var3didin(8))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'dq'
-         endif
-      
-      ierr=nf90_inq_varid(nid,"sens",var3didin(9))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'sens'
-         endif
-
-      ierr=nf90_inq_varid(nid,"flat",var3didin(10))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'flat'
-         endif
-
-      ierr=nf90_inq_varid(nid,"pp",var3didin(11))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
+      IF (annee_ref==2006 .AND. day1<day_ini_amma) THEN
+        PRINT*, 'AMMA a débuté le 10 juillet 2006', day1, day_ini_amma
+        PRINT*, 'Changer dayref dans run.def'
+        stop
       endif
-
-!dimensions lecture
-!      CALL catchaxis(nid,ntime,nlevel,time,z,ierr)
- 
-         ierr = nf90_get_var(nid,var3didin(1),zz)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture z ok',zz
-
-         ierr = nf90_get_var(nid,var3didin(2),temp)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture th ok',temp
-
-         ierr = nf90_get_var(nid,var3didin(3),qv)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture qv ok',qv
- 
-         ierr = nf90_get_var(nid,var3didin(4),u)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture u ok',u
-
-         ierr = nf90_get_var(nid,var3didin(5),v)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture v ok',v
-
-         ierr = nf90_get_var(nid,var3didin(6),dw)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture w ok',dw
-
-         ierr = nf90_get_var(nid,var3didin(7),dt)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dt ok',dt
-
-         ierr = nf90_get_var(nid,var3didin(8),dq)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dq ok',dq
-
-         ierr = nf90_get_var(nid,var3didin(9),sens)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture sens ok',sens
-
-         ierr = nf90_get_var(nid,var3didin(10),flat)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture flat ok',flat
-
-         ierr = nf90_get_var(nid,var3didin(11),pp)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture pp ok',pp
-
-
-         END SUBROUTINE  read_amma
-!======================================================================
-        SUBROUTINE interp_amma_time(day,day1,annee_ref                     &
-           ,year_ini_amma,day_ini_amma,nt_amma,dt_amma,nlev_amma       &
-           ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma               &
-           ,vitw_prof,ht_prof,hq_prof,lat_prof,sens_prof)
-        IMPLICIT NONE
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-
-! day: current julian day (e.g. 717538.2)
-! day1: first day of the simulation
-! nt_amma: total nb of data in the forcing (e.g. 48 for AMMA)
-! dt_amma: total time interval (in sec) between 2 forcing data (e.g. 30min for AMMA)
-!---------------------------------------------------------------------------------------
-
-        INCLUDE "compar1d.h"
-
-! inputs:
-        INTEGER annee_ref
-        INTEGER nt_amma,nlev_amma
-        INTEGER year_ini_amma
-        REAL day, day1,day_ini_amma,dt_amma
-        REAL vitw_amma(nlev_amma,nt_amma)
-        REAL ht_amma(nlev_amma,nt_amma)
-        REAL hq_amma(nlev_amma,nt_amma)
-        REAL lat_amma(nt_amma)
-        REAL sens_amma(nt_amma)
-! outputs:
-        REAL vitw_prof(nlev_amma)
-        REAL ht_prof(nlev_amma)
-        REAL hq_prof(nlev_amma)
-        REAL lat_prof,sens_prof
-! local:
-        INTEGER it_amma1, it_amma2,k
-        REAL timeit,time_amma1,time_amma2,frac
-
-
-        IF (forcing_type==6) THEN
-! Check that initial day of the simulation consistent with AMMA case:
-       IF (annee_ref/=2006) THEN
-        PRINT*,'Pour AMMA, annee_ref doit etre 2006'
-        PRINT*,'Changer annee_ref dans run.def'
+      IF (annee_ref==2006 .AND. day1>day_ini_amma + 1) THEN
+        PRINT*, 'AMMA a fini le 11 juillet'
+        PRINT*, 'Changer dayref ou nday dans run.def'
         stop
-       endif
-       IF (annee_ref==2006 .AND. day1<day_ini_amma) THEN
-        PRINT*,'AMMA a débuté le 10 juillet 2006',day1,day_ini_amma
-        PRINT*,'Changer dayref dans run.def'
-        stop
-       endif
-       IF (annee_ref==2006 .AND. day1>day_ini_amma+1) THEN
-        PRINT*,'AMMA a fini le 11 juillet'
-        PRINT*,'Changer dayref ou nday dans run.def'
-        stop
-       endif
-       endif
-
-! Determine timestep relative to the 1st day of AMMA:
-!       timeit=(day-day1)*86400.
-!       if (annee_ref.EQ.1992) THEN
-!        timeit=(day-day_ini_toga)*86400.
-!       else
-!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
-!       endif
-      timeit=(day-day_ini_amma)*86400
-
-! Determine the closest observation times:
-!       it_amma1=INT(timeit/dt_amma)+1
-!       it_amma2=it_amma1 + 1
-!       time_amma1=(it_amma1-1)*dt_amma
-!       time_amma2=(it_amma2-1)*dt_amma
-
-       it_amma1=INT(timeit/dt_amma)+1
-       IF (it_amma1 == nt_amma) THEN
-       it_amma2=it_amma1 
-       ELSE
-       it_amma2=it_amma1 + 1
-       ENDIF
-       time_amma1=(it_amma1-1)*dt_amma
-       time_amma2=(it_amma2-1)*dt_amma
-
-       IF (it_amma1 > nt_amma) THEN
-        WRITE(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
-          ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.
-        stop
-       endif
-
-! time interpolation:
-       IF (it_amma1 == it_amma2) THEN
-          frac=0.
-       ELSE 
-          frac=(time_amma2-timeit)/(time_amma2-time_amma1)
-          frac=max(frac,0.0)
-       ENDIF
-
-       lat_prof = lat_amma(it_amma2)                                       &
-            -frac*(lat_amma(it_amma2)-lat_amma(it_amma1))
-       sens_prof = sens_amma(it_amma2)                                     &
-            -frac*(sens_amma(it_amma2)-sens_amma(it_amma1))
-
-       do k=1,nlev_amma
-        vitw_prof(k) = vitw_amma(k,it_amma2)                               &
-            -frac*(vitw_amma(k,it_amma2)-vitw_amma(k,it_amma1))
-        ht_prof(k) = ht_amma(k,it_amma2)                                   &
-            -frac*(ht_amma(k,it_amma2)-ht_amma(k,it_amma1))
-        hq_prof(k) = hq_amma(k,it_amma2)                                   &
-            -frac*(hq_amma(k,it_amma2)-hq_amma(k,it_amma1))
-        enddo
-
-        RETURN
-        END
+      endif
+    endif
+
+    ! Determine timestep relative to the 1st day of AMMA:
+    !       timeit=(day-day1)*86400.
+    !       if (annee_ref.EQ.1992) THEN
+    !        timeit=(day-day_ini_toga)*86400.
+    !       else
+    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+    !       endif
+    timeit = (day - day_ini_amma) * 86400
+
+    ! Determine the closest observation times:
+    !       it_amma1=INT(timeit/dt_amma)+1
+    !       it_amma2=it_amma1 + 1
+    !       time_amma1=(it_amma1-1)*dt_amma
+    !       time_amma2=(it_amma2-1)*dt_amma
+
+    it_amma1 = INT(timeit / dt_amma) + 1
+    IF (it_amma1 == nt_amma) THEN
+      it_amma2 = it_amma1
+    ELSE
+      it_amma2 = it_amma1 + 1
+    ENDIF
+    time_amma1 = (it_amma1 - 1) * dt_amma
+    time_amma2 = (it_amma2 - 1) * dt_amma
+
+    IF (it_amma1 > nt_amma) THEN
+      WRITE(*, *) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
+              , day, day_ini_amma, it_amma1, it_amma2, timeit / 86400.
+      stop
+    endif
+
+    ! time interpolation:
+    IF (it_amma1 == it_amma2) THEN
+      frac = 0.
+    ELSE
+      frac = (time_amma2 - timeit) / (time_amma2 - time_amma1)
+      frac = max(frac, 0.0)
+    ENDIF
+
+    lat_prof = lat_amma(it_amma2)                                       &
+            - frac * (lat_amma(it_amma2) - lat_amma(it_amma1))
+    sens_prof = sens_amma(it_amma2)                                     &
+            - frac * (sens_amma(it_amma2) - sens_amma(it_amma1))
+
+    DO k = 1, nlev_amma
+      vitw_prof(k) = vitw_amma(k, it_amma2)                               &
+              - frac * (vitw_amma(k, it_amma2) - vitw_amma(k, it_amma1))
+      ht_prof(k) = ht_amma(k, it_amma2)                                   &
+              - frac * (ht_amma(k, it_amma2) - ht_amma(k, it_amma1))
+      hq_prof(k) = hq_amma(k, it_amma2)                                   &
+              - frac * (hq_amma(k, it_amma2) - hq_amma(k, it_amma1))
+    enddo
+
+    RETURN
+  END
 
 END MODULE mod_1D_amma_read
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90	(revision 5158)
@@ -1,1011 +1,999 @@
 MODULE mod_1D_cases_read
-  USE netcdf, ONLY: nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_inquire_dimension,nf90_inq_dimid,&
-          nf90_nowrite,nf90_open,nf90_get_var
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!Declarations specifiques au cas standard
-        CHARACTER*80 :: fich_cas
-! Discr?tisation
-        INTEGER nlev_cas, nt_cas
-
-
-!       integer year_ini_cas, day_ini_cas, mth_ini_cas
-!       real heure_ini_cas
-!       real day_ju_ini_cas   ! Julian day of case first day
-!       parameter (year_ini_cas=2011)
-!       parameter (year_ini_cas=1969)
-!       parameter (mth_ini_cas=10)
-!       parameter (mth_ini_cas=6)
-!       parameter (day_ini_cas=1)  ! 10 = 10Juil2006
-!       parameter (day_ini_cas=24)  ! 24 = 24 juin 1969
-!       parameter (heure_ini_cas=0.) !0h en secondes
-!       real pdt_cas
-!       parameter (pdt_cas=3.*3600)
-
-!CR ATTENTION TEST AMMA
-!        parameter (year_ini_cas=2006)
-!        parameter (mth_ini_cas=7)
-!        parameter (day_ini_cas=10)  ! 10 = 10Juil2006
-!        parameter (heure_ini_cas=0.) !0h en secondes
-!        parameter (pdt_cas=1800.)
-
-!profils environnementaux
-        REAL, ALLOCATABLE::  plev_cas(:,:)
-
-        REAL, ALLOCATABLE::  z_cas(:,:)
-        REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),rh_cas(:,:)
-        REAL, ALLOCATABLE::  th_cas(:,:),rv_cas(:,:)
-        REAL, ALLOCATABLE::  u_cas(:,:)
-        REAL, ALLOCATABLE::  v_cas(:,:)
-
-!forcing
-        REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
-        REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
-        REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
-        REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
-        REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
-        REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
-        REAL, ALLOCATABLE::  vitw_cas(:,:)
-        REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
-        REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:)
-        REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:)
-
-!champs interpoles
-        REAL, ALLOCATABLE::  plev_prof_cas(:)
-        REAL, ALLOCATABLE::  t_prof_cas(:)
-        REAL, ALLOCATABLE::  q_prof_cas(:)
-        REAL, ALLOCATABLE::  u_prof_cas(:)
-        REAL, ALLOCATABLE::  v_prof_cas(:)
-
-        REAL, ALLOCATABLE::  vitw_prof_cas(:)
-        REAL, ALLOCATABLE::  ug_prof_cas(:)
-        REAL, ALLOCATABLE::  vg_prof_cas(:)
-        REAL, ALLOCATABLE::  ht_prof_cas(:)
-        REAL, ALLOCATABLE::  hq_prof_cas(:)
-        REAL, ALLOCATABLE::  vt_prof_cas(:)
-        REAL, ALLOCATABLE::  vq_prof_cas(:)
-        REAL, ALLOCATABLE::  dt_prof_cas(:)
-        REAL, ALLOCATABLE::  dtrad_prof_cas(:)
-        REAL, ALLOCATABLE::  dq_prof_cas(:)
-        REAL, ALLOCATABLE::  hu_prof_cas(:)
-        REAL, ALLOCATABLE::  hv_prof_cas(:)
-        REAL, ALLOCATABLE::  vu_prof_cas(:)
-        REAL, ALLOCATABLE::  vv_prof_cas(:)
-        REAL, ALLOCATABLE::  du_prof_cas(:)
-        REAL, ALLOCATABLE::  dv_prof_cas(:)
-        REAL, ALLOCATABLE::  uw_prof_cas(:)
-        REAL, ALLOCATABLE::  vw_prof_cas(:)
-        REAL, ALLOCATABLE::  q1_prof_cas(:)
-        REAL, ALLOCATABLE::  q2_prof_cas(:)
-
-
-        REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
-
+  USE netcdf, ONLY: nf90_noerr, nf90_strerror, nf90_inq_varid, nf90_inquire_dimension, nf90_inq_dimid, &
+          nf90_nowrite, nf90_open, nf90_get_var
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !Declarations specifiques au cas standard
+  CHARACTER*80 :: fich_cas
+  ! Discr?tisation
+  INTEGER nlev_cas, nt_cas
+
+
+  !       integer year_ini_cas, day_ini_cas, mth_ini_cas
+  !       real heure_ini_cas
+  !       real day_ju_ini_cas   ! Julian day of case first day
+  !       parameter (year_ini_cas=2011)
+  !       parameter (year_ini_cas=1969)
+  !       parameter (mth_ini_cas=10)
+  !       parameter (mth_ini_cas=6)
+  !       parameter (day_ini_cas=1)  ! 10 = 10Juil2006
+  !       parameter (day_ini_cas=24)  ! 24 = 24 juin 1969
+  !       parameter (heure_ini_cas=0.) !0h en secondes
+  !       real pdt_cas
+  !       parameter (pdt_cas=3.*3600)
+
+  !CR ATTENTION TEST AMMA
+  !        parameter (year_ini_cas=2006)
+  !        parameter (mth_ini_cas=7)
+  !        parameter (day_ini_cas=10)  ! 10 = 10Juil2006
+  !        parameter (heure_ini_cas=0.) !0h en secondes
+  !        parameter (pdt_cas=1800.)
+
+  !profils environnementaux
+  REAL, ALLOCATABLE :: plev_cas(:, :)
+
+  REAL, ALLOCATABLE :: z_cas(:, :)
+  REAL, ALLOCATABLE :: t_cas(:, :), q_cas(:, :), rh_cas(:, :)
+  REAL, ALLOCATABLE :: th_cas(:, :), rv_cas(:, :)
+  REAL, ALLOCATABLE :: u_cas(:, :)
+  REAL, ALLOCATABLE :: v_cas(:, :)
+
+  !forcing
+  REAL, ALLOCATABLE :: ht_cas(:, :), vt_cas(:, :), dt_cas(:, :), dtrad_cas(:, :)
+  REAL, ALLOCATABLE :: hth_cas(:, :), vth_cas(:, :), dth_cas(:, :)
+  REAL, ALLOCATABLE :: hq_cas(:, :), vq_cas(:, :), dq_cas(:, :)
+  REAL, ALLOCATABLE :: hr_cas(:, :), vr_cas(:, :), dr_cas(:, :)
+  REAL, ALLOCATABLE :: hu_cas(:, :), vu_cas(:, :), du_cas(:, :)
+  REAL, ALLOCATABLE :: hv_cas(:, :), vv_cas(:, :), dv_cas(:, :)
+  REAL, ALLOCATABLE :: vitw_cas(:, :)
+  REAL, ALLOCATABLE :: ug_cas(:, :), vg_cas(:, :)
+  REAL, ALLOCATABLE :: lat_cas(:), sens_cas(:), ts_cas(:), ustar_cas(:)
+  REAL, ALLOCATABLE :: uw_cas(:, :), vw_cas(:, :), q1_cas(:, :), q2_cas(:, :)
+
+  !champs interpoles
+  REAL, ALLOCATABLE :: plev_prof_cas(:)
+  REAL, ALLOCATABLE :: t_prof_cas(:)
+  REAL, ALLOCATABLE :: q_prof_cas(:)
+  REAL, ALLOCATABLE :: u_prof_cas(:)
+  REAL, ALLOCATABLE :: v_prof_cas(:)
+
+  REAL, ALLOCATABLE :: vitw_prof_cas(:)
+  REAL, ALLOCATABLE :: ug_prof_cas(:)
+  REAL, ALLOCATABLE :: vg_prof_cas(:)
+  REAL, ALLOCATABLE :: ht_prof_cas(:)
+  REAL, ALLOCATABLE :: hq_prof_cas(:)
+  REAL, ALLOCATABLE :: vt_prof_cas(:)
+  REAL, ALLOCATABLE :: vq_prof_cas(:)
+  REAL, ALLOCATABLE :: dt_prof_cas(:)
+  REAL, ALLOCATABLE :: dtrad_prof_cas(:)
+  REAL, ALLOCATABLE :: dq_prof_cas(:)
+  REAL, ALLOCATABLE :: hu_prof_cas(:)
+  REAL, ALLOCATABLE :: hv_prof_cas(:)
+  REAL, ALLOCATABLE :: vu_prof_cas(:)
+  REAL, ALLOCATABLE :: vv_prof_cas(:)
+  REAL, ALLOCATABLE :: du_prof_cas(:)
+  REAL, ALLOCATABLE :: dv_prof_cas(:)
+  REAL, ALLOCATABLE :: uw_prof_cas(:)
+  REAL, ALLOCATABLE :: vw_prof_cas(:)
+  REAL, ALLOCATABLE :: q1_prof_cas(:)
+  REAL, ALLOCATABLE :: q2_prof_cas(:)
+
+  REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas
 
 
 CONTAINS
 
-SUBROUTINE read_1D_cas
-
-      INTEGER nid,rid,ierr
-      INTEGER ii,jj
-
-      fich_cas='setup/cas.nc'
-      PRINT*,'fich_cas ',fich_cas
-      ierr = nf90_open(fich_cas,nf90_nowrite,nid)
-      PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
-      IF (ierr/=nf90_noerr) THEN
-         WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
-         WRITE(*,*) nf90_strerror(ierr)
-         stop ""
-      endif
-!.......................................................................
-      ierr=nf90_inq_dimid(nid,'lat',rid)
-      IF (ierr/=nf90_noerr) THEN
-         PRINT*, 'Oh probleme lecture dimension lat'
-      ENDIF
-      ierr=nf90_inquire_dimension(nid,rid,len=ii)
-      PRINT*,'OK1 nid,rid,lat',nid,rid,ii
-!.......................................................................
-      ierr=nf90_inq_dimid(nid,'lon',rid)
-      IF (ierr/=nf90_noerr) THEN
-         PRINT*, 'Oh probleme lecture dimension lon'
-      ENDIF
-      ierr=nf90_inquire_dimension(nid,rid,len=jj)
-      PRINT*,'OK2 nid,rid,lat',nid,rid,jj
-!.......................................................................
-      ierr=nf90_inq_dimid(nid,'lev',rid)
-      IF (ierr/=nf90_noerr) THEN
-         PRINT*, 'Oh probleme lecture dimension zz'
-      ENDIF
-      ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
-      PRINT*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
-!.......................................................................
-      ierr=nf90_inq_dimid(nid,'time',rid)
-      PRINT*,'nid,rid',nid,rid
-      nt_cas=0
-      IF (ierr/=nf90_noerr) THEN
-        stop 'probleme lecture dimension sens'
-      ENDIF
-      ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
-      PRINT*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!profils moyens:
-        allocate(plev_cas(nlev_cas,nt_cas))
-        allocate(z_cas(nlev_cas,nt_cas))
-        allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
-        allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
-        allocate(u_cas(nlev_cas,nt_cas))
-        allocate(v_cas(nlev_cas,nt_cas))
-
-!forcing
-        allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
-        allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
-        allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
-        allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
-        allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
-        allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
-        allocate(vitw_cas(nlev_cas,nt_cas))
-        allocate(ug_cas(nlev_cas,nt_cas))
-        allocate(vg_cas(nlev_cas,nt_cas))
-        allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ustar_cas(nt_cas))
-        allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
-
-
-!champs interpoles
-        allocate(plev_prof_cas(nlev_cas))
-        allocate(t_prof_cas(nlev_cas))
-        allocate(q_prof_cas(nlev_cas))
-        allocate(u_prof_cas(nlev_cas))
-        allocate(v_prof_cas(nlev_cas))
-
-        allocate(vitw_prof_cas(nlev_cas))
-        allocate(ug_prof_cas(nlev_cas))
-        allocate(vg_prof_cas(nlev_cas))
-        allocate(ht_prof_cas(nlev_cas))
-        allocate(hq_prof_cas(nlev_cas))
-        allocate(hu_prof_cas(nlev_cas))
-        allocate(hv_prof_cas(nlev_cas))
-        allocate(vt_prof_cas(nlev_cas))
-        allocate(vq_prof_cas(nlev_cas))
-        allocate(vu_prof_cas(nlev_cas))
-        allocate(vv_prof_cas(nlev_cas))
-        allocate(dt_prof_cas(nlev_cas))
-        allocate(dtrad_prof_cas(nlev_cas))
-        allocate(dq_prof_cas(nlev_cas))
-        allocate(du_prof_cas(nlev_cas))
-        allocate(dv_prof_cas(nlev_cas))
-        allocate(uw_prof_cas(nlev_cas))
-        allocate(vw_prof_cas(nlev_cas))
-        allocate(q1_prof_cas(nlev_cas))
-        allocate(q2_prof_cas(nlev_cas))
-
-        PRINT*,'Allocations OK'
-        CALL read_cas(nid,nlev_cas,nt_cas                                       &
-       ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas         &
-       ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas    &
-       ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas                 &
-       ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
-       ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
-        PRINT*,'Read cas OK'
-
-
-END SUBROUTINE read_1D_cas
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-SUBROUTINE deallocate_1D_cases
-!profils environnementaux:
-        deallocate(plev_cas)
-
-        deallocate(z_cas)
-        deallocate(t_cas,q_cas,rh_cas)
-        deallocate(th_cas,rv_cas)
-        deallocate(u_cas)
-        deallocate(v_cas)
-
-!forcing
-        deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
-        deallocate(hq_cas,vq_cas,dq_cas)
-        deallocate(hth_cas,vth_cas,dth_cas)
-        deallocate(hr_cas,vr_cas,dr_cas)
-        deallocate(hu_cas,vu_cas,du_cas)
-        deallocate(hv_cas,vv_cas,dv_cas)
-        deallocate(vitw_cas)
-        deallocate(ug_cas)
-        deallocate(vg_cas)
-        deallocate(lat_cas,sens_cas,ts_cas,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
-
-!champs interpoles
-        deallocate(plev_prof_cas)
-        deallocate(t_prof_cas)
-        deallocate(q_prof_cas)
-        deallocate(u_prof_cas)
-        deallocate(v_prof_cas)
-
-        deallocate(vitw_prof_cas)
-        deallocate(ug_prof_cas)
-        deallocate(vg_prof_cas)
-        deallocate(ht_prof_cas)
-        deallocate(hq_prof_cas)
-        deallocate(hu_prof_cas)
-        deallocate(hv_prof_cas)
-        deallocate(vt_prof_cas)
-        deallocate(vq_prof_cas)
-        deallocate(vu_prof_cas)
-        deallocate(vv_prof_cas)
-        deallocate(dt_prof_cas)
-        deallocate(dtrad_prof_cas)
-        deallocate(dq_prof_cas)
-        deallocate(du_prof_cas)
-        deallocate(dv_prof_cas)
-        deallocate(t_prof_cas)
-        deallocate(q_prof_cas)
-        deallocate(u_prof_cas)
-        deallocate(v_prof_cas)
-        deallocate(uw_prof_cas)
-        deallocate(vw_prof_cas)
-        deallocate(q1_prof_cas)
-        deallocate(q2_prof_cas)
-
-END SUBROUTINE deallocate_1D_cases
+  SUBROUTINE read_1D_cas
+
+    INTEGER nid, rid, ierr
+    INTEGER ii, jj
+
+    fich_cas = 'setup/cas.nc'
+    PRINT*, 'fich_cas ', fich_cas
+    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
+    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
+    IF (ierr/=nf90_noerr) THEN
+      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
+      WRITE(*, *) nf90_strerror(ierr)
+      stop ""
+    endif
+    !.......................................................................
+    ierr = nf90_inq_dimid(nid, 'lat', rid)
+    IF (ierr/=nf90_noerr) THEN
+      PRINT*, 'Oh probleme lecture dimension lat'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = ii)
+    PRINT*, 'OK1 nid,rid,lat', nid, rid, ii
+    !.......................................................................
+    ierr = nf90_inq_dimid(nid, 'lon', rid)
+    IF (ierr/=nf90_noerr) THEN
+      PRINT*, 'Oh probleme lecture dimension lon'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = jj)
+    PRINT*, 'OK2 nid,rid,lat', nid, rid, jj
+    !.......................................................................
+    ierr = nf90_inq_dimid(nid, 'lev', rid)
+    IF (ierr/=nf90_noerr) THEN
+      PRINT*, 'Oh probleme lecture dimension zz'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
+    PRINT*, 'OK3 nid,rid,nlev_cas', nid, rid, nlev_cas
+    !.......................................................................
+    ierr = nf90_inq_dimid(nid, 'time', rid)
+    PRINT*, 'nid,rid', nid, rid
+    nt_cas = 0
+    IF (ierr/=nf90_noerr) THEN
+      stop 'probleme lecture dimension sens'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
+    PRINT*, 'OK4 nid,rid,nt_cas', nid, rid, nt_cas
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !profils moyens:
+    allocate(plev_cas(nlev_cas, nt_cas))
+    allocate(z_cas(nlev_cas, nt_cas))
+    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
+    allocate(th_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
+    allocate(u_cas(nlev_cas, nt_cas))
+    allocate(v_cas(nlev_cas, nt_cas))
+
+    !forcing
+    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
+    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
+    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
+    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
+    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
+    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
+    allocate(vitw_cas(nlev_cas, nt_cas))
+    allocate(ug_cas(nlev_cas, nt_cas))
+    allocate(vg_cas(nlev_cas, nt_cas))
+    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ustar_cas(nt_cas))
+    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
+
+
+    !champs interpoles
+    allocate(plev_prof_cas(nlev_cas))
+    allocate(t_prof_cas(nlev_cas))
+    allocate(q_prof_cas(nlev_cas))
+    allocate(u_prof_cas(nlev_cas))
+    allocate(v_prof_cas(nlev_cas))
+
+    allocate(vitw_prof_cas(nlev_cas))
+    allocate(ug_prof_cas(nlev_cas))
+    allocate(vg_prof_cas(nlev_cas))
+    allocate(ht_prof_cas(nlev_cas))
+    allocate(hq_prof_cas(nlev_cas))
+    allocate(hu_prof_cas(nlev_cas))
+    allocate(hv_prof_cas(nlev_cas))
+    allocate(vt_prof_cas(nlev_cas))
+    allocate(vq_prof_cas(nlev_cas))
+    allocate(vu_prof_cas(nlev_cas))
+    allocate(vv_prof_cas(nlev_cas))
+    allocate(dt_prof_cas(nlev_cas))
+    allocate(dtrad_prof_cas(nlev_cas))
+    allocate(dq_prof_cas(nlev_cas))
+    allocate(du_prof_cas(nlev_cas))
+    allocate(dv_prof_cas(nlev_cas))
+    allocate(uw_prof_cas(nlev_cas))
+    allocate(vw_prof_cas(nlev_cas))
+    allocate(q1_prof_cas(nlev_cas))
+    allocate(q2_prof_cas(nlev_cas))
+
+    PRINT*, 'Allocations OK'
+    CALL read_cas(nid, nlev_cas, nt_cas                                       &
+            , z_cas, plev_cas, t_cas, q_cas, rh_cas, th_cas, rv_cas, u_cas, v_cas         &
+            , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas, dv_cas, hv_cas, vv_cas    &
+            , dt_cas, dtrad_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas                 &
+            , dth_cas, hth_cas, vth_cas, dr_cas, hr_cas, vr_cas, sens_cas, lat_cas, ts_cas&
+            , ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas)
+    PRINT*, 'Read cas OK'
+
+  END SUBROUTINE read_1D_cas
+
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE deallocate_1D_cases
+    !profils environnementaux:
+    deallocate(plev_cas)
+
+    deallocate(z_cas)
+    deallocate(t_cas, q_cas, rh_cas)
+    deallocate(th_cas, rv_cas)
+    deallocate(u_cas)
+    deallocate(v_cas)
+
+    !forcing
+    deallocate(ht_cas, vt_cas, dt_cas, dtrad_cas)
+    deallocate(hq_cas, vq_cas, dq_cas)
+    deallocate(hth_cas, vth_cas, dth_cas)
+    deallocate(hr_cas, vr_cas, dr_cas)
+    deallocate(hu_cas, vu_cas, du_cas)
+    deallocate(hv_cas, vv_cas, dv_cas)
+    deallocate(vitw_cas)
+    deallocate(ug_cas)
+    deallocate(vg_cas)
+    deallocate(lat_cas, sens_cas, ts_cas, ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas)
+
+    !champs interpoles
+    deallocate(plev_prof_cas)
+    deallocate(t_prof_cas)
+    deallocate(q_prof_cas)
+    deallocate(u_prof_cas)
+    deallocate(v_prof_cas)
+
+    deallocate(vitw_prof_cas)
+    deallocate(ug_prof_cas)
+    deallocate(vg_prof_cas)
+    deallocate(ht_prof_cas)
+    deallocate(hq_prof_cas)
+    deallocate(hu_prof_cas)
+    deallocate(hv_prof_cas)
+    deallocate(vt_prof_cas)
+    deallocate(vq_prof_cas)
+    deallocate(vu_prof_cas)
+    deallocate(vv_prof_cas)
+    deallocate(dt_prof_cas)
+    deallocate(dtrad_prof_cas)
+    deallocate(dq_prof_cas)
+    deallocate(du_prof_cas)
+    deallocate(dv_prof_cas)
+    deallocate(t_prof_cas)
+    deallocate(q_prof_cas)
+    deallocate(u_prof_cas)
+    deallocate(v_prof_cas)
+    deallocate(uw_prof_cas)
+    deallocate(vw_prof_cas)
+    deallocate(q1_prof_cas)
+    deallocate(q2_prof_cas)
+
+  END SUBROUTINE deallocate_1D_cases
 
   !=====================================================================
-      SUBROUTINE read_cas(nid,nlevel,ntime                          &
-       ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
-       du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
-       dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
-
-!program reading forcing of the case study
-
-      INTEGER ntime,nlevel
-
-      REAL zz(nlevel,ntime)
-      REAL pp(nlevel,ntime)
-      REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
-      REAL theta(nlevel,ntime),rv(nlevel,ntime)
-      REAL u(nlevel,ntime)
-      REAL v(nlevel,ntime)
-      REAL ug(nlevel,ntime)
-      REAL vg(nlevel,ntime)
-      REAL w(nlevel,ntime)
-      REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-      REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-      REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-      REAL dtrad(nlevel,ntime)
-      REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-      REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
-      REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-      REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
-      REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
-
-
-      INTEGER nid, ierr,rid
-      INTEGER nbvar3d
-      parameter(nbvar3d=39)
-      INTEGER var3didin(nbvar3d)
-
-       ierr=nf90_inq_varid(nid,"zz",var3didin(1))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'lev'
-         endif
-
-      ierr=nf90_inq_varid(nid,"pp",var3didin(2))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'plev'
-         endif
-
-
-      ierr=nf90_inq_varid(nid,"temp",var3didin(3))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'temp'
-         endif
-
-      ierr=nf90_inq_varid(nid,"qv",var3didin(4))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'qv'
-         endif
-
-      ierr=nf90_inq_varid(nid,"rh",var3didin(5))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'rh'
-         endif
-
-      ierr=nf90_inq_varid(nid,"theta",var3didin(6))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'theta'
-         endif
-
-      ierr=nf90_inq_varid(nid,"rv",var3didin(7))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'rv'
-         endif
-
-
-      ierr=nf90_inq_varid(nid,"u",var3didin(8))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'u'
-         endif
-
-      ierr=nf90_inq_varid(nid,"v",var3didin(9))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'v'
-         endif
-
-       ierr=nf90_inq_varid(nid,"ug",var3didin(10))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'ug'
-         endif
-
-      ierr=nf90_inq_varid(nid,"vg",var3didin(11))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vg'
-         endif
-
-      ierr=nf90_inq_varid(nid,"w",var3didin(12))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'w'
-         endif
-
-      ierr=nf90_inq_varid(nid,"advu",var3didin(13))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'advu'
-         endif
-
-      ierr=nf90_inq_varid(nid,"hu",var3didin(14))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'hu'
-         endif
-
-       ierr=nf90_inq_varid(nid,"vu",var3didin(15))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vu'
-         endif
-
-       ierr=nf90_inq_varid(nid,"advv",var3didin(16))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'advv'
-         endif
-
-      ierr=nf90_inq_varid(nid,"hv",var3didin(17))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'hv'
-         endif
-
-       ierr=nf90_inq_varid(nid,"vv",var3didin(18))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vv'
-         endif
-
-      ierr=nf90_inq_varid(nid,"advT",var3didin(19))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'advT'
-         endif
-
-      ierr=nf90_inq_varid(nid,"hT",var3didin(20))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'hT'
-         endif
-
-      ierr=nf90_inq_varid(nid,"vT",var3didin(21))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vT'
-         endif
-
-      ierr=nf90_inq_varid(nid,"advq",var3didin(22))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'advq'
-         endif
-
-      ierr=nf90_inq_varid(nid,"hq",var3didin(23))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'hq'
-         endif
-
-      ierr=nf90_inq_varid(nid,"vq",var3didin(24))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vq'
-         endif
-
-      ierr=nf90_inq_varid(nid,"advth",var3didin(25))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'advth'
-         endif
-
-      ierr=nf90_inq_varid(nid,"hth",var3didin(26))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'hth'
-         endif
-
-      ierr=nf90_inq_varid(nid,"vth",var3didin(27))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vth'
-         endif
-
-      ierr=nf90_inq_varid(nid,"advr",var3didin(28))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'advr'
-         endif
-
-      ierr=nf90_inq_varid(nid,"hr",var3didin(29))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'hr'
-         endif
-
-      ierr=nf90_inq_varid(nid,"vr",var3didin(30))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vr'
-         endif
-
-      ierr=nf90_inq_varid(nid,"radT",var3didin(31))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'radT'
-         endif
-
-      ierr=nf90_inq_varid(nid,"sens",var3didin(32))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'sens'
-         endif
-
-      ierr=nf90_inq_varid(nid,"flat",var3didin(33))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'flat'
-         endif
-
-      ierr=nf90_inq_varid(nid,"ts",var3didin(34))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'ts'
-         endif
-
-      ierr=nf90_inq_varid(nid,"ustar",var3didin(35))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'ustar'
-         endif
-
-      ierr=nf90_inq_varid(nid,"uw",var3didin(36))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'uw'
-         endif
-
-      ierr=nf90_inq_varid(nid,"vw",var3didin(37))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'vw'
-         endif
-
-      ierr=nf90_inq_varid(nid,"q1",var3didin(38))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'q1'
-         endif
-
-      ierr=nf90_inq_varid(nid,"q2",var3didin(39))
-         IF(ierr/=nf90_noerr) THEN
-           WRITE(*,*) nf90_strerror(ierr)
-           stop 'q2'
-         endif
-
-         ierr = nf90_get_var(nid,var3didin(1),zz)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture z ok',zz
-
-         ierr = nf90_get_var(nid,var3didin(2),pp)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture pp ok',pp
-
-
-         ierr = nf90_get_var(nid,var3didin(3),temp)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture T ok',temp
-
-         ierr = nf90_get_var(nid,var3didin(4),qv)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture qv ok',qv
-
-         ierr = nf90_get_var(nid,var3didin(5),rh)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture rh ok',rh
-
-         ierr = nf90_get_var(nid,var3didin(6),theta)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture theta ok',theta
-
-         ierr = nf90_get_var(nid,var3didin(7),rv)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture rv ok',rv
-
-         ierr = nf90_get_var(nid,var3didin(8),u)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture u ok',u
-
-         ierr = nf90_get_var(nid,var3didin(9),v)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture v ok',v
-
-         ierr = nf90_get_var(nid,var3didin(10),ug)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture ug ok',ug
-
-         ierr = nf90_get_var(nid,var3didin(11),vg)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture vg ok',vg
-
-         ierr = nf90_get_var(nid,var3didin(12),w)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture w ok',w
-
-         ierr = nf90_get_var(nid,var3didin(13),du)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture du ok',du
-
-         ierr = nf90_get_var(nid,var3didin(14),hu)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture hu ok',hu
-
-         ierr = nf90_get_var(nid,var3didin(15),vu)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture vu ok',vu
-
-         ierr = nf90_get_var(nid,var3didin(16),dv)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dv ok',dv
-
-         ierr = nf90_get_var(nid,var3didin(17),hv)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture hv ok',hv
-
-         ierr = nf90_get_var(nid,var3didin(18),vv)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture vv ok',vv
-
-         ierr = nf90_get_var(nid,var3didin(19),dt)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dt ok',dt
-
-         ierr = nf90_get_var(nid,var3didin(20),ht)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture ht ok',ht
-
-         ierr = nf90_get_var(nid,var3didin(21),vt)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture vt ok',vt
-
-         ierr = nf90_get_var(nid,var3didin(22),dq)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dq ok',dq
-
-         ierr = nf90_get_var(nid,var3didin(23),hq)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture hq ok',hq
-
-         ierr = nf90_get_var(nid,var3didin(24),vq)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture vq ok',vq
-
-         ierr = nf90_get_var(nid,var3didin(25),dth)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dth ok',dth
-
-         ierr = nf90_get_var(nid,var3didin(26),hth)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture hth ok',hth
-
-         ierr = nf90_get_var(nid,var3didin(27),vth)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture vth ok',vth
-
-         ierr = nf90_get_var(nid,var3didin(28),dr)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dr ok',dr
-
-         ierr = nf90_get_var(nid,var3didin(29),hr)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture hr ok',hr
-
-         ierr = nf90_get_var(nid,var3didin(30),vr)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture vr ok',vr
-
-         ierr = nf90_get_var(nid,var3didin(31),dtrad)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture dtrad ok',dtrad
-
-         ierr = nf90_get_var(nid,var3didin(32),sens)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture sens ok',sens
-
-         ierr = nf90_get_var(nid,var3didin(33),flat)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture flat ok',flat
-
-         ierr = nf90_get_var(nid,var3didin(34),ts)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!          WRITE(*,*)'lecture ts ok',ts
-
-         ierr = nf90_get_var(nid,var3didin(35),ustar)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         WRITE(*,*)'lecture ustar ok',ustar
-
-         ierr = nf90_get_var(nid,var3didin(36),uw)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         WRITE(*,*)'lecture uw ok',uw
-
-         ierr = nf90_get_var(nid,var3didin(37),vw)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         WRITE(*,*)'lecture vw ok',vw
-
-         ierr = nf90_get_var(nid,var3didin(38),q1)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         WRITE(*,*)'lecture q1 ok',q1
-
-         ierr = nf90_get_var(nid,var3didin(39),q2)
-         IF(ierr/=nf90_noerr) THEN
-            WRITE(*,*) nf90_strerror(ierr)
-            stop "getvarup"
-         endif
-!         WRITE(*,*)'lecture q2 ok',q2
-
-
-
-         END SUBROUTINE  read_cas
-!======================================================================
-        SUBROUTINE interp_case_time(day,day1,annee_ref                &
-!    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
-           ,nt_cas,nlev_cas                                       &
-           ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
-           ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
-           ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
-           ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
-           ,uw_cas,vw_cas,q1_cas,q2_cas                           &
-           ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
-           ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
-           ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
-           ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
-           ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
-           ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
-           ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
-
-
-        IMPLICIT NONE
-
-!---------------------------------------------------------------------------------------
-! Time interpolation of a 2D field to the timestep corresponding to day
-
-! day: current julian day (e.g. 717538.2)
-! day1: first day of the simulation
-! nt_cas: total nb of data in the forcing
-! pdt_cas: total time interval (in sec) between 2 forcing data
-!---------------------------------------------------------------------------------------
-
-        INCLUDE "compar1d.h"
-        INCLUDE "date_cas.h"
-
-! inputs:
-        INTEGER annee_ref
-        INTEGER nt_cas,nlev_cas
-        REAL day, day1,day_cas
-        REAL ts_cas(nt_cas)
-        REAL plev_cas(nlev_cas,nt_cas)
-        REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
-        REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
-        REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
-        REAL vitw_cas(nlev_cas,nt_cas)
-        REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
-        REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
-        REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
-        REAL dtrad_cas(nlev_cas,nt_cas)
-        REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-        REAL lat_cas(nt_cas)
-        REAL sens_cas(nt_cas)
-        REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
-        REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
-
-! outputs:
-        REAL plev_prof_cas(nlev_cas)
-        REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
-        REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-        REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
-        REAL vitw_prof_cas(nlev_cas)
-        REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-        REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-        REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
-        REAL dtrad_prof_cas(nlev_cas)
-        REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-        REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
-        REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
-! local:
-        INTEGER it_cas1, it_cas2,k
-        REAL timeit,time_cas1,time_cas2,frac
-
-
-        PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
-
-! On teste si la date du cas AMMA est correcte.
-! C est pour memoire car en fait les fichiers .def
-! sont censes etre corrects.
-! A supprimer a terme (MPL 20150623)
-!     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
-! Check that initial day of the simulation consistent with AMMA case:
-!      if (annee_ref.NE.2006) THEN
-!       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
-!       PRINT*,'Changer annee_ref dans run.def'
-!       stop
-!      endif
-!      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
-!       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
-!       PRINT*,'Changer dayref dans run.def'
-!       stop
-!      endif
-!      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
-!       PRINT*,'AMMA a fini le 11 juillet'
-!       PRINT*,'Changer dayref ou nday dans run.def'
-!       stop
-!      endif
-!      endif
-
-! Determine timestep relative to the 1st day:
-!       timeit=(day-day1)*86400.
-!       if (annee_ref.EQ.1992) THEN
-!        timeit=(day-day_cas)*86400.
-!       else
-!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
-!       endif
-      timeit=(day-day_ju_ini_cas)*86400
-      print *,'day=',day
-      print *,'day_ju_ini_cas=',day_ju_ini_cas
-      print *,'pdt_cas=',pdt_cas
-      print *,'timeit=',timeit
-      print *,'nt_cas=',nt_cas
-
-! Determine the closest observation times:
-!       it_cas1=INT(timeit/pdt_cas)+1
-!       it_cas2=it_cas1 + 1
-!       time_cas1=(it_cas1-1)*pdt_cas
-!       time_cas2=(it_cas2-1)*pdt_cas
-
-       it_cas1=INT(timeit/pdt_cas)+1
-       IF (it_cas1 == nt_cas) THEN
-       it_cas2=it_cas1
-       ELSE
-       it_cas2=it_cas1 + 1
-       ENDIF
-       time_cas1=(it_cas1-1)*pdt_cas
-       time_cas2=(it_cas2-1)*pdt_cas
-      print *,'it_cas1=',it_cas1
-      print *,'it_cas2=',it_cas2
-      print *,'time_cas1=',time_cas1
-      print *,'time_cas2=',time_cas2
-
-       IF (it_cas1 > nt_cas) THEN
-        WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
-          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
-        stop
-       endif
-
-! time interpolation:
-       IF (it_cas1 == it_cas2) THEN
-          frac=0.
-       ELSE
-          frac=(time_cas2-timeit)/(time_cas2-time_cas1)
-          frac=max(frac,0.0)
-       ENDIF
-
-       lat_prof_cas = lat_cas(it_cas2)                                       &
-            -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
-       sens_prof_cas = sens_cas(it_cas2)                                     &
-            -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
-       ts_prof_cas = ts_cas(it_cas2)                                         &
-            -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
-       ustar_prof_cas = ustar_cas(it_cas2)                                   &
-            -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
-
-       do k=1,nlev_cas
-        plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
-            -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
-        t_prof_cas(k) = t_cas(k,it_cas2)                               &
-            -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
-        q_prof_cas(k) = q_cas(k,it_cas2)                               &
-            -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
-        u_prof_cas(k) = u_cas(k,it_cas2)                               &
-            -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
-        v_prof_cas(k) = v_cas(k,it_cas2)                               &
-            -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
-        ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
-            -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
-        vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
-            -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
-        vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
-            -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
-        du_prof_cas(k) = du_cas(k,it_cas2)                                   &
-            -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
-        hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
-            -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
-        vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
-            -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
-        dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
-            -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
-        hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
-            -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
-        vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
-            -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
-        dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
-            -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
-        ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
-            -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
-        vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
-            -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
-        dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
-            -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
-        dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
-            -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
-        hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
-            -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
-        vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
-            -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
-       uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
-            -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
-       vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
-            -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
-       q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
-            -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
-       q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
-            -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
-        enddo
-
-        RETURN
-        END
-
-!**********************************************************************************************
+  SUBROUTINE read_cas(nid, nlevel, ntime                          &
+          , zz, pp, temp, qv, rh, theta, rv, u, v, ug, vg, w, &
+          du, hu, vu, dv, hv, vv, dt, dtrad, ht, vt, dq, hq, vq, &
+          dth, hth, vth, dr, hr, vr, sens, flat, ts, ustar, uw, vw, q1, q2)
+
+    !program reading forcing of the case study
+
+    INTEGER ntime, nlevel
+
+    REAL zz(nlevel, ntime)
+    REAL pp(nlevel, ntime)
+    REAL temp(nlevel, ntime), qv(nlevel, ntime), rh(nlevel, ntime)
+    REAL theta(nlevel, ntime), rv(nlevel, ntime)
+    REAL u(nlevel, ntime)
+    REAL v(nlevel, ntime)
+    REAL ug(nlevel, ntime)
+    REAL vg(nlevel, ntime)
+    REAL w(nlevel, ntime)
+    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
+    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
+    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
+    REAL dtrad(nlevel, ntime)
+    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
+    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime)
+    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
+    REAL flat(ntime), sens(ntime), ts(ntime), ustar(ntime)
+    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime)
+
+    INTEGER nid, ierr, rid
+    INTEGER nbvar3d
+    parameter(nbvar3d = 39)
+    INTEGER var3didin(nbvar3d)
+
+    ierr = nf90_inq_varid(nid, "zz", var3didin(1))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'lev'
+    endif
+
+    ierr = nf90_inq_varid(nid, "pp", var3didin(2))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'plev'
+    endif
+
+    ierr = nf90_inq_varid(nid, "temp", var3didin(3))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'temp'
+    endif
+
+    ierr = nf90_inq_varid(nid, "qv", var3didin(4))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'qv'
+    endif
+
+    ierr = nf90_inq_varid(nid, "rh", var3didin(5))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'rh'
+    endif
+
+    ierr = nf90_inq_varid(nid, "theta", var3didin(6))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'theta'
+    endif
+
+    ierr = nf90_inq_varid(nid, "rv", var3didin(7))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'rv'
+    endif
+
+    ierr = nf90_inq_varid(nid, "u", var3didin(8))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'u'
+    endif
+
+    ierr = nf90_inq_varid(nid, "v", var3didin(9))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'v'
+    endif
+
+    ierr = nf90_inq_varid(nid, "ug", var3didin(10))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'ug'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vg", var3didin(11))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vg'
+    endif
+
+    ierr = nf90_inq_varid(nid, "w", var3didin(12))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'w'
+    endif
+
+    ierr = nf90_inq_varid(nid, "advu", var3didin(13))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'advu'
+    endif
+
+    ierr = nf90_inq_varid(nid, "hu", var3didin(14))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'hu'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vu", var3didin(15))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vu'
+    endif
+
+    ierr = nf90_inq_varid(nid, "advv", var3didin(16))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'advv'
+    endif
+
+    ierr = nf90_inq_varid(nid, "hv", var3didin(17))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'hv'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vv", var3didin(18))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vv'
+    endif
+
+    ierr = nf90_inq_varid(nid, "advT", var3didin(19))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'advT'
+    endif
+
+    ierr = nf90_inq_varid(nid, "hT", var3didin(20))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'hT'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vT", var3didin(21))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vT'
+    endif
+
+    ierr = nf90_inq_varid(nid, "advq", var3didin(22))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'advq'
+    endif
+
+    ierr = nf90_inq_varid(nid, "hq", var3didin(23))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'hq'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vq", var3didin(24))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vq'
+    endif
+
+    ierr = nf90_inq_varid(nid, "advth", var3didin(25))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'advth'
+    endif
+
+    ierr = nf90_inq_varid(nid, "hth", var3didin(26))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'hth'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vth", var3didin(27))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vth'
+    endif
+
+    ierr = nf90_inq_varid(nid, "advr", var3didin(28))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'advr'
+    endif
+
+    ierr = nf90_inq_varid(nid, "hr", var3didin(29))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'hr'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vr", var3didin(30))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vr'
+    endif
+
+    ierr = nf90_inq_varid(nid, "radT", var3didin(31))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'radT'
+    endif
+
+    ierr = nf90_inq_varid(nid, "sens", var3didin(32))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'sens'
+    endif
+
+    ierr = nf90_inq_varid(nid, "flat", var3didin(33))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'flat'
+    endif
+
+    ierr = nf90_inq_varid(nid, "ts", var3didin(34))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'ts'
+    endif
+
+    ierr = nf90_inq_varid(nid, "ustar", var3didin(35))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'ustar'
+    endif
+
+    ierr = nf90_inq_varid(nid, "uw", var3didin(36))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'uw'
+    endif
+
+    ierr = nf90_inq_varid(nid, "vw", var3didin(37))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'vw'
+    endif
+
+    ierr = nf90_inq_varid(nid, "q1", var3didin(38))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'q1'
+    endif
+
+    ierr = nf90_inq_varid(nid, "q2", var3didin(39))
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop 'q2'
+    endif
+
+    ierr = nf90_get_var(nid, var3didin(1), zz)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture z ok',zz
+
+    ierr = nf90_get_var(nid, var3didin(2), pp)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture pp ok',pp
+
+    ierr = nf90_get_var(nid, var3didin(3), temp)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture T ok',temp
+
+    ierr = nf90_get_var(nid, var3didin(4), qv)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture qv ok',qv
+
+    ierr = nf90_get_var(nid, var3didin(5), rh)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture rh ok',rh
+
+    ierr = nf90_get_var(nid, var3didin(6), theta)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture theta ok',theta
+
+    ierr = nf90_get_var(nid, var3didin(7), rv)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture rv ok',rv
+
+    ierr = nf90_get_var(nid, var3didin(8), u)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture u ok',u
+
+    ierr = nf90_get_var(nid, var3didin(9), v)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture v ok',v
+
+    ierr = nf90_get_var(nid, var3didin(10), ug)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture ug ok',ug
+
+    ierr = nf90_get_var(nid, var3didin(11), vg)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture vg ok',vg
+
+    ierr = nf90_get_var(nid, var3didin(12), w)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture w ok',w
+
+    ierr = nf90_get_var(nid, var3didin(13), du)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture du ok',du
+
+    ierr = nf90_get_var(nid, var3didin(14), hu)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture hu ok',hu
+
+    ierr = nf90_get_var(nid, var3didin(15), vu)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture vu ok',vu
+
+    ierr = nf90_get_var(nid, var3didin(16), dv)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dv ok',dv
+
+    ierr = nf90_get_var(nid, var3didin(17), hv)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture hv ok',hv
+
+    ierr = nf90_get_var(nid, var3didin(18), vv)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture vv ok',vv
+
+    ierr = nf90_get_var(nid, var3didin(19), dt)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dt ok',dt
+
+    ierr = nf90_get_var(nid, var3didin(20), ht)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture ht ok',ht
+
+    ierr = nf90_get_var(nid, var3didin(21), vt)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture vt ok',vt
+
+    ierr = nf90_get_var(nid, var3didin(22), dq)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dq ok',dq
+
+    ierr = nf90_get_var(nid, var3didin(23), hq)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture hq ok',hq
+
+    ierr = nf90_get_var(nid, var3didin(24), vq)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture vq ok',vq
+
+    ierr = nf90_get_var(nid, var3didin(25), dth)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dth ok',dth
+
+    ierr = nf90_get_var(nid, var3didin(26), hth)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture hth ok',hth
+
+    ierr = nf90_get_var(nid, var3didin(27), vth)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture vth ok',vth
+
+    ierr = nf90_get_var(nid, var3didin(28), dr)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dr ok',dr
+
+    ierr = nf90_get_var(nid, var3didin(29), hr)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture hr ok',hr
+
+    ierr = nf90_get_var(nid, var3didin(30), vr)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture vr ok',vr
+
+    ierr = nf90_get_var(nid, var3didin(31), dtrad)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture dtrad ok',dtrad
+
+    ierr = nf90_get_var(nid, var3didin(32), sens)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture sens ok',sens
+
+    ierr = nf90_get_var(nid, var3didin(33), flat)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture flat ok',flat
+
+    ierr = nf90_get_var(nid, var3didin(34), ts)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !          WRITE(*,*)'lecture ts ok',ts
+
+    ierr = nf90_get_var(nid, var3didin(35), ustar)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !         WRITE(*,*)'lecture ustar ok',ustar
+
+    ierr = nf90_get_var(nid, var3didin(36), uw)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !         WRITE(*,*)'lecture uw ok',uw
+
+    ierr = nf90_get_var(nid, var3didin(37), vw)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !         WRITE(*,*)'lecture vw ok',vw
+
+    ierr = nf90_get_var(nid, var3didin(38), q1)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !         WRITE(*,*)'lecture q1 ok',q1
+
+    ierr = nf90_get_var(nid, var3didin(39), q2)
+    IF(ierr/=nf90_noerr) THEN
+      WRITE(*, *) nf90_strerror(ierr)
+      stop "getvarup"
+    endif
+    !         WRITE(*,*)'lecture q2 ok',q2
+
+  END SUBROUTINE  read_cas
+  !======================================================================
+  SUBROUTINE interp_case_time(day, day1, annee_ref                &
+          !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
+          , nt_cas, nlev_cas                                       &
+          , ts_cas, plev_cas, t_cas, q_cas, u_cas, v_cas               &
+          , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas           &
+          , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas   &
+          , dq_cas, hq_cas, vq_cas, lat_cas, sens_cas, ustar_cas       &
+          , uw_cas, vw_cas, q1_cas, q2_cas                           &
+          , ts_prof_cas, plev_prof_cas, t_prof_cas, q_prof_cas       &
+          , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas         &
+          , vitw_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas     &
+          , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas       &
+          , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas    &
+          , hq_prof_cas, vq_prof_cas, lat_prof_cas, sens_prof_cas    &
+          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas)
+
+    USE lmdz_compar1d
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
+    IMPLICIT NONE
+
+    !---------------------------------------------------------------------------------------
+    ! Time interpolation of a 2D field to the timestep corresponding to day
+
+    ! day: current julian day (e.g. 717538.2)
+    ! day1: first day of the simulation
+    ! nt_cas: total nb of data in the forcing
+    ! pdt_cas: total time interval (in sec) between 2 forcing data
+    !---------------------------------------------------------------------------------------
+
+    ! inputs:
+    INTEGER annee_ref
+    INTEGER nt_cas, nlev_cas
+    REAL day, day1, day_cas
+    REAL ts_cas(nt_cas)
+    REAL plev_cas(nlev_cas, nt_cas)
+    REAL t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas)
+    REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas)
+    REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas)
+    REAL vitw_cas(nlev_cas, nt_cas)
+    REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas)
+    REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas)
+    REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas)
+    REAL dtrad_cas(nlev_cas, nt_cas)
+    REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas)
+    REAL lat_cas(nt_cas)
+    REAL sens_cas(nt_cas)
+    REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas)
+    REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas)
+
+    ! outputs:
+    REAL plev_prof_cas(nlev_cas)
+    REAL t_prof_cas(nlev_cas), q_prof_cas(nlev_cas)
+    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
+    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas)
+    REAL vitw_prof_cas(nlev_cas)
+    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
+    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
+    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas)
+    REAL dtrad_prof_cas(nlev_cas)
+    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
+    REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas
+    REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas)
+    ! local:
+    INTEGER it_cas1, it_cas2, k
+    REAL timeit, time_cas1, time_cas2, frac
+
+    PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas
+
+    ! On teste si la date du cas AMMA est correcte.
+    ! C est pour memoire car en fait les fichiers .def
+    ! sont censes etre corrects.
+    ! A supprimer a terme (MPL 20150623)
+    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
+    ! Check that initial day of the simulation consistent with AMMA case:
+    !      if (annee_ref.NE.2006) THEN
+    !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
+    !       PRINT*,'Changer annee_ref dans run.def'
+    !       stop
+    !      endif
+    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
+    !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
+    !       PRINT*,'Changer dayref dans run.def'
+    !       stop
+    !      endif
+    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
+    !       PRINT*,'AMMA a fini le 11 juillet'
+    !       PRINT*,'Changer dayref ou nday dans run.def'
+    !       stop
+    !      endif
+    !      endif
+
+    ! Determine timestep relative to the 1st day:
+    !       timeit=(day-day1)*86400.
+    !       if (annee_ref.EQ.1992) THEN
+    !        timeit=(day-day_cas)*86400.
+    !       else
+    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+    !       endif
+    timeit = (day - day_ju_ini_cas) * 86400
+    print *, 'day=', day
+    print *, 'day_ju_ini_cas=', day_ju_ini_cas
+    print *, 'pdt_cas=', pdt_cas
+    print *, 'timeit=', timeit
+    print *, 'nt_cas=', nt_cas
+
+    ! Determine the closest observation times:
+    !       it_cas1=INT(timeit/pdt_cas)+1
+    !       it_cas2=it_cas1 + 1
+    !       time_cas1=(it_cas1-1)*pdt_cas
+    !       time_cas2=(it_cas2-1)*pdt_cas
+
+    it_cas1 = INT(timeit / pdt_cas) + 1
+    IF (it_cas1 == nt_cas) THEN
+      it_cas2 = it_cas1
+    ELSE
+      it_cas2 = it_cas1 + 1
+    ENDIF
+    time_cas1 = (it_cas1 - 1) * pdt_cas
+    time_cas2 = (it_cas2 - 1) * pdt_cas
+    print *, 'it_cas1=', it_cas1
+    print *, 'it_cas2=', it_cas2
+    print *, 'time_cas1=', time_cas1
+    print *, 'time_cas2=', time_cas2
+
+    IF (it_cas1 > nt_cas) THEN
+      WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+              , day, day_ju_ini_cas, it_cas1, it_cas2, timeit
+      stop
+    endif
+
+    ! time interpolation:
+    IF (it_cas1 == it_cas2) THEN
+      frac = 0.
+    ELSE
+      frac = (time_cas2 - timeit) / (time_cas2 - time_cas1)
+      frac = max(frac, 0.0)
+    ENDIF
+
+    lat_prof_cas = lat_cas(it_cas2)                                       &
+            - frac * (lat_cas(it_cas2) - lat_cas(it_cas1))
+    sens_prof_cas = sens_cas(it_cas2)                                     &
+            - frac * (sens_cas(it_cas2) - sens_cas(it_cas1))
+    ts_prof_cas = ts_cas(it_cas2)                                         &
+            - frac * (ts_cas(it_cas2) - ts_cas(it_cas1))
+    ustar_prof_cas = ustar_cas(it_cas2)                                   &
+            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
+
+    DO k = 1, nlev_cas
+      plev_prof_cas(k) = plev_cas(k, it_cas2)                               &
+              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
+      t_prof_cas(k) = t_cas(k, it_cas2)                               &
+              - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1))
+      q_prof_cas(k) = q_cas(k, it_cas2)                               &
+              - frac * (q_cas(k, it_cas2) - q_cas(k, it_cas1))
+      u_prof_cas(k) = u_cas(k, it_cas2)                               &
+              - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1))
+      v_prof_cas(k) = v_cas(k, it_cas2)                               &
+              - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1))
+      ug_prof_cas(k) = ug_cas(k, it_cas2)                               &
+              - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1))
+      vg_prof_cas(k) = vg_cas(k, it_cas2)                               &
+              - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1))
+      vitw_prof_cas(k) = vitw_cas(k, it_cas2)                               &
+              - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1))
+      du_prof_cas(k) = du_cas(k, it_cas2)                                   &
+              - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1))
+      hu_prof_cas(k) = hu_cas(k, it_cas2)                                   &
+              - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1))
+      vu_prof_cas(k) = vu_cas(k, it_cas2)                                   &
+              - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1))
+      dv_prof_cas(k) = dv_cas(k, it_cas2)                                   &
+              - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1))
+      hv_prof_cas(k) = hv_cas(k, it_cas2)                                   &
+              - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1))
+      vv_prof_cas(k) = vv_cas(k, it_cas2)                                   &
+              - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1))
+      dt_prof_cas(k) = dt_cas(k, it_cas2)                                   &
+              - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1))
+      ht_prof_cas(k) = ht_cas(k, it_cas2)                                   &
+              - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1))
+      vt_prof_cas(k) = vt_cas(k, it_cas2)                                   &
+              - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1))
+      dtrad_prof_cas(k) = dtrad_cas(k, it_cas2)                                   &
+              - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1))
+      dq_prof_cas(k) = dq_cas(k, it_cas2)                                   &
+              - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1))
+      hq_prof_cas(k) = hq_cas(k, it_cas2)                                   &
+              - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1))
+      vq_prof_cas(k) = vq_cas(k, it_cas2)                                   &
+              - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1))
+      uw_prof_cas(k) = uw_cas(k, it_cas2)                                   &
+              - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1))
+      vw_prof_cas(k) = vw_cas(k, it_cas2)                                   &
+              - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1))
+      q1_prof_cas(k) = q1_cas(k, it_cas2)                                   &
+              - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1))
+      q2_prof_cas(k) = q2_cas(k, it_cas2)                                   &
+              - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1))
+    enddo
+
+    RETURN
+  END
+
+  !**********************************************************************************************
 END MODULE mod_1D_cases_read
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90	(revision 5158)
@@ -1,78 +1,75 @@
-
 ! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $
 
 MODULE mod_1D_cases_read2
-  USE netcdf, ONLY: nf90_get_var,nf90_noerr,nf90_inq_varid,nf90_inquire_dimension,nf90_strerror,nf90_open,&
-          nf90_nowrite,nf90_inq_dimid
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_inq_varid, nf90_inquire_dimension, nf90_strerror, nf90_open, &
+          nf90_nowrite, nf90_inq_dimid
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   !Declarations specifiques au cas standard
   CHARACTER*80 :: fich_cas
-  ! Discr?tisation 
+  ! Discr?tisation
   INTEGER nlev_cas, nt_cas
 
 
   !profils environnementaux
-  REAL, ALLOCATABLE::  plev_cas(:,:),plevh_cas(:)
-  REAL, ALLOCATABLE::  ap_cas(:),bp_cas(:)
-
-  REAL, ALLOCATABLE::  z_cas(:,:),zh_cas(:)
-  REAL, ALLOCATABLE::  t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:)
-  REAL, ALLOCATABLE::  th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:)
-  REAL, ALLOCATABLE::  u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:)
+  REAL, ALLOCATABLE :: plev_cas(:, :), plevh_cas(:)
+  REAL, ALLOCATABLE :: ap_cas(:), bp_cas(:)
+
+  REAL, ALLOCATABLE :: z_cas(:, :), zh_cas(:)
+  REAL, ALLOCATABLE :: t_cas(:, :), q_cas(:, :), qv_cas(:, :), ql_cas(:, :), qi_cas(:, :), rh_cas(:, :)
+  REAL, ALLOCATABLE :: th_cas(:, :), thv_cas(:, :), thl_cas(:, :), rv_cas(:, :)
+  REAL, ALLOCATABLE :: u_cas(:, :), v_cas(:, :), vitw_cas(:, :), omega_cas(:, :)
 
   !forcing
-  REAL, ALLOCATABLE::  ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:)
-  REAL, ALLOCATABLE::  hth_cas(:,:),vth_cas(:,:),dth_cas(:,:)
-  REAL, ALLOCATABLE::  hq_cas(:,:),vq_cas(:,:),dq_cas(:,:)
-  REAL, ALLOCATABLE::  hr_cas(:,:),vr_cas(:,:),dr_cas(:,:)
-  REAL, ALLOCATABLE::  hu_cas(:,:),vu_cas(:,:),du_cas(:,:)
-  REAL, ALLOCATABLE::  hv_cas(:,:),vv_cas(:,:),dv_cas(:,:)
-  REAL, ALLOCATABLE::  ug_cas(:,:),vg_cas(:,:)
-  REAL, ALLOCATABLE::  lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:)
-  REAL, ALLOCATABLE::  uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:)
+  REAL, ALLOCATABLE :: ht_cas(:, :), vt_cas(:, :), dt_cas(:, :), dtrad_cas(:, :)
+  REAL, ALLOCATABLE :: hth_cas(:, :), vth_cas(:, :), dth_cas(:, :)
+  REAL, ALLOCATABLE :: hq_cas(:, :), vq_cas(:, :), dq_cas(:, :)
+  REAL, ALLOCATABLE :: hr_cas(:, :), vr_cas(:, :), dr_cas(:, :)
+  REAL, ALLOCATABLE :: hu_cas(:, :), vu_cas(:, :), du_cas(:, :)
+  REAL, ALLOCATABLE :: hv_cas(:, :), vv_cas(:, :), dv_cas(:, :)
+  REAL, ALLOCATABLE :: ug_cas(:, :), vg_cas(:, :)
+  REAL, ALLOCATABLE :: lat_cas(:), sens_cas(:), ts_cas(:), ps_cas(:), ustar_cas(:)
+  REAL, ALLOCATABLE :: uw_cas(:, :), vw_cas(:, :), q1_cas(:, :), q2_cas(:, :), tke_cas(:)
 
   !champs interpoles
-  REAL, ALLOCATABLE::  plev_prof_cas(:)
-  REAL, ALLOCATABLE::  t_prof_cas(:)
-  REAL, ALLOCATABLE::  theta_prof_cas(:)
-  REAL, ALLOCATABLE::  thl_prof_cas(:)
-  REAL, ALLOCATABLE::  thv_prof_cas(:)
-  REAL, ALLOCATABLE::  q_prof_cas(:)
-  REAL, ALLOCATABLE::  qv_prof_cas(:)
-  REAL, ALLOCATABLE::  ql_prof_cas(:)
-  REAL, ALLOCATABLE::  qi_prof_cas(:)
-  REAL, ALLOCATABLE::  rh_prof_cas(:)
-  REAL, ALLOCATABLE::  rv_prof_cas(:)
-  REAL, ALLOCATABLE::  u_prof_cas(:)
-  REAL, ALLOCATABLE::  v_prof_cas(:)
-  REAL, ALLOCATABLE::  vitw_prof_cas(:)
-  REAL, ALLOCATABLE::  omega_prof_cas(:)
-  REAL, ALLOCATABLE::  ug_prof_cas(:)
-  REAL, ALLOCATABLE::  vg_prof_cas(:)
-  REAL, ALLOCATABLE::  ht_prof_cas(:)
-  REAL, ALLOCATABLE::  hth_prof_cas(:)
-  REAL, ALLOCATABLE::  hq_prof_cas(:)
-  REAL, ALLOCATABLE::  vt_prof_cas(:)
-  REAL, ALLOCATABLE::  vth_prof_cas(:)
-  REAL, ALLOCATABLE::  vq_prof_cas(:)
-  REAL, ALLOCATABLE::  dt_prof_cas(:)
-  REAL, ALLOCATABLE::  dth_prof_cas(:)
-  REAL, ALLOCATABLE::  dtrad_prof_cas(:)
-  REAL, ALLOCATABLE::  dq_prof_cas(:)
-  REAL, ALLOCATABLE::  hu_prof_cas(:)
-  REAL, ALLOCATABLE::  hv_prof_cas(:)
-  REAL, ALLOCATABLE::  vu_prof_cas(:)
-  REAL, ALLOCATABLE::  vv_prof_cas(:)
-  REAL, ALLOCATABLE::  du_prof_cas(:)
-  REAL, ALLOCATABLE::  dv_prof_cas(:)
-  REAL, ALLOCATABLE::  uw_prof_cas(:)
-  REAL, ALLOCATABLE::  vw_prof_cas(:)
-  REAL, ALLOCATABLE::  q1_prof_cas(:)
-  REAL, ALLOCATABLE::  q2_prof_cas(:)
-
-
-  REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas
-  REAL o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas
-
+  REAL, ALLOCATABLE :: plev_prof_cas(:)
+  REAL, ALLOCATABLE :: t_prof_cas(:)
+  REAL, ALLOCATABLE :: theta_prof_cas(:)
+  REAL, ALLOCATABLE :: thl_prof_cas(:)
+  REAL, ALLOCATABLE :: thv_prof_cas(:)
+  REAL, ALLOCATABLE :: q_prof_cas(:)
+  REAL, ALLOCATABLE :: qv_prof_cas(:)
+  REAL, ALLOCATABLE :: ql_prof_cas(:)
+  REAL, ALLOCATABLE :: qi_prof_cas(:)
+  REAL, ALLOCATABLE :: rh_prof_cas(:)
+  REAL, ALLOCATABLE :: rv_prof_cas(:)
+  REAL, ALLOCATABLE :: u_prof_cas(:)
+  REAL, ALLOCATABLE :: v_prof_cas(:)
+  REAL, ALLOCATABLE :: vitw_prof_cas(:)
+  REAL, ALLOCATABLE :: omega_prof_cas(:)
+  REAL, ALLOCATABLE :: ug_prof_cas(:)
+  REAL, ALLOCATABLE :: vg_prof_cas(:)
+  REAL, ALLOCATABLE :: ht_prof_cas(:)
+  REAL, ALLOCATABLE :: hth_prof_cas(:)
+  REAL, ALLOCATABLE :: hq_prof_cas(:)
+  REAL, ALLOCATABLE :: vt_prof_cas(:)
+  REAL, ALLOCATABLE :: vth_prof_cas(:)
+  REAL, ALLOCATABLE :: vq_prof_cas(:)
+  REAL, ALLOCATABLE :: dt_prof_cas(:)
+  REAL, ALLOCATABLE :: dth_prof_cas(:)
+  REAL, ALLOCATABLE :: dtrad_prof_cas(:)
+  REAL, ALLOCATABLE :: dq_prof_cas(:)
+  REAL, ALLOCATABLE :: hu_prof_cas(:)
+  REAL, ALLOCATABLE :: hv_prof_cas(:)
+  REAL, ALLOCATABLE :: vu_prof_cas(:)
+  REAL, ALLOCATABLE :: vv_prof_cas(:)
+  REAL, ALLOCATABLE :: du_prof_cas(:)
+  REAL, ALLOCATABLE :: dv_prof_cas(:)
+  REAL, ALLOCATABLE :: uw_prof_cas(:)
+  REAL, ALLOCATABLE :: vw_prof_cas(:)
+  REAL, ALLOCATABLE :: q1_prof_cas(:)
+  REAL, ALLOCATABLE :: q2_prof_cas(:)
+
+  REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ps_prof_cas, ustar_prof_cas, tke_prof_cas
+  REAL o3_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, rugos_cas, sand_cas, clay_cas
 
 
@@ -82,68 +79,68 @@
     IMPLICIT NONE
 
-    INTEGER nid,rid,ierr
-    INTEGER ii,jj
-
-    fich_cas='setup/cas.nc'
-    PRINT*,'fich_cas ',fich_cas
-    ierr = nf90_open(fich_cas,nf90_nowrite,nid)
-    PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
+    INTEGER nid, rid, ierr
+    INTEGER ii, jj
+
+    fich_cas = 'setup/cas.nc'
+    PRINT*, 'fich_cas ', fich_cas
+    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
+    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
     IF (ierr/=nf90_noerr) THEN
-       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
-       WRITE(*,*) nf90_strerror(ierr)
-       stop ""
+      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
+      WRITE(*, *) nf90_strerror(ierr)
+      stop ""
     endif
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lat',rid)
+    ierr = nf90_inq_dimid(nid, 'lat', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension lat'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=ii)
-    PRINT*,'OK1 nid,rid,lat',nid,rid,ii
+      PRINT*, 'Oh probleme lecture dimension lat'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = ii)
+    PRINT*, 'OK1 nid,rid,lat', nid, rid, ii
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lon',rid)
+    ierr = nf90_inq_dimid(nid, 'lon', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension lon'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=jj)
-    PRINT*,'OK2 nid,rid,lat',nid,rid,jj
+      PRINT*, 'Oh probleme lecture dimension lon'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = jj)
+    PRINT*, 'OK2 nid,rid,lat', nid, rid, jj
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lev',rid)
+    ierr = nf90_inq_dimid(nid, 'lev', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension zz'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
-    PRINT*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas
+      PRINT*, 'Oh probleme lecture dimension zz'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
+    PRINT*, 'OK3 nid,rid,nlev_cas', nid, rid, nlev_cas
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'time',rid)
-    PRINT*,'nid,rid',nid,rid
-    nt_cas=0
+    ierr = nf90_inq_dimid(nid, 'time', rid)
+    PRINT*, 'nid,rid', nid, rid
+    nt_cas = 0
     IF (ierr/=nf90_noerr) THEN
-       stop 'probleme lecture dimension sens'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
-    PRINT*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      stop 'probleme lecture dimension sens'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
+    PRINT*, 'OK4 nid,rid,nt_cas', nid, rid, nt_cas
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !profils moyens:
-    allocate(plev_cas(nlev_cas,nt_cas))        
-    allocate(z_cas(nlev_cas,nt_cas))
-    allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
-    allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
-    allocate(u_cas(nlev_cas,nt_cas))
-    allocate(v_cas(nlev_cas,nt_cas))
+    allocate(plev_cas(nlev_cas, nt_cas))
+    allocate(z_cas(nlev_cas, nt_cas))
+    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
+    allocate(th_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
+    allocate(u_cas(nlev_cas, nt_cas))
+    allocate(v_cas(nlev_cas, nt_cas))
 
     !forcing
-    allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
-    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
-    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
-    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
-    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
-    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
-    allocate(vitw_cas(nlev_cas,nt_cas))
-    allocate(ug_cas(nlev_cas,nt_cas))
-    allocate(vg_cas(nlev_cas,nt_cas))
-    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas))
-    allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
+    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
+    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
+    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
+    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
+    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
+    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
+    allocate(vitw_cas(nlev_cas, nt_cas))
+    allocate(ug_cas(nlev_cas, nt_cas))
+    allocate(vg_cas(nlev_cas, nt_cas))
+    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas))
+    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
 
 
@@ -176,13 +173,12 @@
     allocate(q2_prof_cas(nlev_cas))
 
-    PRINT*,'Allocations OK'
-    CALL read_cas2(nid,nlev_cas,nt_cas                                       &
-         ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas         &
-         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas    &
-         ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas                 &
-         ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&
-         ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)
-    PRINT*,'Read cas OK'
-
+    PRINT*, 'Allocations OK'
+    CALL read_cas2(nid, nlev_cas, nt_cas                                       &
+            , z_cas, plev_cas, t_cas, q_cas, rh_cas, th_cas, rv_cas, u_cas, v_cas         &
+            , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas, dv_cas, hv_cas, vv_cas    &
+            , dt_cas, dtrad_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas                 &
+            , dth_cas, hth_cas, vth_cas, dr_cas, hr_cas, vr_cas, sens_cas, lat_cas, ts_cas&
+            , ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas)
+    PRINT*, 'Read cas OK'
 
   END SUBROUTINE read_1D_cas
@@ -191,67 +187,67 @@
     IMPLICIT NONE
 
-    INTEGER nid,rid,ierr
-    INTEGER ii,jj
-
-    fich_cas='setup/cas.nc'
-    PRINT*,'fich_cas ',fich_cas
-    ierr = nf90_open(fich_cas,nf90_nowrite,nid)
-    PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
+    INTEGER nid, rid, ierr
+    INTEGER ii, jj
+
+    fich_cas = 'setup/cas.nc'
+    PRINT*, 'fich_cas ', fich_cas
+    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
+    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
     IF (ierr/=nf90_noerr) THEN
-       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
-       WRITE(*,*) nf90_strerror(ierr)
-       stop ""
+      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
+      WRITE(*, *) nf90_strerror(ierr)
+      stop ""
     endif
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lat',rid)
+    ierr = nf90_inq_dimid(nid, 'lat', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension lat'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=ii)
-    PRINT*,'OK1 read2: nid,rid,lat',nid,rid,ii
+      PRINT*, 'Oh probleme lecture dimension lat'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = ii)
+    PRINT*, 'OK1 read2: nid,rid,lat', nid, rid, ii
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lon',rid)
+    ierr = nf90_inq_dimid(nid, 'lon', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension lon'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=jj)
-    PRINT*,'OK2 read2: nid,rid,lat',nid,rid,jj
+      PRINT*, 'Oh probleme lecture dimension lon'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = jj)
+    PRINT*, 'OK2 read2: nid,rid,lat', nid, rid, jj
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'nlev',rid)
+    ierr = nf90_inq_dimid(nid, 'nlev', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension nlev'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
-    PRINT*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
+      PRINT*, 'Oh probleme lecture dimension nlev'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
+    PRINT*, 'OK3 read2: nid,rid,nlev_cas', nid, rid, nlev_cas
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'time',rid)
-    nt_cas=0
+    ierr = nf90_inq_dimid(nid, 'time', rid)
+    nt_cas = 0
     IF (ierr/=nf90_noerr) THEN
-       stop 'Oh probleme lecture dimension time'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
-    PRINT*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      stop 'Oh probleme lecture dimension time'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
+    PRINT*, 'OK4 read2: nid,rid,nt_cas', nid, rid, nt_cas
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !profils moyens:
-    allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))        
-    allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
-    allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
-    allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
-         qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
-    allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
-    allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
+    allocate(plev_cas(nlev_cas, nt_cas), plevh_cas(nlev_cas + 1))
+    allocate(z_cas(nlev_cas, nt_cas), zh_cas(nlev_cas + 1))
+    allocate(ap_cas(nlev_cas + 1), bp_cas(nlev_cas + 1))
+    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), &
+            qi_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
+    allocate(th_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas), thv_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
+    allocate(u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas), vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas))
 
     !forcing
-    allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
-    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
-    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
-    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
-    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
-    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
-    allocate(ug_cas(nlev_cas,nt_cas))
-    allocate(vg_cas(nlev_cas,nt_cas))
-    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas))
-    allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
+    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
+    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
+    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
+    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
+    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
+    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
+    allocate(ug_cas(nlev_cas, nt_cas))
+    allocate(vg_cas(nlev_cas, nt_cas))
+    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas), tke_cas(nt_cas))
+    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
 
 
@@ -296,17 +292,16 @@
     allocate(q2_prof_cas(nlev_cas))
 
-    PRINT*,'Allocations OK'
-    CALL read2_cas (nid,nlev_cas,nt_cas,                                                                     &
-         ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
-         ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas,        &
-         dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
-         dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
-         uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
-         o3_cas,rugos_cas,clay_cas,sand_cas)
-    PRINT*,'Read2 cas OK'
-    do ii=1,nlev_cas
-       PRINT*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
+    PRINT*, 'Allocations OK'
+    CALL read2_cas (nid, nlev_cas, nt_cas, &
+            ap_cas, bp_cas, z_cas, plev_cas, zh_cas, plevh_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, &
+            ql_cas, qi_cas, rh_cas, rv_cas, u_cas, v_cas, vitw_cas, omega_cas, ug_cas, vg_cas, du_cas, hu_cas, vu_cas, &
+            dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, &
+            dr_cas, hr_cas, vr_cas, dtrad_cas, sens_cas, lat_cas, ts_cas, ps_cas, ustar_cas, tke_cas, &
+            uw_cas, vw_cas, q1_cas, q2_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, &
+            o3_cas, rugos_cas, clay_cas, sand_cas)
+    PRINT*, 'Read2 cas OK'
+    DO ii = 1, nlev_cas
+      PRINT*, 'apres read2_cas, plev_cas=', ii, plev_cas(ii, 1)
     enddo
-
 
   END SUBROUTINE read2_1D_cas
@@ -314,95 +309,95 @@
   !**********************************************************************************************
   SUBROUTINE old_read_SCM_cas
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
     IMPLICIT NONE
 
-    INCLUDE "date_cas.h"
-
-    INTEGER nid,rid,ierr
-    INTEGER ii,jj,timeid
+    INTEGER nid, rid, ierr
+    INTEGER ii, jj, timeid
     REAL, ALLOCATABLE :: time_val(:)
 
-    fich_cas='cas.nc'
-    PRINT*,'fich_cas ',fich_cas
-    ierr = nf90_open(fich_cas,nf90_nowrite,nid)
-    PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid
+    fich_cas = 'cas.nc'
+    PRINT*, 'fich_cas ', fich_cas
+    ierr = nf90_open(fich_cas, nf90_nowrite, nid)
+    PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid
     IF (ierr/=nf90_noerr) THEN
-       WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file '
-       WRITE(*,*) nf90_strerror(ierr)
-       stop ""
+      WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file '
+      WRITE(*, *) nf90_strerror(ierr)
+      stop ""
     endif
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lat',rid)
+    ierr = nf90_inq_dimid(nid, 'lat', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension lat'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=ii)
-    PRINT*,'OK1 read2: nid,rid,lat',nid,rid,ii
+      PRINT*, 'Oh probleme lecture dimension lat'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = ii)
+    PRINT*, 'OK1 read2: nid,rid,lat', nid, rid, ii
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lon',rid)
+    ierr = nf90_inq_dimid(nid, 'lon', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension lon'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=jj)
-    PRINT*,'OK2 read2: nid,rid,lat',nid,rid,jj
+      PRINT*, 'Oh probleme lecture dimension lon'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = jj)
+    PRINT*, 'OK2 read2: nid,rid,lat', nid, rid, jj
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'lev',rid)
+    ierr = nf90_inq_dimid(nid, 'lev', rid)
     IF (ierr/=nf90_noerr) THEN
-       PRINT*, 'Oh probleme lecture dimension nlev'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas)
-    PRINT*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas
-    IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 1000 )) THEN
-       PRINT*,'Valeur de nlev_cas peu probable'
-       STOP
+      PRINT*, 'Oh probleme lecture dimension nlev'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas)
+    PRINT*, 'OK3 read2: nid,rid,nlev_cas', nid, rid, nlev_cas
+    IF (.NOT. (nlev_cas > 10 .AND. nlev_cas < 1000)) THEN
+      PRINT*, 'Valeur de nlev_cas peu probable'
+      STOP
     ENDIF
     !.......................................................................
-    ierr=nf90_inq_dimid(nid,'time',rid)
-    nt_cas=0
+    ierr = nf90_inq_dimid(nid, 'time', rid)
+    nt_cas = 0
     IF (ierr/=nf90_noerr) THEN
-       stop 'Oh probleme lecture dimension time'
-    ENDIF
-    ierr=nf90_inquire_dimension(nid,rid,len=nt_cas)
-    PRINT*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas
+      stop 'Oh probleme lecture dimension time'
+    ENDIF
+    ierr = nf90_inquire_dimension(nid, rid, len = nt_cas)
+    PRINT*, 'OK4 read2: nid,rid,nt_cas', nid, rid, nt_cas
     ! Lecture de l'axe des temps
-    PRINT*,'LECTURE DU TEMPS'
-    ierr=nf90_inq_varid(nid,'time',timeid)
+    PRINT*, 'LECTURE DU TEMPS'
+    ierr = nf90_inq_varid(nid, 'time', timeid)
     IF(ierr/=nf90_noerr) THEN
-       print *,'Variable time manquante dans cas.nc:'
-       ierr=nf90_noerr
+      print *, 'Variable time manquante dans cas.nc:'
+      ierr = nf90_noerr
     else
-       allocate(time_val(nt_cas))
-       ierr = nf90_get_var(nid,timeid,time_val)
-       IF(ierr/=nf90_noerr) THEN
-          print *,'Pb a la lecture de time cas.nc: '
-       endif
+      allocate(time_val(nt_cas))
+      ierr = nf90_get_var(nid, timeid, time_val)
+      IF(ierr/=nf90_noerr) THEN
+        print *, 'Pb a la lecture de time cas.nc: '
+      endif
     endif
     IF (nt_cas>1) THEN
-       pdt_cas=time_val(2)-time_val(1)
+      pdt_cas = time_val(2) - time_val(1)
     ELSE
-       pdt_cas=0.
-    ENDIF
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      pdt_cas = 0.
+    ENDIF
+
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !profils moyens:
-    allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1))        
-    allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1))
-    allocate(ap_cas(nlev_cas+1),bp_cas(nlev_cas+1))
-    allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), &
-         qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
-    allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas))
-    allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas))
+    allocate(plev_cas(nlev_cas, nt_cas), plevh_cas(nlev_cas + 1))
+    allocate(z_cas(nlev_cas, nt_cas), zh_cas(nlev_cas + 1))
+    allocate(ap_cas(nlev_cas + 1), bp_cas(nlev_cas + 1))
+    allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), &
+            qi_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas))
+    allocate(th_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas), thv_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas))
+    allocate(u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas), vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas))
 
     !forcing
-    allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas))
-    allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas))
-    allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas))
-    allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas))
-    allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas))
-    allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas))
-    allocate(ug_cas(nlev_cas,nt_cas))
-    allocate(vg_cas(nlev_cas,nt_cas))
-    allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas))
-    allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas))
+    allocate(ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas), dt_cas(nlev_cas, nt_cas), dtrad_cas(nlev_cas, nt_cas))
+    allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas))
+    allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas))
+    allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas))
+    allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas))
+    allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas))
+    allocate(ug_cas(nlev_cas, nt_cas))
+    allocate(vg_cas(nlev_cas, nt_cas))
+    allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas), tke_cas(nt_cas))
+    allocate(uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas), q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas))
 
 
@@ -447,42 +442,41 @@
     allocate(q2_prof_cas(nlev_cas))
 
-    PRINT*,'Allocations OK'
-    CALL old_read_SCM (nid,nlev_cas,nt_cas,                                                                     &
-         ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,                    &
-         ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas,        &
-         dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,               &
-         dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas,                      &
-         uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, &
-         o3_cas,rugos_cas,clay_cas,sand_cas)
-    PRINT*,'Read2 cas OK'
-    do ii=1,nlev_cas
-       PRINT*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1)
+    PRINT*, 'Allocations OK'
+    CALL old_read_SCM (nid, nlev_cas, nt_cas, &
+            ap_cas, bp_cas, z_cas, plev_cas, zh_cas, plevh_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, &
+            ql_cas, qi_cas, rh_cas, rv_cas, u_cas, v_cas, vitw_cas, omega_cas, ug_cas, vg_cas, du_cas, hu_cas, vu_cas, &
+            dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, &
+            dr_cas, hr_cas, vr_cas, dtrad_cas, sens_cas, lat_cas, ts_cas, ps_cas, ustar_cas, tke_cas, &
+            uw_cas, vw_cas, q1_cas, q2_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, &
+            o3_cas, rugos_cas, clay_cas, sand_cas)
+    PRINT*, 'Read2 cas OK'
+    DO ii = 1, nlev_cas
+      PRINT*, 'apres read2_cas, plev_cas=', ii, plev_cas(ii, 1)
     enddo
 
-
   END SUBROUTINE old_read_SCM_cas
 
 
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   SUBROUTINE deallocate2_1D_cases
     !profils environnementaux:
-    deallocate(plev_cas,plevh_cas)
-
-    deallocate(z_cas,zh_cas)
-    deallocate(ap_cas,bp_cas)
-    deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas)
-    deallocate(th_cas,thl_cas,thv_cas,rv_cas)
-    deallocate(u_cas,v_cas,vitw_cas,omega_cas)
+    deallocate(plev_cas, plevh_cas)
+
+    deallocate(z_cas, zh_cas)
+    deallocate(ap_cas, bp_cas)
+    deallocate(t_cas, q_cas, qv_cas, ql_cas, qi_cas, rh_cas)
+    deallocate(th_cas, thl_cas, thv_cas, rv_cas)
+    deallocate(u_cas, v_cas, vitw_cas, omega_cas)
 
     !forcing
-    deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
-    deallocate(hq_cas,vq_cas,dq_cas)
-    deallocate(hth_cas,vth_cas,dth_cas)
-    deallocate(hr_cas,vr_cas,dr_cas)
-    deallocate(hu_cas,vu_cas,du_cas)
-    deallocate(hv_cas,vv_cas,dv_cas)
+    deallocate(ht_cas, vt_cas, dt_cas, dtrad_cas)
+    deallocate(hq_cas, vq_cas, dq_cas)
+    deallocate(hth_cas, vth_cas, dth_cas)
+    deallocate(hr_cas, vr_cas, dr_cas)
+    deallocate(hu_cas, vu_cas, du_cas)
+    deallocate(hv_cas, vv_cas, dv_cas)
     deallocate(ug_cas)
     deallocate(vg_cas)
-    deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas)
+    deallocate(lat_cas, sens_cas, ts_cas, ps_cas, ustar_cas, tke_cas, uw_cas, vw_cas, q1_cas, q2_cas)
 
     !champs interpoles
@@ -528,938 +522,924 @@
 
 
-!=====================================================================
-SUBROUTINE read_cas2(nid,nlevel,ntime                          &
-     ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
-     du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq,                     &
-     dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)
-
-  !program reading forcing of the case study
-  IMPLICIT NONE
-
-  INTEGER ntime,nlevel
-
-  REAL zz(nlevel,ntime)
-  REAL pp(nlevel,ntime)
-  REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime)
-  REAL theta(nlevel,ntime),rv(nlevel,ntime)
-  REAL u(nlevel,ntime)
-  REAL v(nlevel,ntime)
-  REAL ug(nlevel,ntime)
-  REAL vg(nlevel,ntime)
-  REAL w(nlevel,ntime)
-  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-  REAL dtrad(nlevel,ntime)
-  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime)
-  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-  REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime)
-  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime)
-
-
-  INTEGER nid, ierr, ierr1,ierr2,rid,i
-  INTEGER nbvar3d
-  parameter(nbvar3d=39)
-  INTEGER var3didin(nbvar3d)
-  CHARACTER*5 name_var(1:nbvar3d)
-  data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
-       'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&
-       'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/
-
-
-  do i=1,nbvar3d
-     print *,'Dans read_cas2, on va lire ',nid,i,name_var(i)
-  enddo
-  do i=1,nbvar3d
-     ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
-     print *,'ierr=',i,ierr,name_var(i),var3didin(i)
-     IF(ierr/=nf90_noerr) THEN
-        print *,'Variable manquante dans cas.nc:',name_var(i)
-     endif
-  enddo
-  do i=1,nbvar3d
-     print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
-     IF(i<=35) THEN
-        ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
-        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
+  !=====================================================================
+  SUBROUTINE read_cas2(nid, nlevel, ntime                          &
+          , zz, pp, temp, qv, rh, theta, rv, u, v, ug, vg, w, &
+          du, hu, vu, dv, hv, vv, dt, dtrad, ht, vt, dq, hq, vq, &
+          dth, hth, vth, dr, hr, vr, sens, flat, ts, ustar, uw, vw, q1, q2)
+
+    !program reading forcing of the case study
+    IMPLICIT NONE
+
+    INTEGER ntime, nlevel
+
+    REAL zz(nlevel, ntime)
+    REAL pp(nlevel, ntime)
+    REAL temp(nlevel, ntime), qv(nlevel, ntime), rh(nlevel, ntime)
+    REAL theta(nlevel, ntime), rv(nlevel, ntime)
+    REAL u(nlevel, ntime)
+    REAL v(nlevel, ntime)
+    REAL ug(nlevel, ntime)
+    REAL vg(nlevel, ntime)
+    REAL w(nlevel, ntime)
+    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
+    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
+    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
+    REAL dtrad(nlevel, ntime)
+    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
+    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime)
+    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
+    REAL flat(ntime), sens(ntime), ts(ntime), ustar(ntime)
+    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime), resul(nlevel, ntime), resul1(ntime)
+
+    INTEGER nid, ierr, ierr1, ierr2, rid, i
+    INTEGER nbvar3d
+    parameter(nbvar3d = 39)
+    INTEGER var3didin(nbvar3d)
+    CHARACTER*5 name_var(1:nbvar3d)
+    data name_var/'zz', 'pp', 'temp', 'qv', 'rh', 'theta', 'rv', 'u', 'v', 'ug', 'vg', 'w', 'advu', 'hu', 'vu', &
+            'advv', 'hv', 'vv', 'advT', 'hT', 'vT', 'advq', 'hq', 'vq', 'advth', 'hth', 'vth', 'advr', 'hr', 'vr', &
+            'radT', 'uw', 'vw', 'q1', 'q2', 'sens', 'flat', 'ts', 'ustar'/
+
+    DO i = 1, nbvar3d
+      print *, 'Dans read_cas2, on va lire ', nid, i, name_var(i)
+    enddo
+    DO i = 1, nbvar3d
+      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
+      print *, 'ierr=', i, ierr, name_var(i), var3didin(i)
+      IF(ierr/=nf90_noerr) THEN
+        print *, 'Variable manquante dans cas.nc:', name_var(i)
+      endif
+    enddo
+    DO i = 1, nbvar3d
+      print *, 'Dans read_cas2, on va lire ', var3didin(i), name_var(i)
+      IF(i<=35) THEN
+        ierr = nf90_get_var(nid, var3didin(i), resul, count = [1, 1, nlevel, ntime])
+        print *, 'Dans read_cas2, on a lu ', ierr, var3didin(i), name_var(i)
         IF(ierr/=nf90_noerr) THEN
-           print *,'Pb a la lecture de cas.nc: ',name_var(i)
-           stop "getvarup"
+          print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+          stop "getvarup"
         endif
-     else
-        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
-        ierr = nf90_get_var(nid,var3didin(i),resul1, count = [1, 1, ntime])
+      else
+        print *, 'Dans read_cas2, on a lu ', ierr, var3didin(i), name_var(i)
+        ierr = nf90_get_var(nid, var3didin(i), resul1, count = [1, 1, ntime])
         IF(ierr/=nf90_noerr) THEN
-           print *,'Pb a la lecture de cas.nc: ',name_var(i)
-           stop "getvarup"
+          print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+          stop "getvarup"
         endif
-     endif
-     select case(i)
-     case(1) ; zz=resul
-     case(2) ; pp=resul
-     case(3) ; temp=resul
-     case(4) ; qv=resul
-     case(5) ; rh=resul
-     case(6) ; theta=resul
-     case(7) ; rv=resul
-     case(8) ; u=resul
-     case(9) ; v=resul
-     case(10) ; ug=resul
-     case(11) ; vg=resul
-     case(12) ; w=resul
-     case(13) ; du=resul
-     case(14) ; hu=resul
-     case(15) ; vu=resul
-     case(16) ; dv=resul
-     case(17) ; hv=resul
-     case(18) ; vv=resul
-     case(19) ; dt=resul
-     case(20) ; ht=resul
-     case(21) ; vt=resul
-     case(22) ; dq=resul
-     case(23) ; hq=resul
-     case(24) ; vq=resul
-     case(25) ; dth=resul
-     case(26) ; hth=resul
-     case(27) ; vth=resul
-     case(28) ; dr=resul
-     case(29) ; hr=resul
-     case(30) ; vr=resul
-     case(31) ; dtrad=resul
-     case(32) ; uw=resul
-     case(33) ; vw=resul
-     case(34) ; q1=resul
-     case(35) ; q2=resul
-     case(36) ; sens=resul1
-     case(37) ; flat=resul1
-     case(38) ; ts=resul1
-     case(39) ; ustar=resul1
-     end select
-  enddo
-
-
-END SUBROUTINE  read_cas2
-!======================================================================
-SUBROUTINE read2_cas(nid,nlevel,ntime,                                       &
-     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
-     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
-     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
-     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
-     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
-
-  !program reading forcing of the case study
-  IMPLICIT NONE
-
-  INTEGER ntime,nlevel
-
-  REAL ap(nlevel+1),bp(nlevel+1)
-  REAL zz(nlevel,ntime),zzh(nlevel+1)
-  REAL pp(nlevel,ntime),pph(nlevel+1)
-  REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
-  REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
-  REAL u(nlevel,ntime),v(nlevel,ntime)
-  REAL ug(nlevel,ntime),vg(nlevel,ntime)
-  REAL vitw(nlevel,ntime),omega(nlevel,ntime)
-  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-  REAL dtrad(nlevel,ntime)
-  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
-  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-  REAL flat(ntime),sens(ntime),ustar(ntime)
-  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
-  REAL ts(ntime),ps(ntime),tke(ntime)
-  REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
-  REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
-
-
-  INTEGER nid, ierr,ierr1,ierr2,rid,i
-  INTEGER nbvar3d
-  parameter(nbvar3d=62)
-  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
-  CHARACTER*12 name_var(1:nbvar3d)
-  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
-       'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
-       'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &
-       'rh',&
-       'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&
-       'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&
-       'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
-  do i=1,nbvar3d
-     missing_var(i)=0.
-  enddo
-
-  !-----------------------------------------------------------------------
-  do i=1,nbvar3d
-     ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
-     IF(ierr/=nf90_noerr) THEN
-        print *,'Variable manquante dans cas.nc:',i,name_var(i)
-        ierr=nf90_noerr
-        missing_var(i)=1
-     else
+      endif
+      select case(i)
+      case(1) ; zz = resul
+      case(2) ; pp = resul
+      case(3) ; temp = resul
+      case(4) ; qv = resul
+      case(5) ; rh = resul
+      case(6) ; theta = resul
+      case(7) ; rv = resul
+      case(8) ; u = resul
+      case(9) ; v = resul
+      case(10) ; ug = resul
+      case(11) ; vg = resul
+      case(12) ; w = resul
+      case(13) ; du = resul
+      case(14) ; hu = resul
+      case(15) ; vu = resul
+      case(16) ; dv = resul
+      case(17) ; hv = resul
+      case(18) ; vv = resul
+      case(19) ; dt = resul
+      case(20) ; ht = resul
+      case(21) ; vt = resul
+      case(22) ; dq = resul
+      case(23) ; hq = resul
+      case(24) ; vq = resul
+      case(25) ; dth = resul
+      case(26) ; hth = resul
+      case(27) ; vth = resul
+      case(28) ; dr = resul
+      case(29) ; hr = resul
+      case(30) ; vr = resul
+      case(31) ; dtrad = resul
+      case(32) ; uw = resul
+      case(33) ; vw = resul
+      case(34) ; q1 = resul
+      case(35) ; q2 = resul
+      case(36) ; sens = resul1
+      case(37) ; flat = resul1
+      case(38) ; ts = resul1
+      case(39) ; ustar = resul1
+      end select
+    enddo
+
+  END SUBROUTINE  read_cas2
+  !======================================================================
+  SUBROUTINE read2_cas(nid, nlevel, ntime, &
+          ap, bp, zz, pp, zzh, pph, temp, theta, thv, thl, qv, ql, qi, rh, rv, u, v, vitw, omega, ug, vg, &
+          du, hu, vu, dv, hv, vv, dt, ht, vt, dq, hq, vq, &
+          dth, hth, vth, dr, hr, vr, dtrad, sens, flat, ts, ps, ustar, tke, uw, vw, q1, q2, &
+          orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, &
+          heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas)
+
+    !program reading forcing of the case study
+    IMPLICIT NONE
+
+    INTEGER ntime, nlevel
+
+    REAL ap(nlevel + 1), bp(nlevel + 1)
+    REAL zz(nlevel, ntime), zzh(nlevel + 1)
+    REAL pp(nlevel, ntime), pph(nlevel + 1)
+    REAL temp(nlevel, ntime), qv(nlevel, ntime), ql(nlevel, ntime), qi(nlevel, ntime), rh(nlevel, ntime)
+    REAL theta(nlevel, ntime), thv(nlevel, ntime), thl(nlevel, ntime), rv(nlevel, ntime)
+    REAL u(nlevel, ntime), v(nlevel, ntime)
+    REAL ug(nlevel, ntime), vg(nlevel, ntime)
+    REAL vitw(nlevel, ntime), omega(nlevel, ntime)
+    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
+    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
+    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
+    REAL dtrad(nlevel, ntime)
+    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
+    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime), hthl(nlevel, ntime)
+    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
+    REAL flat(ntime), sens(ntime), ustar(ntime)
+    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime)
+    REAL ts(ntime), ps(ntime), tke(ntime)
+    REAL orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas
+    REAL apbp(nlevel + 1), resul(nlevel, ntime), resul1(nlevel), resul2(ntime), resul3
+
+    INTEGER nid, ierr, ierr1, ierr2, rid, i
+    INTEGER nbvar3d
+    parameter(nbvar3d = 62)
+    INTEGER var3didin(nbvar3d), missing_var(nbvar3d)
+    CHARACTER*12 name_var(1:nbvar3d)
+    data name_var/'coor_par_a', 'coor_par_b', 'height_h', 'pressure_h', &
+            'w', 'omega', 'ug', 'vg', 'uadv', 'uadvh', 'uadvv', 'vadv', 'vadvh', 'vadvv', 'tadv', 'tadvh', 'tadvv', &
+            'qadv', 'qadvh', 'qadvv', 'thadv', 'thadvh', 'thadvv', 'thladvh', 'radv', 'radvh', 'radvv', 'radcool', 'q1', 'q2', 'ustress', 'vstress', &
+            'rh', &
+            'height_f', 'pressure_f', 'temp', 'theta', 'thv', 'thl', 'qv', 'ql', 'qi', 'rv', 'u', 'v', &
+            'sfc_sens_flx', 'sfc_lat_flx', 'ts', 'ps', 'ustar', 'tke', &
+            'orog', 'albedo', 'emiss', 't_skin', 'q_skin', 'mom_rough', 'heat_rough', 'o3', 'rugos', 'clay', 'sand'/
+    DO i = 1, nbvar3d
+      missing_var(i) = 0.
+    enddo
+
+    !-----------------------------------------------------------------------
+    DO i = 1, nbvar3d
+      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
+      IF(ierr/=nf90_noerr) THEN
+        print *, 'Variable manquante dans cas.nc:', i, name_var(i)
+        ierr = nf90_noerr
+        missing_var(i) = 1
+      else
         !-----------------------------------------------------------------------
         IF(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
-           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           !-----------------------------------------------------------------------
+          ierr = nf90_get_var(nid, var3didin(i), apbp, count = [1, 1, nlevel + 1])
+          print *, 'read2_cas(apbp), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          !-----------------------------------------------------------------------
         else IF(i>4.AND.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
-           print *,'read2_cas(resul), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           !-----------------------------------------------------------------------
+          ierr = nf90_get_var(nid, var3didin(i), resul, count = [1, 1, nlevel, ntime])
+          print *, 'read2_cas(resul), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          !-----------------------------------------------------------------------
         ELSE IF (i>45.AND.i<=51) then   ! Lecture des variables en (time,lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),resul2, count = [1, 1, ntime])
-           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           !-----------------------------------------------------------------------
+          ierr = nf90_get_var(nid, var3didin(i), resul2, count = [1, 1, ntime])
+          print *, 'read2_cas(resul2), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          !-----------------------------------------------------------------------
         else     ! Lecture des constantes (lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),resul3)
-           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
+          ierr = nf90_get_var(nid, var3didin(i), resul3)
+          print *, 'read2_cas(resul3), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
         endif
-     endif
-     !-----------------------------------------------------------------------
-     select case(i)
-     case(1) ; ap=apbp       ! donnees indexees en nlevel+1
-     case(2) ; bp=apbp
-     case(3) ; zzh=apbp
-     case(4) ; pph=apbp
-     case(5) ; vitw=resul    ! donnees indexees en nlevel,time
-     case(6) ; omega=resul
-     case(7) ; ug=resul
-     case(8) ; vg=resul
-     case(9) ; du=resul
-     case(10) ; hu=resul
-     case(11) ; vu=resul
-     case(12) ; dv=resul
-     case(13) ; hv=resul
-     case(14) ; vv=resul
-     case(15) ; dt=resul
-     case(16) ; ht=resul
-     case(17) ; vt=resul
-     case(18) ; dq=resul
-     case(19) ; hq=resul
-     case(20) ; vq=resul
-     case(21) ; dth=resul
-     case(22) ; hth=resul
-     case(23) ; vth=resul
-     case(24) ; hthl=resul
-     case(25) ; dr=resul
-     case(26) ; hr=resul
-     case(27) ; vr=resul
-     case(28) ; dtrad=resul
-     case(29) ; q1=resul
-     case(30) ; q2=resul
-     case(31) ; uw=resul
-     case(32) ; vw=resul
-     case(33) ; rh=resul
-     case(34) ; zz=resul      ! donnees en time,nlevel pour profil initial
-     case(35) ; pp=resul
-     case(36) ; temp=resul
-     case(37) ; theta=resul
-     case(38) ; thv=resul
-     case(39) ; thl=resul
-     case(40) ; qv=resul
-     case(41) ; ql=resul
-     case(42) ; qi=resul
-     case(43) ; rv=resul
-     case(44) ; u=resul
-     case(45) ; v=resul
-     case(46) ; sens=resul2   ! donnees indexees en time
-     case(47) ; flat=resul2
-     case(48) ; ts=resul2
-     case(49) ; ps=resul2
-     case(50) ; ustar=resul2
-     case(51) ; tke=resul2
-     case(52) ; orog_cas=resul3      ! constantes
-     case(53) ; albedo_cas=resul3
-     case(54) ; emiss_cas=resul3
-     case(55) ; t_skin_cas=resul3
-     case(56) ; q_skin_cas=resul3
-     case(57) ; mom_rough=resul3
-     case(58) ; heat_rough=resul3
-     case(59) ; o3_cas=resul3        
-     case(60) ; rugos_cas=resul3
-     case(61) ; clay_cas=resul3
-     case(62) ; sand_cas=resul3
-     end select
-     resul=0.
-     resul1=0.
-     resul2=0.
-     resul3=0.
-  enddo
-  !-----------------------------------------------------------------------
-
-
-
-END SUBROUTINE  read2_cas
-
-!======================================================================
-SUBROUTINE old_read_SCM(nid,nlevel,ntime,                                       &
-     ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,&
-     du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq,                                    &
-     dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2,       &
-     orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,          &
-     heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas)
-
-  !program reading forcing of the case study
-  IMPLICIT NONE
-
-  INTEGER ntime,nlevel,k,t
-
-  REAL ap(nlevel+1),bp(nlevel+1)
-  REAL zz(nlevel,ntime),zzh(nlevel+1)
-  REAL pp(nlevel,ntime),pph(nlevel+1)
-  !profils initiaux
-  REAL temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel)
-  REAL pp0(nlevel)
-  REAL temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime)
-  REAL theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime)
-  REAL u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime)
-  REAL ug(nlevel,ntime),vg(nlevel,ntime)
-  REAL vitw(nlevel,ntime),omega(nlevel,ntime)
-  REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime)
-  REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime)
-  REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime)
-  REAL dtrad(nlevel,ntime)
-  REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime)
-  REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime)
-  REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime)
-  REAL flat(ntime),sens(ntime),ustar(ntime)
-  REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime)
-  REAL ts(ntime),ps(ntime)
-  REAL orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas
-  REAL apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3
-
-
-  INTEGER nid, ierr,ierr1,ierr2,rid,i
-  INTEGER nbvar3d
-  parameter(nbvar3d=70)
-  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
-  CHARACTER*13 name_var(1:nbvar3d)
-  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
-       'temp','qv','ql','qi','u','v','tke','pressure',&
-       'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
-       'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress', &
-       'vstress','rh',&
-       'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&
-       'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&
-       'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/
-  do i=1,nbvar3d
-     missing_var(i)=0.
-  enddo
-
-  !-----------------------------------------------------------------------
-
-  PRINT*,'ON EST LA'
-  do i=1,nbvar3d
-     ierr=nf90_inq_varid(nid,name_var(i),var3didin(i))
-     IF(ierr/=nf90_noerr) THEN
-        print *,'Variable manquante dans cas.nc:',i,name_var(i)
-        ierr=nf90_noerr
-        missing_var(i)=1
-     else
+      endif
+      !-----------------------------------------------------------------------
+      select case(i)
+      case(1) ; ap = apbp       ! donnees indexees en nlevel+1
+      case(2) ; bp = apbp
+      case(3) ; zzh = apbp
+      case(4) ; pph = apbp
+      case(5) ; vitw = resul    ! donnees indexees en nlevel,time
+      case(6) ; omega = resul
+      case(7) ; ug = resul
+      case(8) ; vg = resul
+      case(9) ; du = resul
+      case(10) ; hu = resul
+      case(11) ; vu = resul
+      case(12) ; dv = resul
+      case(13) ; hv = resul
+      case(14) ; vv = resul
+      case(15) ; dt = resul
+      case(16) ; ht = resul
+      case(17) ; vt = resul
+      case(18) ; dq = resul
+      case(19) ; hq = resul
+      case(20) ; vq = resul
+      case(21) ; dth = resul
+      case(22) ; hth = resul
+      case(23) ; vth = resul
+      case(24) ; hthl = resul
+      case(25) ; dr = resul
+      case(26) ; hr = resul
+      case(27) ; vr = resul
+      case(28) ; dtrad = resul
+      case(29) ; q1 = resul
+      case(30) ; q2 = resul
+      case(31) ; uw = resul
+      case(32) ; vw = resul
+      case(33) ; rh = resul
+      case(34) ; zz = resul      ! donnees en time,nlevel pour profil initial
+      case(35) ; pp = resul
+      case(36) ; temp = resul
+      case(37) ; theta = resul
+      case(38) ; thv = resul
+      case(39) ; thl = resul
+      case(40) ; qv = resul
+      case(41) ; ql = resul
+      case(42) ; qi = resul
+      case(43) ; rv = resul
+      case(44) ; u = resul
+      case(45) ; v = resul
+      case(46) ; sens = resul2   ! donnees indexees en time
+      case(47) ; flat = resul2
+      case(48) ; ts = resul2
+      case(49) ; ps = resul2
+      case(50) ; ustar = resul2
+      case(51) ; tke = resul2
+      case(52) ; orog_cas = resul3      ! constantes
+      case(53) ; albedo_cas = resul3
+      case(54) ; emiss_cas = resul3
+      case(55) ; t_skin_cas = resul3
+      case(56) ; q_skin_cas = resul3
+      case(57) ; mom_rough = resul3
+      case(58) ; heat_rough = resul3
+      case(59) ; o3_cas = resul3
+      case(60) ; rugos_cas = resul3
+      case(61) ; clay_cas = resul3
+      case(62) ; sand_cas = resul3
+      end select
+      resul = 0.
+      resul1 = 0.
+      resul2 = 0.
+      resul3 = 0.
+    enddo
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE  read2_cas
+
+  !======================================================================
+  SUBROUTINE old_read_SCM(nid, nlevel, ntime, &
+          ap, bp, zz, pp, zzh, pph, temp, theta, thv, thl, qv, ql, qi, rh, rv, u, v, vitw, omega, ug, vg, &
+          du, hu, vu, dv, hv, vv, dt, ht, vt, dq, hq, vq, &
+          dth, hth, vth, dr, hr, vr, dtrad, sens, flat, ts, ps, ustar, tke, uw, vw, q1, q2, &
+          orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, &
+          heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas)
+
+    !program reading forcing of the case study
+    IMPLICIT NONE
+
+    INTEGER ntime, nlevel, k, t
+
+    REAL ap(nlevel + 1), bp(nlevel + 1)
+    REAL zz(nlevel, ntime), zzh(nlevel + 1)
+    REAL pp(nlevel, ntime), pph(nlevel + 1)
+    !profils initiaux
+    REAL temp0(nlevel), qv0(nlevel), ql0(nlevel), qi0(nlevel), u0(nlevel), v0(nlevel), tke0(nlevel)
+    REAL pp0(nlevel)
+    REAL temp(nlevel, ntime), qv(nlevel, ntime), ql(nlevel, ntime), qi(nlevel, ntime), rh(nlevel, ntime)
+    REAL theta(nlevel, ntime), thv(nlevel, ntime), thl(nlevel, ntime), rv(nlevel, ntime)
+    REAL u(nlevel, ntime), v(nlevel, ntime), tke(nlevel, ntime)
+    REAL ug(nlevel, ntime), vg(nlevel, ntime)
+    REAL vitw(nlevel, ntime), omega(nlevel, ntime)
+    REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime)
+    REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime)
+    REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime)
+    REAL dtrad(nlevel, ntime)
+    REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime)
+    REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime), hthl(nlevel, ntime)
+    REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime)
+    REAL flat(ntime), sens(ntime), ustar(ntime)
+    REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime)
+    REAL ts(ntime), ps(ntime)
+    REAL orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas
+    REAL apbp(nlevel + 1), resul(nlevel, ntime), resul1(nlevel), resul2(ntime), resul3
+
+    INTEGER nid, ierr, ierr1, ierr2, rid, i
+    INTEGER nbvar3d
+    parameter(nbvar3d = 70)
+    INTEGER var3didin(nbvar3d), missing_var(nbvar3d)
+    CHARACTER*13 name_var(1:nbvar3d)
+    data name_var/'coor_par_a', 'coor_par_b', 'height_h', 'pressure_h', &
+            'temp', 'qv', 'ql', 'qi', 'u', 'v', 'tke', 'pressure', &
+            'w', 'omega', 'ug', 'vg', 'uadv', 'uadvh', 'uadvv', 'vadv', 'vadvh', 'vadvv', 'tadv', 'tadvh', 'tadvv', &
+            'qvadv', 'qvadvh', 'qvadvv', 'thadv', 'thadvh', 'thadvv', 'thladvh', 'radv', 'radvh', 'radvv', 'radcool', 'q1', 'q2', 'ustress', &
+            'vstress', 'rh', &
+            'height_f', 'pressure_forc', 'tempt', 'theta', 'thv', 'thl', 'qvt', 'qlt', 'qit', 'rv', 'ut', 'vt', 'tket', &
+            'sfc_sens_flx', 'sfc_lat_flx', 'ts', 'ps', 'ustar', &
+            'orog', 'albedo', 'emiss', 't_skin', 'q_skin', 'mom_rough', 'heat_rough', 'o3', 'rugos', 'clay', 'sand'/
+    DO i = 1, nbvar3d
+      missing_var(i) = 0.
+    enddo
+
+    !-----------------------------------------------------------------------
+
+    PRINT*, 'ON EST LA'
+    DO i = 1, nbvar3d
+      ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
+      IF(ierr/=nf90_noerr) THEN
+        print *, 'Variable manquante dans cas.nc:', i, name_var(i)
+        ierr = nf90_noerr
+        missing_var(i) = 1
+      else
         !-----------------------------------------------------------------------
         IF(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),apbp)
-           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           !-----------------------------------------------------------------------
+          ierr = nf90_get_var(nid, var3didin(i), apbp)
+          print *, 'read2_cas(apbp), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          !-----------------------------------------------------------------------
         else IF(i>4.AND.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),resul1)
-           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
-           !-----------------------------------------------------------------------
+          ierr = nf90_get_var(nid, var3didin(i), resul1)
+          print *, 'read2_cas(resul1), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul1), maxval(resul1)
+          !-----------------------------------------------------------------------
         else IF(i>12.AND.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),resul)
-           print *,'read2_cas(resul), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           PRINT*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
-           !-----------------------------------------------------------------------
+          ierr = nf90_get_var(nid, var3didin(i), resul)
+          print *, 'read2_cas(resul), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul), maxval(resul)
+          !-----------------------------------------------------------------------
         ELSE IF (i>54.AND.i<=65) then   ! Lecture des variables en (time,lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),resul2)
-           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           PRINT*,'Lecture de la variable #i  ',i,name_var(i),minval(resul2),maxval(resul2)
-           !-----------------------------------------------------------------------
+          ierr = nf90_get_var(nid, var3didin(i), resul2)
+          print *, 'read2_cas(resul2), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          PRINT*, 'Lecture de la variable #i  ', i, name_var(i), minval(resul2), maxval(resul2)
+          !-----------------------------------------------------------------------
         else     ! Lecture des constantes (lat,lon)
-           ierr = nf90_get_var(nid,var3didin(i),resul3)
-           print *,'read2_cas(resul3), on a lu ',i,name_var(i)
-           IF(ierr/=nf90_noerr) THEN
-              print *,'Pb a la lecture de cas.nc: ',name_var(i)
-              stop "getvarup"
-           endif
-           PRINT*,'Lecture de la variable #i ',i,name_var(i),resul3
+          ierr = nf90_get_var(nid, var3didin(i), resul3)
+          print *, 'read2_cas(resul3), on a lu ', i, name_var(i)
+          IF(ierr/=nf90_noerr) THEN
+            print *, 'Pb a la lecture de cas.nc: ', name_var(i)
+            stop "getvarup"
+          endif
+          PRINT*, 'Lecture de la variable #i ', i, name_var(i), resul3
         endif
-     endif
-     !-----------------------------------------------------------------------
-     select case(i)
+      endif
+      !-----------------------------------------------------------------------
+      select case(i)
         !case(1) ; ap=apbp       ! donnees indexees en nlevel+1
         ! case(2) ; bp=apbp
-     case(3) ; zzh=apbp
-     case(4) ; pph=apbp
-     case(5) ; temp0=resul1    ! donnees initiales
-     case(6) ; qv0=resul1
-     case(7) ; ql0=resul1
-     case(8) ; qi0=resul1
-     case(9) ; u0=resul1
-     case(10) ; v0=resul1
-     case(11) ; tke0=resul1
-     case(12) ; pp0=resul1
-     case(13) ; vitw=resul    ! donnees indexees en nlevel,time
-     case(14) ; omega=resul
-     case(15) ; ug=resul
-     case(16) ; vg=resul
-     case(17) ; du=resul
-     case(18) ; hu=resul
-     case(19) ; vu=resul
-     case(20) ; dv=resul
-     case(21) ; hv=resul
-     case(22) ; vv=resul
-     case(23) ; dt=resul
-     case(24) ; ht=resul
-     case(25) ; vt=resul
-     case(26) ; dq=resul
-     case(27) ; hq=resul
-     case(28) ; vq=resul
-     case(29) ; dth=resul
-     case(30) ; hth=resul
-     case(31) ; vth=resul
-     case(32) ; hthl=resul
-     case(33) ; dr=resul
-     case(34) ; hr=resul
-     case(35) ; vr=resul
-     case(36) ; dtrad=resul
-     case(37) ; q1=resul
-     case(38) ; q2=resul
-     case(39) ; uw=resul
-     case(40) ; vw=resul
-     case(41) ; rh=resul
-     case(42) ; zz=resul      ! donnees en time,nlevel pour profil initial
-     case(43) ; pp=resul
-     case(44) ; temp=resul
-     case(45) ; theta=resul
-     case(46) ; thv=resul
-     case(47) ; thl=resul
-     case(48) ; qv=resul
-     case(49) ; ql=resul
-     case(50) ; qi=resul
-     case(51) ; rv=resul
-     case(52) ; u=resul
-     case(53) ; v=resul
-     case(54) ; tke=resul
-     case(55) ; sens=resul2   ! donnees indexees en time
-     case(56) ; flat=resul2
-     case(57) ; ts=resul2
-     case(58) ; ps=resul2
-     case(59) ; ustar=resul2
-     case(60) ; orog_cas=resul3      ! constantes
-     case(61) ; albedo_cas=resul3
-     case(62) ; emiss_cas=resul3
-     case(63) ; t_skin_cas=resul3
-     case(64) ; q_skin_cas=resul3
-     case(65) ; mom_rough=resul3
-     case(66) ; heat_rough=resul3
-     case(67) ; o3_cas=resul3        
-     case(68) ; rugos_cas=resul3
-     case(69) ; clay_cas=resul3
-     case(70) ; sand_cas=resul3
-     end select
-     resul=0.
-     resul1=0.
-     resul2=0.
-     resul3=0.
-  enddo
-  PRINT*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens)
-  PRINT*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat)
-
-  !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
-  do t=1,ntime
-     do k=1,nlevel
-        temp(k,t)=temp0(k)
-        qv(k,t)=qv0(k)
-        ql(k,t)=ql0(k)
-        qi(k,t)=qi0(k)
-        u(k,t)=u0(k)
-        v(k,t)=v0(k)
-        tke(k,t)=tke0(k)
-     enddo
-  enddo
-  !-----------------------------------------------------------------------
-
-
-END SUBROUTINE  old_read_SCM
-!======================================================================
-
-!======================================================================
-SUBROUTINE interp_case_time2(day,day1,annee_ref                &
-     !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
-     ,nt_cas,nlev_cas                                       &
-     ,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
-     ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
-     ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas   &
-     ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas       &
-     ,uw_cas,vw_cas,q1_cas,q2_cas                           &
-     ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas       &
-     ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas         &
-     ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
-     ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas       &
-     ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas    &
-     ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
-     ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
-
-
-  IMPLICIT NONE
-
-  !---------------------------------------------------------------------------------------
-  ! Time interpolation of a 2D field to the timestep corresponding to day
-
-  ! day: current julian day (e.g. 717538.2)
-  ! day1: first day of the simulation
-  ! nt_cas: total nb of data in the forcing 
-  ! pdt_cas: total time interval (in sec) between 2 forcing data
-  !---------------------------------------------------------------------------------------
-
-  INCLUDE "compar1d.h"
-  INCLUDE "date_cas.h"
-
-  ! inputs:
-  INTEGER annee_ref
-  INTEGER nt_cas,nlev_cas
-  REAL day, day1,day_cas
-  REAL ts_cas(nt_cas),ps_cas(nt_cas)
-  REAL plev_cas(nlev_cas,nt_cas)
-  REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas)
-  REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
-  REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
-  REAL vitw_cas(nlev_cas,nt_cas)
-  REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
-  REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
-  REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
-  REAL dtrad_cas(nlev_cas,nt_cas)
-  REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-  REAL lat_cas(nt_cas)
-  REAL sens_cas(nt_cas)
-  REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
-  REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
-
-  ! outputs:
-  REAL plev_prof_cas(nlev_cas)
-  REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
-  REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-  REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
-  REAL vitw_prof_cas(nlev_cas)
-  REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-  REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-  REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
-  REAL dtrad_prof_cas(nlev_cas)
-  REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-  REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
-  REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
-  ! local:
-  INTEGER it_cas1, it_cas2,k
-  REAL timeit,time_cas1,time_cas2,frac
-
-
-  PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
-
-  ! On teste si la date du cas AMMA est correcte.
-  ! C est pour memoire car en fait les fichiers .def
-  ! sont censes etre corrects.
-  ! A supprimer a terme (MPL 20150623)
-  !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
-  ! Check that initial day of the simulation consistent with AMMA case:
-  !      if (annee_ref.NE.2006) THEN
-  !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
-  !       PRINT*,'Changer annee_ref dans run.def'
-  !       stop
-  !      endif
-  !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
-  !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
-  !       PRINT*,'Changer dayref dans run.def'
-  !       stop
-  !      endif
-  !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
-  !       PRINT*,'AMMA a fini le 11 juillet'
-  !       PRINT*,'Changer dayref ou nday dans run.def'
-  !       stop
-  !      endif
-  !      endif
-
-  ! Determine timestep relative to the 1st day:
-  !       timeit=(day-day1)*86400.
-  !       if (annee_ref.EQ.1992) THEN
-  !        timeit=(day-day_cas)*86400.
-  !       else
-  !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
-  !       endif
-  timeit=(day-day_ju_ini_cas)*86400
-  !print *,'day=',day
-  !print *,'day_ju_ini_cas=',day_ju_ini_cas
-  !print *,'pdt_cas=',pdt_cas
-  !print *,'timeit=',timeit
-  !print *,'nt_cas=',nt_cas
-
-  ! Determine the closest observation times:
-  !       it_cas1=INT(timeit/pdt_cas)+1
-  !       it_cas2=it_cas1 + 1
-  !       time_cas1=(it_cas1-1)*pdt_cas
-  !       time_cas2=(it_cas2-1)*pdt_cas
-
-  it_cas1=INT(timeit/pdt_cas)+1
-  IF (it_cas1 == nt_cas) THEN
-     it_cas2=it_cas1 
-  ELSE
-     it_cas2=it_cas1 + 1
-  ENDIF
-  time_cas1=(it_cas1-1)*pdt_cas
-  time_cas2=(it_cas2-1)*pdt_cas
-  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
-
-  IF (it_cas1 > nt_cas) THEN
-     WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
-          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
-     stop
-  ENDIF
-
-  ! time interpolation:
-  IF (it_cas1 == it_cas2) THEN
-     frac=0.
-  ELSE
-     frac=(time_cas2-timeit)/(time_cas2-time_cas1)
-     frac=max(frac,0.0)
-  ENDIF
-
-  lat_prof_cas = lat_cas(it_cas2)                                       &
-       -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 
-  sens_prof_cas = sens_cas(it_cas2)                                     &
-       -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
-  ts_prof_cas = ts_cas(it_cas2)                                         &
-       -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
-  ustar_prof_cas = ustar_cas(it_cas2)                                   &
-       -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
-
-  do k=1,nlev_cas
-     plev_prof_cas(k) = plev_cas(k,it_cas2)                               &
-          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
-     t_prof_cas(k) = t_cas(k,it_cas2)                               &
-          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
-     q_prof_cas(k) = q_cas(k,it_cas2)                               &
-          -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))
-     u_prof_cas(k) = u_cas(k,it_cas2)                               &
-          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
-     v_prof_cas(k) = v_cas(k,it_cas2)                               &
-          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
-     ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
-          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
-     vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
-          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
-     vitw_prof_cas(k) = vitw_cas(k,it_cas2)                               &
-          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
-     du_prof_cas(k) = du_cas(k,it_cas2)                                   &
-          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
-     hu_prof_cas(k) = hu_cas(k,it_cas2)                                   &
-          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
-     vu_prof_cas(k) = vu_cas(k,it_cas2)                                   &
-          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
-     dv_prof_cas(k) = dv_cas(k,it_cas2)                                   &
-          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
-     hv_prof_cas(k) = hv_cas(k,it_cas2)                                   &
-          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
-     vv_prof_cas(k) = vv_cas(k,it_cas2)                                   &
-          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
-     dt_prof_cas(k) = dt_cas(k,it_cas2)                                   &
-          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
-     ht_prof_cas(k) = ht_cas(k,it_cas2)                                   &
-          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
-     vt_prof_cas(k) = vt_cas(k,it_cas2)                                   &
-          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
-     dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                                   &
-          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
-     dq_prof_cas(k) = dq_cas(k,it_cas2)                                   &
-          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
-     hq_prof_cas(k) = hq_cas(k,it_cas2)                                   &
-          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
-     vq_prof_cas(k) = vq_cas(k,it_cas2)                                   &
-          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
-     uw_prof_cas(k) = uw_cas(k,it_cas2)                                   &
-          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
-     vw_prof_cas(k) = vw_cas(k,it_cas2)                                   &
-          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
-     q1_prof_cas(k) = q1_cas(k,it_cas2)                                   &
-          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
-     q2_prof_cas(k) = q2_cas(k,it_cas2)                                   &
-          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
-  enddo
-
-
-END SUBROUTINE interp_case_time2
-
-!**********************************************************************************************
-SUBROUTINE interp2_case_time(day,day1,annee_ref                           &
-     !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
-     ,nt_cas,nlev_cas                                                   &
-     ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas            &
-     ,qv_cas,ql_cas,qi_cas,u_cas,v_cas                                  &
-     ,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
-     ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas               &
-     ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas                      &
-     ,lat_cas,sens_cas,ustar_cas                                        &
-     ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                               &
-
-     ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas               &
-     ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas     &
-     ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas                     &
-     ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas  &
-     ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas                   &
-     ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas                &
-     ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas    &
-     ,lat_prof_cas,sens_prof_cas                                        &
-     ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
-
-
-  IMPLICIT NONE
-
-  !---------------------------------------------------------------------------------------
-  ! Time interpolation of a 2D field to the timestep corresponding to day
-
-  ! day: current julian day (e.g. 717538.2)
-  ! day1: first day of the simulation
-  ! nt_cas: total nb of data in the forcing 
-  ! pdt_cas: total time interval (in sec) between 2 forcing data
-  !---------------------------------------------------------------------------------------
-
-  INCLUDE "compar1d.h"
-  INCLUDE "date_cas.h"
-
-  ! inputs:
-  INTEGER annee_ref
-  INTEGER nt_cas,nlev_cas
-  REAL day, day1,day_cas
-  REAL ts_cas(nt_cas),ps_cas(nt_cas)
-  REAL plev_cas(nlev_cas,nt_cas)
-  REAL t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas)
-  REAL qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas)
-  REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas)
-  REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)
-  REAL vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)
-  REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas)
-  REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas)
-  REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas)
-  REAL dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas)
-  REAL dtrad_cas(nlev_cas,nt_cas)
-  REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas)
-  REAL lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas)
-  REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas)
-  REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)
-
-  ! outputs:
-  REAL plev_prof_cas(nlev_cas)
-  REAL t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas)
-  REAL qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
-  REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
-  REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas)
-  REAL vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
-  REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
-  REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
-  REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas)
-  REAL dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
-  REAL dtrad_prof_cas(nlev_cas)
-  REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
-  REAL lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas
-  REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas)
-  ! local:
-  INTEGER it_cas1, it_cas2,k
-  REAL timeit,time_cas1,time_cas2,frac
-
-
-  PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas
-  !       do k=1,nlev_cas
-  !       PRINT*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
-  !       enddo
-
-  ! On teste si la date du cas AMMA est correcte.
-  ! C est pour memoire car en fait les fichiers .def
-  ! sont censes etre corrects.
-  ! A supprimer a terme (MPL 20150623)
-  !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
-  ! Check that initial day of the simulation consistent with AMMA case:
-  !      if (annee_ref.NE.2006) THEN
-  !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
-  !       PRINT*,'Changer annee_ref dans run.def'
-  !       stop
-  !      endif
-  !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
-  !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
-  !       PRINT*,'Changer dayref dans run.def'
-  !       stop
-  !      endif
-  !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
-  !       PRINT*,'AMMA a fini le 11 juillet'
-  !       PRINT*,'Changer dayref ou nday dans run.def'
-  !       stop
-  !      endif
-  !      endif
-
-  ! Determine timestep relative to the 1st day:
-  !       timeit=(day-day1)*86400.
-  !       if (annee_ref.EQ.1992) THEN
-  !        timeit=(day-day_cas)*86400.
-  !       else
-  !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
-  !       endif
-  timeit=(day-day_ju_ini_cas)*86400
-  !print *,'day=',day
-  !print *,'day_ju_ini_cas=',day_ju_ini_cas
-  !print *,'pdt_cas=',pdt_cas
-  !print *,'timeit=',timeit
-  !print *,'nt_cas=',nt_cas
-
-  ! Determine the closest observation times:
-  !       it_cas1=INT(timeit/pdt_cas)+1
-  !       it_cas2=it_cas1 + 1
-  !       time_cas1=(it_cas1-1)*pdt_cas
-  !       time_cas2=(it_cas2-1)*pdt_cas
-
-  it_cas1=INT(timeit/pdt_cas)+1
-  IF (it_cas1 == nt_cas) THEN
-     it_cas2=it_cas1 
-  ELSE
-     it_cas2=it_cas1 + 1
-  ENDIF
-  time_cas1=(it_cas1-1)*pdt_cas
-  time_cas2=(it_cas2-1)*pdt_cas
-  !print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
-  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
-
-  IF (it_cas1 > nt_cas) THEN
-     WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
-          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
-     stop
-  ENDIF
-
-  ! time interpolation:
-  IF (it_cas1 == it_cas2) THEN
-     frac=0.
-  ELSE
-     frac=(time_cas2-timeit)/(time_cas2-time_cas1)
-     frac=max(frac,0.0)
-  ENDIF
-
-  lat_prof_cas = lat_cas(it_cas2)                                   &
-       -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 
-  sens_prof_cas = sens_cas(it_cas2)                                 &
-       -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
-  tke_prof_cas = tke_cas(it_cas2)                                   &
-       -frac*(tke_cas(it_cas2)-tke_cas(it_cas1))
-  ts_prof_cas = ts_cas(it_cas2)                                     &
-       -frac*(ts_cas(it_cas2)-ts_cas(it_cas1))
-  ustar_prof_cas = ustar_cas(it_cas2)                               &
-       -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))
-
-  do k=1,nlev_cas
-     plev_prof_cas(k) = plev_cas(k,it_cas2)                           &     
-          -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))
-     t_prof_cas(k) = t_cas(k,it_cas2)                                 &        
-          -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))
-     !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
-     theta_prof_cas(k) = theta_cas(k,it_cas2)                         &                      
-          -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1))
-     thv_prof_cas(k) = thv_cas(k,it_cas2)                             &          
-          -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1))
-     thl_prof_cas(k) = thl_cas(k,it_cas2)                             &              
-          -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1))
-     qv_prof_cas(k) = qv_cas(k,it_cas2)                               &
-          -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1))
-     ql_prof_cas(k) = ql_cas(k,it_cas2)                               &
-          -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1))
-     qi_prof_cas(k) = qi_cas(k,it_cas2)                               &
-          -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1))
-     u_prof_cas(k) = u_cas(k,it_cas2)                                 &
-          -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))
-     v_prof_cas(k) = v_cas(k,it_cas2)                                 &
-          -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))
-     ug_prof_cas(k) = ug_cas(k,it_cas2)                               &
-          -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))
-     vg_prof_cas(k) = vg_cas(k,it_cas2)                               &
-          -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))
-     vitw_prof_cas(k) = vitw_cas(k,it_cas2)                           &
-          -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))
-     omega_prof_cas(k) = omega_cas(k,it_cas2)                         &
-          -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1))
-     du_prof_cas(k) = du_cas(k,it_cas2)                               &
-          -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))
-     hu_prof_cas(k) = hu_cas(k,it_cas2)                               &
-          -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))
-     vu_prof_cas(k) = vu_cas(k,it_cas2)                               &
-          -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))
-     dv_prof_cas(k) = dv_cas(k,it_cas2)                               &
-          -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))
-     hv_prof_cas(k) = hv_cas(k,it_cas2)                               &
-          -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))
-     vv_prof_cas(k) = vv_cas(k,it_cas2)                               &
-          -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))
-     dt_prof_cas(k) = dt_cas(k,it_cas2)                               &
-          -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))
-     ht_prof_cas(k) = ht_cas(k,it_cas2)                               &
-          -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))
-     vt_prof_cas(k) = vt_cas(k,it_cas2)                               &
-          -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))
-     dth_prof_cas(k) = dth_cas(k,it_cas2)                             &
-          -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1))
-     hth_prof_cas(k) = hth_cas(k,it_cas2)                             &
-          -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1))
-     vth_prof_cas(k) = vth_cas(k,it_cas2)                             &
-          -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1))
-     dtrad_prof_cas(k) = dtrad_cas(k,it_cas2)                         &
-          -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))
-     dq_prof_cas(k) = dq_cas(k,it_cas2)                               &
-          -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))
-     hq_prof_cas(k) = hq_cas(k,it_cas2)                               &
-          -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))
-     vq_prof_cas(k) = vq_cas(k,it_cas2)                               &
-          -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))
-     uw_prof_cas(k) = uw_cas(k,it_cas2)                                &
-          -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))
-     vw_prof_cas(k) = vw_cas(k,it_cas2)                                &
-          -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))
-     q1_prof_cas(k) = q1_cas(k,it_cas2)                                &
-          -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))
-     q2_prof_cas(k) = q2_cas(k,it_cas2)                                &
-          -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))
-  enddo
-
-
-END SUBROUTINE interp2_case_time
-
-!**********************************************************************************************
+      case(3) ; zzh = apbp
+      case(4) ; pph = apbp
+      case(5) ; temp0 = resul1    ! donnees initiales
+      case(6) ; qv0 = resul1
+      case(7) ; ql0 = resul1
+      case(8) ; qi0 = resul1
+      case(9) ; u0 = resul1
+      case(10) ; v0 = resul1
+      case(11) ; tke0 = resul1
+      case(12) ; pp0 = resul1
+      case(13) ; vitw = resul    ! donnees indexees en nlevel,time
+      case(14) ; omega = resul
+      case(15) ; ug = resul
+      case(16) ; vg = resul
+      case(17) ; du = resul
+      case(18) ; hu = resul
+      case(19) ; vu = resul
+      case(20) ; dv = resul
+      case(21) ; hv = resul
+      case(22) ; vv = resul
+      case(23) ; dt = resul
+      case(24) ; ht = resul
+      case(25) ; vt = resul
+      case(26) ; dq = resul
+      case(27) ; hq = resul
+      case(28) ; vq = resul
+      case(29) ; dth = resul
+      case(30) ; hth = resul
+      case(31) ; vth = resul
+      case(32) ; hthl = resul
+      case(33) ; dr = resul
+      case(34) ; hr = resul
+      case(35) ; vr = resul
+      case(36) ; dtrad = resul
+      case(37) ; q1 = resul
+      case(38) ; q2 = resul
+      case(39) ; uw = resul
+      case(40) ; vw = resul
+      case(41) ; rh = resul
+      case(42) ; zz = resul      ! donnees en time,nlevel pour profil initial
+      case(43) ; pp = resul
+      case(44) ; temp = resul
+      case(45) ; theta = resul
+      case(46) ; thv = resul
+      case(47) ; thl = resul
+      case(48) ; qv = resul
+      case(49) ; ql = resul
+      case(50) ; qi = resul
+      case(51) ; rv = resul
+      case(52) ; u = resul
+      case(53) ; v = resul
+      case(54) ; tke = resul
+      case(55) ; sens = resul2   ! donnees indexees en time
+      case(56) ; flat = resul2
+      case(57) ; ts = resul2
+      case(58) ; ps = resul2
+      case(59) ; ustar = resul2
+      case(60) ; orog_cas = resul3      ! constantes
+      case(61) ; albedo_cas = resul3
+      case(62) ; emiss_cas = resul3
+      case(63) ; t_skin_cas = resul3
+      case(64) ; q_skin_cas = resul3
+      case(65) ; mom_rough = resul3
+      case(66) ; heat_rough = resul3
+      case(67) ; o3_cas = resul3
+      case(68) ; rugos_cas = resul3
+      case(69) ; clay_cas = resul3
+      case(70) ; sand_cas = resul3
+      end select
+      resul = 0.
+      resul1 = 0.
+      resul2 = 0.
+      resul3 = 0.
+    enddo
+    PRINT*, 'Lecture de la variable APRES ,sens ', minval(sens), maxval(sens)
+    PRINT*, 'Lecture de la variable APRES ,flat ', minval(flat), maxval(flat)
+
+    !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
+    DO t = 1, ntime
+      DO k = 1, nlevel
+        temp(k, t) = temp0(k)
+        qv(k, t) = qv0(k)
+        ql(k, t) = ql0(k)
+        qi(k, t) = qi0(k)
+        u(k, t) = u0(k)
+        v(k, t) = v0(k)
+        tke(k, t) = tke0(k)
+      enddo
+    enddo
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE  old_read_SCM
+  !======================================================================
+
+  !======================================================================
+  SUBROUTINE interp_case_time2(day, day1, annee_ref                &
+          !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas      &
+          , nt_cas, nlev_cas                                       &
+          , ts_cas, ps_cas, plev_cas, t_cas, q_cas, u_cas, v_cas               &
+          , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas           &
+          , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas   &
+          , dq_cas, hq_cas, vq_cas, lat_cas, sens_cas, ustar_cas       &
+          , uw_cas, vw_cas, q1_cas, q2_cas                           &
+          , ts_prof_cas, plev_prof_cas, t_prof_cas, q_prof_cas       &
+          , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas         &
+          , vitw_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas     &
+          , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas       &
+          , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas    &
+          , hq_prof_cas, vq_prof_cas, lat_prof_cas, sens_prof_cas    &
+          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas)
+
+    USE lmdz_compar1d
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
+    IMPLICIT NONE
+
+    !---------------------------------------------------------------------------------------
+    ! Time interpolation of a 2D field to the timestep corresponding to day
+
+    ! day: current julian day (e.g. 717538.2)
+    ! day1: first day of the simulation
+    ! nt_cas: total nb of data in the forcing
+    ! pdt_cas: total time interval (in sec) between 2 forcing data
+    !---------------------------------------------------------------------------------------
+
+    ! inputs:
+    INTEGER annee_ref
+    INTEGER nt_cas, nlev_cas
+    REAL day, day1, day_cas
+    REAL ts_cas(nt_cas), ps_cas(nt_cas)
+    REAL plev_cas(nlev_cas, nt_cas)
+    REAL t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas)
+    REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas)
+    REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas)
+    REAL vitw_cas(nlev_cas, nt_cas)
+    REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas)
+    REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas)
+    REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas)
+    REAL dtrad_cas(nlev_cas, nt_cas)
+    REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas)
+    REAL lat_cas(nt_cas)
+    REAL sens_cas(nt_cas)
+    REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas)
+    REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas)
+
+    ! outputs:
+    REAL plev_prof_cas(nlev_cas)
+    REAL t_prof_cas(nlev_cas), q_prof_cas(nlev_cas)
+    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
+    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas)
+    REAL vitw_prof_cas(nlev_cas)
+    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
+    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
+    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas)
+    REAL dtrad_prof_cas(nlev_cas)
+    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
+    REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas
+    REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas)
+    ! local:
+    INTEGER it_cas1, it_cas2, k
+    REAL timeit, time_cas1, time_cas2, frac
+
+    PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas
+
+    ! On teste si la date du cas AMMA est correcte.
+    ! C est pour memoire car en fait les fichiers .def
+    ! sont censes etre corrects.
+    ! A supprimer a terme (MPL 20150623)
+    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
+    ! Check that initial day of the simulation consistent with AMMA case:
+    !      if (annee_ref.NE.2006) THEN
+    !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
+    !       PRINT*,'Changer annee_ref dans run.def'
+    !       stop
+    !      endif
+    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
+    !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
+    !       PRINT*,'Changer dayref dans run.def'
+    !       stop
+    !      endif
+    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
+    !       PRINT*,'AMMA a fini le 11 juillet'
+    !       PRINT*,'Changer dayref ou nday dans run.def'
+    !       stop
+    !      endif
+    !      endif
+
+    ! Determine timestep relative to the 1st day:
+    !       timeit=(day-day1)*86400.
+    !       if (annee_ref.EQ.1992) THEN
+    !        timeit=(day-day_cas)*86400.
+    !       else
+    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+    !       endif
+    timeit = (day - day_ju_ini_cas) * 86400
+    !print *,'day=',day
+    !print *,'day_ju_ini_cas=',day_ju_ini_cas
+    !print *,'pdt_cas=',pdt_cas
+    !print *,'timeit=',timeit
+    !print *,'nt_cas=',nt_cas
+
+    ! Determine the closest observation times:
+    !       it_cas1=INT(timeit/pdt_cas)+1
+    !       it_cas2=it_cas1 + 1
+    !       time_cas1=(it_cas1-1)*pdt_cas
+    !       time_cas2=(it_cas2-1)*pdt_cas
+
+    it_cas1 = INT(timeit / pdt_cas) + 1
+    IF (it_cas1 == nt_cas) THEN
+      it_cas2 = it_cas1
+    ELSE
+      it_cas2 = it_cas1 + 1
+    ENDIF
+    time_cas1 = (it_cas1 - 1) * pdt_cas
+    time_cas2 = (it_cas2 - 1) * pdt_cas
+    !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
+
+    IF (it_cas1 > nt_cas) THEN
+      WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+              , day, day_ju_ini_cas, it_cas1, it_cas2, timeit
+      stop
+    ENDIF
+
+    ! time interpolation:
+    IF (it_cas1 == it_cas2) THEN
+      frac = 0.
+    ELSE
+      frac = (time_cas2 - timeit) / (time_cas2 - time_cas1)
+      frac = max(frac, 0.0)
+    ENDIF
+
+    lat_prof_cas = lat_cas(it_cas2)                                       &
+            - frac * (lat_cas(it_cas2) - lat_cas(it_cas1))
+    sens_prof_cas = sens_cas(it_cas2)                                     &
+            - frac * (sens_cas(it_cas2) - sens_cas(it_cas1))
+    ts_prof_cas = ts_cas(it_cas2)                                         &
+            - frac * (ts_cas(it_cas2) - ts_cas(it_cas1))
+    ustar_prof_cas = ustar_cas(it_cas2)                                   &
+            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
+
+    DO k = 1, nlev_cas
+      plev_prof_cas(k) = plev_cas(k, it_cas2)                               &
+              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
+      t_prof_cas(k) = t_cas(k, it_cas2)                               &
+              - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1))
+      q_prof_cas(k) = q_cas(k, it_cas2)                               &
+              - frac * (q_cas(k, it_cas2) - q_cas(k, it_cas1))
+      u_prof_cas(k) = u_cas(k, it_cas2)                               &
+              - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1))
+      v_prof_cas(k) = v_cas(k, it_cas2)                               &
+              - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1))
+      ug_prof_cas(k) = ug_cas(k, it_cas2)                               &
+              - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1))
+      vg_prof_cas(k) = vg_cas(k, it_cas2)                               &
+              - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1))
+      vitw_prof_cas(k) = vitw_cas(k, it_cas2)                               &
+              - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1))
+      du_prof_cas(k) = du_cas(k, it_cas2)                                   &
+              - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1))
+      hu_prof_cas(k) = hu_cas(k, it_cas2)                                   &
+              - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1))
+      vu_prof_cas(k) = vu_cas(k, it_cas2)                                   &
+              - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1))
+      dv_prof_cas(k) = dv_cas(k, it_cas2)                                   &
+              - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1))
+      hv_prof_cas(k) = hv_cas(k, it_cas2)                                   &
+              - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1))
+      vv_prof_cas(k) = vv_cas(k, it_cas2)                                   &
+              - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1))
+      dt_prof_cas(k) = dt_cas(k, it_cas2)                                   &
+              - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1))
+      ht_prof_cas(k) = ht_cas(k, it_cas2)                                   &
+              - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1))
+      vt_prof_cas(k) = vt_cas(k, it_cas2)                                   &
+              - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1))
+      dtrad_prof_cas(k) = dtrad_cas(k, it_cas2)                                   &
+              - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1))
+      dq_prof_cas(k) = dq_cas(k, it_cas2)                                   &
+              - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1))
+      hq_prof_cas(k) = hq_cas(k, it_cas2)                                   &
+              - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1))
+      vq_prof_cas(k) = vq_cas(k, it_cas2)                                   &
+              - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1))
+      uw_prof_cas(k) = uw_cas(k, it_cas2)                                   &
+              - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1))
+      vw_prof_cas(k) = vw_cas(k, it_cas2)                                   &
+              - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1))
+      q1_prof_cas(k) = q1_cas(k, it_cas2)                                   &
+              - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1))
+      q2_prof_cas(k) = q2_cas(k, it_cas2)                                   &
+              - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1))
+    enddo
+
+  END SUBROUTINE interp_case_time2
+
+  !**********************************************************************************************
+  SUBROUTINE interp2_case_time(day, day1, annee_ref                           &
+          !    &         ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas                         &
+          , nt_cas, nlev_cas                                                   &
+          , ts_cas, ps_cas, plev_cas, t_cas, theta_cas, thv_cas, thl_cas            &
+          , qv_cas, ql_cas, qi_cas, u_cas, v_cas                                  &
+          , ug_cas, vg_cas, vitw_cas, omega_cas, du_cas, hu_cas, vu_cas             &
+          , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas               &
+          , dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas                      &
+          , lat_cas, sens_cas, ustar_cas                                        &
+          , uw_cas, vw_cas, q1_cas, q2_cas, tke_cas                               &
+
+          , ts_prof_cas, plev_prof_cas, t_prof_cas, theta_prof_cas               &
+          , thv_prof_cas, thl_prof_cas, qv_prof_cas, ql_prof_cas, qi_prof_cas     &
+          , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas                     &
+          , vitw_prof_cas, omega_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas  &
+          , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas                   &
+          , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas                &
+          , hq_prof_cas, vq_prof_cas, dth_prof_cas, hth_prof_cas, vth_prof_cas    &
+          , lat_prof_cas, sens_prof_cas                                        &
+          , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tke_prof_cas)
+
+    USE lmdz_compar1d
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
+    IMPLICIT NONE
+
+    !---------------------------------------------------------------------------------------
+    ! Time interpolation of a 2D field to the timestep corresponding to day
+
+    ! day: current julian day (e.g. 717538.2)
+    ! day1: first day of the simulation
+    ! nt_cas: total nb of data in the forcing
+    ! pdt_cas: total time interval (in sec) between 2 forcing data
+    !---------------------------------------------------------------------------------------
+
+    ! inputs:
+    INTEGER annee_ref
+    INTEGER nt_cas, nlev_cas
+    REAL day, day1, day_cas
+    REAL ts_cas(nt_cas), ps_cas(nt_cas)
+    REAL plev_cas(nlev_cas, nt_cas)
+    REAL t_cas(nlev_cas, nt_cas), theta_cas(nlev_cas, nt_cas), thv_cas(nlev_cas, nt_cas), thl_cas(nlev_cas, nt_cas)
+    REAL qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), qi_cas(nlev_cas, nt_cas)
+    REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas)
+    REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas)
+    REAL vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas)
+    REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas)
+    REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas)
+    REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas)
+    REAL dth_cas(nlev_cas, nt_cas), hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas)
+    REAL dtrad_cas(nlev_cas, nt_cas)
+    REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas)
+    REAL lat_cas(nt_cas), sens_cas(nt_cas), tke_cas(nt_cas)
+    REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas)
+    REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas)
+
+    ! outputs:
+    REAL plev_prof_cas(nlev_cas)
+    REAL t_prof_cas(nlev_cas), theta_prof_cas(nlev_cas), thl_prof_cas(nlev_cas), thv_prof_cas(nlev_cas)
+    REAL qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas)
+    REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas)
+    REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas)
+    REAL vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas)
+    REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas)
+    REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas)
+    REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas)
+    REAL dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas)
+    REAL dtrad_prof_cas(nlev_cas)
+    REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas)
+    REAL lat_prof_cas, sens_prof_cas, tke_prof_cas, ts_prof_cas, ustar_prof_cas
+    REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas)
+    ! local:
+    INTEGER it_cas1, it_cas2, k
+    REAL timeit, time_cas1, time_cas2, frac
+
+    PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas
+    !       do k=1,nlev_cas
+    !       PRINT*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)
+    !       enddo
+
+    ! On teste si la date du cas AMMA est correcte.
+    ! C est pour memoire car en fait les fichiers .def
+    ! sont censes etre corrects.
+    ! A supprimer a terme (MPL 20150623)
+    !     if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN
+    ! Check that initial day of the simulation consistent with AMMA case:
+    !      if (annee_ref.NE.2006) THEN
+    !       PRINT*,'Pour AMMA, annee_ref doit etre 2006'
+    !       PRINT*,'Changer annee_ref dans run.def'
+    !       stop
+    !      endif
+    !      if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN
+    !       PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas
+    !       PRINT*,'Changer dayref dans run.def'
+    !       stop
+    !      endif
+    !      if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN
+    !       PRINT*,'AMMA a fini le 11 juillet'
+    !       PRINT*,'Changer dayref ou nday dans run.def'
+    !       stop
+    !      endif
+    !      endif
+
+    ! Determine timestep relative to the 1st day:
+    !       timeit=(day-day1)*86400.
+    !       if (annee_ref.EQ.1992) THEN
+    !        timeit=(day-day_cas)*86400.
+    !       else
+    !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+    !       endif
+    timeit = (day - day_ju_ini_cas) * 86400
+    !print *,'day=',day
+    !print *,'day_ju_ini_cas=',day_ju_ini_cas
+    !print *,'pdt_cas=',pdt_cas
+    !print *,'timeit=',timeit
+    !print *,'nt_cas=',nt_cas
+
+    ! Determine the closest observation times:
+    !       it_cas1=INT(timeit/pdt_cas)+1
+    !       it_cas2=it_cas1 + 1
+    !       time_cas1=(it_cas1-1)*pdt_cas
+    !       time_cas2=(it_cas2-1)*pdt_cas
+
+    it_cas1 = INT(timeit / pdt_cas) + 1
+    IF (it_cas1 == nt_cas) THEN
+      it_cas2 = it_cas1
+    ELSE
+      it_cas2 = it_cas1 + 1
+    ENDIF
+    time_cas1 = (it_cas1 - 1) * pdt_cas
+    time_cas2 = (it_cas2 - 1) * pdt_cas
+    !print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas
+    !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
+
+    IF (it_cas1 > nt_cas) THEN
+      WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
+              , day, day_ju_ini_cas, it_cas1, it_cas2, timeit
+      stop
+    ENDIF
+
+    ! time interpolation:
+    IF (it_cas1 == it_cas2) THEN
+      frac = 0.
+    ELSE
+      frac = (time_cas2 - timeit) / (time_cas2 - time_cas1)
+      frac = max(frac, 0.0)
+    ENDIF
+
+    lat_prof_cas = lat_cas(it_cas2)                                   &
+            - frac * (lat_cas(it_cas2) - lat_cas(it_cas1))
+    sens_prof_cas = sens_cas(it_cas2)                                 &
+            - frac * (sens_cas(it_cas2) - sens_cas(it_cas1))
+    tke_prof_cas = tke_cas(it_cas2)                                   &
+            - frac * (tke_cas(it_cas2) - tke_cas(it_cas1))
+    ts_prof_cas = ts_cas(it_cas2)                                     &
+            - frac * (ts_cas(it_cas2) - ts_cas(it_cas1))
+    ustar_prof_cas = ustar_cas(it_cas2)                               &
+            - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
+
+    DO k = 1, nlev_cas
+      plev_prof_cas(k) = plev_cas(k, it_cas2)                           &
+              - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
+      t_prof_cas(k) = t_cas(k, it_cas2)                                 &
+              - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1))
+      !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2)
+      theta_prof_cas(k) = theta_cas(k, it_cas2)                         &
+              - frac * (theta_cas(k, it_cas2) - theta_cas(k, it_cas1))
+      thv_prof_cas(k) = thv_cas(k, it_cas2)                             &
+              - frac * (thv_cas(k, it_cas2) - thv_cas(k, it_cas1))
+      thl_prof_cas(k) = thl_cas(k, it_cas2)                             &
+              - frac * (thl_cas(k, it_cas2) - thl_cas(k, it_cas1))
+      qv_prof_cas(k) = qv_cas(k, it_cas2)                               &
+              - frac * (qv_cas(k, it_cas2) - qv_cas(k, it_cas1))
+      ql_prof_cas(k) = ql_cas(k, it_cas2)                               &
+              - frac * (ql_cas(k, it_cas2) - ql_cas(k, it_cas1))
+      qi_prof_cas(k) = qi_cas(k, it_cas2)                               &
+              - frac * (qi_cas(k, it_cas2) - qi_cas(k, it_cas1))
+      u_prof_cas(k) = u_cas(k, it_cas2)                                 &
+              - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1))
+      v_prof_cas(k) = v_cas(k, it_cas2)                                 &
+              - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1))
+      ug_prof_cas(k) = ug_cas(k, it_cas2)                               &
+              - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1))
+      vg_prof_cas(k) = vg_cas(k, it_cas2)                               &
+              - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1))
+      vitw_prof_cas(k) = vitw_cas(k, it_cas2)                           &
+              - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1))
+      omega_prof_cas(k) = omega_cas(k, it_cas2)                         &
+              - frac * (omega_cas(k, it_cas2) - omega_cas(k, it_cas1))
+      du_prof_cas(k) = du_cas(k, it_cas2)                               &
+              - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1))
+      hu_prof_cas(k) = hu_cas(k, it_cas2)                               &
+              - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1))
+      vu_prof_cas(k) = vu_cas(k, it_cas2)                               &
+              - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1))
+      dv_prof_cas(k) = dv_cas(k, it_cas2)                               &
+              - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1))
+      hv_prof_cas(k) = hv_cas(k, it_cas2)                               &
+              - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1))
+      vv_prof_cas(k) = vv_cas(k, it_cas2)                               &
+              - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1))
+      dt_prof_cas(k) = dt_cas(k, it_cas2)                               &
+              - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1))
+      ht_prof_cas(k) = ht_cas(k, it_cas2)                               &
+              - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1))
+      vt_prof_cas(k) = vt_cas(k, it_cas2)                               &
+              - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1))
+      dth_prof_cas(k) = dth_cas(k, it_cas2)                             &
+              - frac * (dth_cas(k, it_cas2) - dth_cas(k, it_cas1))
+      hth_prof_cas(k) = hth_cas(k, it_cas2)                             &
+              - frac * (hth_cas(k, it_cas2) - hth_cas(k, it_cas1))
+      vth_prof_cas(k) = vth_cas(k, it_cas2)                             &
+              - frac * (vth_cas(k, it_cas2) - vth_cas(k, it_cas1))
+      dtrad_prof_cas(k) = dtrad_cas(k, it_cas2)                         &
+              - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1))
+      dq_prof_cas(k) = dq_cas(k, it_cas2)                               &
+              - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1))
+      hq_prof_cas(k) = hq_cas(k, it_cas2)                               &
+              - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1))
+      vq_prof_cas(k) = vq_cas(k, it_cas2)                               &
+              - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1))
+      uw_prof_cas(k) = uw_cas(k, it_cas2)                                &
+              - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1))
+      vw_prof_cas(k) = vw_cas(k, it_cas2)                                &
+              - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1))
+      q1_prof_cas(k) = q1_cas(k, it_cas2)                                &
+              - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1))
+      q2_prof_cas(k) = q2_cas(k, it_cas2)                                &
+              - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1))
+    enddo
+
+  END SUBROUTINE interp2_case_time
+
+  !**********************************************************************************************
 
 END MODULE mod_1D_cases_read2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90	(revision 5158)
@@ -86,7 +86,7 @@
   !**********************************************************************************************
   SUBROUTINE read_SCM_cas
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
     IMPLICIT NONE
-
-    INCLUDE "date_cas.h"
 
     INTEGER nid, rid, ierr
@@ -239,5 +239,5 @@
             o3_cas, rugos_cas, clay_cas, sand_cas)
     PRINT*, 'read_SCM cas OK'
-    do ii = 1, nlev_cas
+    DO ii = 1, nlev_cas
       PRINT*, 'apres read_SCM_cas, plev_cas=', ii, plev_cas(ii, 1)
       !PRINT*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1)
@@ -325,6 +325,7 @@
 
     !program reading forcing of the case study
+    USE lmdz_compar1d
+
     IMPLICIT NONE
-    INCLUDE "compar1d.h"
 
     INTEGER ntime, nlevel, k, t
@@ -419,5 +420,5 @@
     !-----------------------------------------------------------------------
 
-    do i = 1, nbvar3d
+    DO i = 1, nbvar3d
       missing_var(i) = 0.
       ierr = nf90_inq_varid(nid, name_var(i), var3didin(i))
@@ -596,6 +597,6 @@
 
     !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL
-    do t = 1, ntime
-      do k = 1, nlevel
+    DO t = 1, ntime
+      DO k = 1, nlevel
         temp(k, t) = temp0(k)
         qv(k, t) = qv0(k)
@@ -644,4 +645,7 @@
           , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tkes_prof_cas)
 
+    USE lmdz_compar1d
+    USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas
+
     IMPLICIT NONE
 
@@ -654,7 +658,4 @@
     ! pdt_cas: total time interval (in sec) between 2 forcing data
     !---------------------------------------------------------------------------------------
-
-    INCLUDE "compar1d.h"
-    INCLUDE "date_cas.h"
 
     ! inputs:
@@ -799,5 +800,5 @@
             - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1))
 
-    do k = 1, nlev_cas
+    DO k = 1, nlev_cas
       plev_prof_cas(k) = plev_cas(k, it_cas2)                           &
               - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1))
@@ -970,5 +971,5 @@
     ! for variables defined at the middle of layers
 
-    do l = 1, llm
+    DO l = 1, llm
 
       IF (play(l)>=plev_prof_cas(nlev_cas)) THEN
@@ -979,5 +980,5 @@
 
         IF (play(l)<=plev_prof_cas(1)) THEN
-          do k = 1, nlev_cas - 1
+          DO k = 1, nlev_cas - 1
             IF (play(l)<=plev_prof_cas(k).AND. play(l)>plev_prof_cas(k + 1)) THEN
               k1 = k
@@ -989,5 +990,5 @@
             WRITE(*, *) 'PB! k1, k2 = ', k1, k2
             WRITE(*, *) 'l,play(l) = ', l, play(l) / 100
-            do k = 1, nlev_cas - 1
+            DO k = 1, nlev_cas - 1
               WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
             enddo
@@ -1141,5 +1142,5 @@
     ! for variables defined at layer interfaces (EV):
 
-    do l = 1, llm + 1
+    DO l = 1, llm + 1
 
       IF (plev(l)>=plev_prof_cas(nlev_cas)) THEN
@@ -1149,5 +1150,5 @@
 
         IF (plev(l)<=plev_prof_cas(1)) THEN
-          do k = 1, nlev_cas - 1
+          DO k = 1, nlev_cas - 1
             IF (plev(l)<=plev_prof_cas(k).AND. plev(l)>plev_prof_cas(k + 1)) THEN
               k1 = k
@@ -1159,5 +1160,5 @@
             WRITE(*, *) 'PB! k1, k2 = ', k1, k2
             WRITE(*, *) 'l,plev(l) = ', l, plev(l) / 100
-            do k = 1, nlev_cas - 1
+            DO k = 1, nlev_cas - 1
               WRITE(*, *) 'k,plev_prof_cas(k) = ', k, plev_prof_cas(k) / 100
             enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h	(revision 5158)
@@ -29,5 +29,5 @@
       open(21,file=trim(fich_toga),form='formatted')
       read(21,'(a)') 
-      do ip = 1, nt_toga
+      DO ip = 1, nt_toga
       read(21,'(a)') 
       read(21,'(a)') 
@@ -36,5 +36,5 @@
       read(21,'(a)') 
 
-       do k = 1, nlev_toga
+       DO k = 1, nlev_toga
          read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip)          &
      &       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)                     &
@@ -85,5 +85,5 @@
       open(21,file=trim(fich_sandu),form='formatted')
       read(21,'(a)')
-      do ip = 1, nt_sandu
+      DO ip = 1, nt_sandu
       read(21,'(a)')
       read(21,'(a)')
@@ -124,5 +124,5 @@
       read(21,'(a)')
       read(21,'(a)')
-      do ip = 1, nt_astex
+      DO ip = 1, nt_astex
       read(21,'(a)')
       read(21,'(a)')
@@ -308,6 +308,6 @@
 
 !pressure 
-       do l=1,ntime
-       do k=1,nlevel
+       DO l=1,ntime
+       DO k=1,nlevel
           plev(k,l)=lev(k)
        enddo
@@ -356,6 +356,6 @@
 !         WRITE(*,*)'lecture q ok'
 !q in kg/kg
-       do l=1,ntime
-       do k=1,nlevel
+       DO l=1,ntime
+       DO k=1,nlevel
           q(k,l)=q(k,l)/1000.
        enddo
@@ -382,6 +382,6 @@
 !         WRITE(*,*)'lecture omega ok'
 !omega in mb/hour
-       do l=1,ntime
-       do k=1,nlevel
+       DO l=1,ntime
+       DO k=1,nlevel
           omega(k,l)=omega(k,l)*100./3600.
        enddo
@@ -402,6 +402,6 @@
 !         WRITE(*,*)'lecture T_adv_h ok'
 !T adv in K/s
-       do l=1,ntime
-       do k=1,nlevel
+       DO l=1,ntime
+       DO k=1,nlevel
           T_adv_h(k,l)=T_adv_h(k,l)/3600.
        enddo
@@ -416,6 +416,6 @@
 !         WRITE(*,*)'lecture T_adv_v ok'
 !T adv in K/s
-       do l=1,ntime
-       do k=1,nlevel
+       DO l=1,ntime
+       DO k=1,nlevel
           T_adv_v(k,l)=T_adv_v(k,l)/3600.
        enddo
@@ -429,6 +429,6 @@
 !         WRITE(*,*)'lecture q_adv_h ok'
 !q adv in kg/kg/s
-       do l=1,ntime
-       do k=1,nlevel
+       DO l=1,ntime
+       DO k=1,nlevel
           q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
        enddo
@@ -443,6 +443,6 @@
 !         WRITE(*,*)'lecture q_adv_v ok'
 !q adv in kg/kg/s
-       do l=1,ntime
-       do k=1,nlevel
+       DO l=1,ntime
+       DO k=1,nlevel
           q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
        enddo
@@ -572,5 +572,5 @@
        REAL frac,frac1,frac2,fact
 
-       do l = 1, llm
+       DO l = 1, llm
 
         IF (play(l).ge.plev_prof(nlev_sandu)) THEN
@@ -580,5 +580,5 @@
 
          IF (play(l).le.plev_prof(1)) THEN
-         do k = 1, nlev_sandu-1
+         DO k = 1, nlev_sandu-1
           IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
@@ -590,5 +590,5 @@
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_sandu-1
+         DO k = 1, nlev_sandu-1
           WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
@@ -641,5 +641,5 @@
        enddo ! l
 
-       do l = 1,llm
+       DO l = 1,llm
 !      print *,'t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l) ',
 !    $        l,t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l)
@@ -685,5 +685,5 @@
        REAL frac,frac1,frac2,fact
 
-       do l = 1, llm
+       DO l = 1, llm
 
         IF (play(l).ge.plev_prof(nlev_astex)) THEN
@@ -693,5 +693,5 @@
 
          IF (play(l).le.plev_prof(1)) THEN
-         do k = 1, nlev_astex-1
+         DO k = 1, nlev_astex-1
           IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
@@ -703,5 +703,5 @@
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_astex-1
+         DO k = 1, nlev_astex-1
           WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
@@ -760,5 +760,5 @@
        enddo ! l
 
-       do l = 1,llm
+       DO l = 1,llm
 !      print *,'t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l) ',
 !    $        l,t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l)
@@ -801,5 +801,5 @@
       PRINT*,fich_rico
       open(21,file=trim(fich_rico),form='formatted')
-        do k=1,llm
+        DO k=1,llm
       zlay(k)=0.
          enddo
@@ -808,11 +808,11 @@
         prico(1)=ps_rico
         zrico(1)=0.0
-      do l=2,nlev_rico
+      DO l=2,nlev_rico
         read(21,*) k,prico(l),zrico(l)
       enddo
        close(21)
 
-      do k=1,llm
-        do l=1,80
+      DO k=1,llm
+        DO l=1,80
           IF(prico(l)>play(k)) THEN
               IF(play(k)>prico(l+1)) THEN
@@ -922,5 +922,5 @@
       enddo
 
-      do k=1,llm
+      DO k=1,llm
       q_rico(k)=q_rico(k)/1e3 
       dqh_dyn(k)=dqh_dyn(k)/1e3
@@ -1029,5 +1029,5 @@
       open(21,file=trim(fich_armcu),form='formatted')
       read(21,'(a)')
-      do ip = 1, nt_armcu
+      DO ip = 1, nt_armcu
       read(21,'(a)')
       read(21,'(a)')
@@ -1082,5 +1082,5 @@
        REAL frac,frac1,frac2,fact
  
-       do l = 1, llm
+       DO l = 1, llm
 
         IF (play(l).ge.plev_prof(nlev_toga)) THEN
@@ -1090,5 +1090,5 @@
 
          IF (play(l).le.plev_prof(1)) THEN
-         do k = 1, nlev_toga-1
+         DO k = 1, nlev_toga-1
           IF (play(l).le.plev_prof(k).AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
@@ -1100,5 +1100,5 @@
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_toga-1
+         DO k = 1, nlev_toga-1
           WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
@@ -1208,5 +1208,5 @@
        REAL frac,frac1,frac2,fact
  
-       do l = 1, llm
+       DO l = 1, llm
 
         IF (play(l).ge.plev_prof_cas(nlev_cas)) THEN
@@ -1216,5 +1216,5 @@
 
          IF (play(l).le.plev_prof_cas(1)) THEN
-         do k = 1, nlev_cas-1
+         DO k = 1, nlev_cas-1
           IF (play(l).le.plev_prof_cas(k).AND. play(l).gt.plev_prof_cas(k+1)) THEN
             k1=k
@@ -1226,5 +1226,5 @@
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_cas-1
+         DO k = 1, nlev_cas-1
           WRITE(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
          enddo
@@ -1356,5 +1356,5 @@
        REAL aa,frac,frac1,frac2,fact
  
-       do l = 1, llm
+       DO l = 1, llm
 
         IF (play(l).ge.plev_prof(nlev_dice)) THEN
@@ -1364,5 +1364,5 @@
 
          IF (play(l).le.plev_prof(1)) THEN
-         do k = 1, nlev_dice-1
+         DO k = 1, nlev_dice-1
           IF (play(l).le.plev_prof(k) .AND. play(l).gt.plev_prof(k+1)) THEN
             k1=k
@@ -1374,5 +1374,5 @@
           WRITE(*,*) 'PB! k1, k2 = ',k1,k2
           WRITE(*,*) 'l,play(l) = ',l,play(l)/100
-         do k = 1, nlev_dice-1
+         DO k = 1, nlev_dice-1
           WRITE(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
          enddo
@@ -1540,4 +1540,7 @@
      &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof   &
      &             ,ht_prof,vt_prof,hq_prof,vq_prof)
+
+     USE lmdz_compar1d
+
         IMPLICIT NONE
 
@@ -1550,6 +1553,4 @@
 ! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
 !---------------------------------------------------------------------------------------
-
-        INCLUDE "compar1d.h"
 
 ! inputs:
@@ -1646,5 +1647,5 @@
 !     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
 
-       do k=1,nlev_toga
+       DO k=1,nlev_toga
         plev_prof(k) = 100.*(plev_toga(k,it_toga2)                         &
      &          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
@@ -1681,4 +1682,7 @@
      &             ,ustar_prof,psurf_prof,ug_prof,vg_prof                 &
      &             ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof)
+
+     USE lmdz_compar1d
+
         IMPLICIT NONE
 
@@ -1691,6 +1695,4 @@
 ! dt_dice: total time interval (in sec) between 2 forcing data (e.g. 30min. for Dice)
 !---------------------------------------------------------------------------------------
-
-        INCLUDE "compar1d.h"
 
 ! inputs:
@@ -1777,5 +1779,5 @@
 !     :day,annee_ref,day_ini_dice,timeit/86400.,it_dice1,it_dice2,ts_prof
 
-       do k=1,nlev_dice
+       DO k=1,nlev_dice
         ht_prof(k) = ht_dice(k,it_dice2)-frac*(ht_dice(k,it_dice2)-ht_dice(k,it_dice1))
         hq_prof(k) = hq_dice(k,it_dice2)-frac*(hq_dice(k,it_dice2)-hq_dice(k,it_dice1))
@@ -1794,4 +1796,7 @@
      &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                          &
      &             ,ug_prof,vg_prof,ht_prof,hq_prof,tg_prof)
+
+     USE lmdz_compar1d
+
         IMPLICIT NONE
 
@@ -1804,6 +1809,4 @@
 ! dt_gabls4: total time interval (in sec) between 2 forcing data (e.g. 60min. for gabls4)
 !---------------------------------------------------------------------------------------
-
-        INCLUDE "compar1d.h"
 
 ! inputs:
@@ -1866,5 +1869,5 @@
 
 
-       do k=1,nlev_gabls4
+       DO k=1,nlev_gabls4
         ug_prof(k) = ug_gabls4(k,it_gabls42)-frac*(ug_gabls4(k,it_gabls42)-ug_gabls4(k,it_gabls41))
         vg_prof(k) = vg_gabls4(k,it_gabls42)-frac*(vg_gabls4(k,it_gabls42)-vg_gabls4(k,it_gabls41))
@@ -1982,5 +1985,5 @@
         IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
-        do k=1,kmax
+        DO k=1,kmax
           read (ilesfile,*) height1(k),thlprof(k),qtprof (k),               &
      &                      uprof (k),vprof  (k),e12prof(k)
@@ -1996,9 +1999,9 @@
           stop 'lecture profiles'
         endif
-        do k=1,kmax
+        DO k=1,kmax
           read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),         &
      &                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
         END DO
-        do k=1,kmax
+        DO k=1,kmax
           IF (height(k) .NE. height1(k)) THEN
             print *, 'fichiers prof.inp et lscale.inp incompatibles :'
@@ -2022,5 +2025,5 @@
           stop 'lecture profiles'
         endif
-        do k=1,kmax
+        DO k=1,kmax
           read (ilesfile,*) height(k),(tracer(k,itrac),itrac=nt1,nt2)
         END DO
@@ -2052,5 +2055,5 @@
         IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
-        do k=1,kmax
+        DO k=1,kmax
           read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
      &                      qprof (k),uprof(k),  vprof(k),  wprof(k),      &
@@ -2084,5 +2087,5 @@
         IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
-        do k=1,kmax
+        DO k=1,kmax
           read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
      &                qvprof (k),qlprof (k),qtprof (k),                    &
@@ -2126,5 +2129,5 @@
         IF (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
         read (ilesfile,*) kmax
-        do k=1,kmax
+        DO k=1,kmax
           read (ilesfile,*) height(k)    ,pprof(k),  uprof(k), vprof(k),   &
      &                      thetaprof(k) ,tprof(k), qvprof(k),rvprof(k)
@@ -2143,5 +2146,5 @@
        ENDIF
         read (ifile,*) kmax
-        do k=1,kmax
+        DO k=1,kmax
           read (ifile,*) jtot,aprof(k),bprof(k)
         enddo
@@ -2559,5 +2562,5 @@
          endif
 !          WRITE(*,*)'lecture th ok',th
-           do k=1,nlevel
+           DO k=1,nlevel
              t(k)=th(k)*(pres(k)/pzero)**rkappa
            enddo
@@ -2925,5 +2928,5 @@
 
 ! On remet les variables lues dans le bon ordre des niveaux (MPL 20141024)
-         do k=1,nlevel
+         DO k=1,nlevel
            zz(k)=zz_i(nlevel+1-k)
            ug(k,:)=ug_i(nlevel+1-k,:)
@@ -2948,8 +2951,9 @@
 
       USE lmdz_yomcst
-      
+
+      INTEGER :: ncm_1, nlev_circ, ilev, iskip, icm_1, il
       parameter (ncm_1=49180)
 
-      REAL albsfc(ncm_1), albsfc_w(ncm_1)
+      REAL albsfc(ncm_1), albsfc_w(ncm_1), aer_alpha, sw_dn_toa, tsfc
       REAL cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
            reliq(nlev_circ), reice(nlev_circ), lwp(nlev_circ), iwp(nlev_circ)
@@ -2975,5 +2979,5 @@
       
 !     Read scalar information
-      do iskip=1,5
+      DO iskip=1,5
          read (11, *)
       enddo
@@ -2988,5 +2992,5 @@
 !     Read level information
       read (12, *)
-      do il=1,nlev
+      DO il=1,nlev
          read (12, 302) ilev, z(il), p(il), t(il)
          z(il)=z(il)*1000.    ! z donne en km
@@ -2997,8 +3001,8 @@
 
 !     Read layer information (midpoint values)
-      do iskip=1,3
+      DO iskip=1,3
          read (13, *)
       enddo
-      do il=1,nlev-1
+      DO il=1,nlev-1
          read (13, 303) ilev,pm(il),tm(il),h2o(il),co2(il),o3(il), &
                         n2o(il),co(il),ch4(il),o2(il),ccl4(il), &
@@ -3010,5 +3014,5 @@
       
 !     Read aerosol layer information
-      do iskip=1,3
+      DO iskip=1,3
          read (14, *)
       enddo
@@ -3016,5 +3020,5 @@
       read (14, *)
       read (14, *)
-      do il=1,nlev-1
+      DO il=1,nlev-1
          read (14, 304) ilev, aer_beta(il), waer(il), gaer(il)
       enddo
@@ -3023,8 +3027,8 @@
       
 !     Read cloud information
-      do iskip=1,3
+      DO iskip=1,3
          read (15, *)
       enddo
-      do il=1,nlev-1
+      DO il=1,nlev-1
          read (15, 305) ilev, cf(il), lwp(il), iwp(il), reliq(il), reice(il)
          lwp(il)=lwp(il)/1000.          ! lwp donne en g/kg
@@ -3037,8 +3041,8 @@
 
 !     Read surface albedo (weighted & unweighted) and spectral solar irradiance
-      do iskip=1,6
+      DO iskip=1,6
          read (16, *)
       enddo
-      do icm_1=1,ncm_1
+      DO icm_1=1,ncm_1
          read (16, 306) wavn(icm_1), albsfc(icm_1), albsfc_w(icm_1), ssf(icm_1)
       enddo
@@ -3055,4 +3059,5 @@
       USE lmdz_yomcst
 
+      INTEGER nlev_rtmip, il
       REAL t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
       REAL temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
@@ -3066,8 +3071,8 @@
 !     Read level information
       read (11, *)
-      do il=1,nlev_rtmip
+      DO il=1,nlev_rtmip
          read (11, 302) pt(il), pb(il), t(il),h2o(il),o3(il)
       enddo
-      do il=1,nlev_rtmip
+      DO il=1,nlev_rtmip
          play(il)=pt(nlev_rtmip-il+1)*100.     ! p donne en mb
          temp(il)=t(nlev_rtmip-il+1)
@@ -3075,5 +3080,5 @@
          oz(il)=o3(nlev_rtmip-il+1)
       enddo
-      do il=1,39
+      DO il=1,39
          plev(il)=play(il)+(play(il+1)-play(il))/2.
          print *,'il p t ovap oz=',il,plev(il),temp(il),ovap(il),oz(il)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_interp_cases.h	(revision 5158)
@@ -26,5 +26,5 @@
 ! large-scale forcing :
 !!!      tsurf = ts_gcssold
-      do l = 1, llm
+      DO l = 1, llm
 !       u(l) = hu_gcssold(l) !  on prescrit le vent
 !       v(l) = hv_gcssold(l)    !  on prescrit le vent
@@ -72,5 +72,5 @@
 ! large-scale forcing :
       tsurf = ts_prof
-      do l = 1, llm
+      DO l = 1, llm
        u(l) = u_mod(l) ! sb: on prescrit le vent
        v(l) = v_mod(l) ! sb: on prescrit le vent
@@ -169,5 +169,5 @@
       tg=tg_prof
       print *,'ust= ',ust
-      do l = 1, llm
+      DO l = 1, llm
        ug(l)= ug_profd
        vg(l)= vg_profd
@@ -217,5 +217,5 @@
      &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
 
-      do l = 1, llm
+      DO l = 1, llm
        ug(l)= ug_mod(l)
        vg(l)= vg_mod(l)
@@ -276,5 +276,5 @@
 
 !wind nudging above 500m with a 2h time scale
-        do l=1,llm
+        DO l=1,llm
         IF (nudge_wind) THEN
 !           if (phi(l).gt.5000.) THEN
@@ -291,5 +291,5 @@
 !CR:nudging of q and theta with a 6h time scale above 15km
         IF (nudge_thermo) THEN
-        do l=1,llm
+        DO l=1,llm
            zz(l)=phi(l)/9.8
            IF ((zz(l).le.16000.).AND.(zz(l).gt.15000.)) THEN
@@ -304,5 +304,5 @@
         endif
 
-      do l = 1, llm
+      DO l = 1, llm
        omega(l) = w_mod(l)
        omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
@@ -343,5 +343,5 @@
       PRINT*,'apres interpolation temporelle AMMA'
 
-      do k=1,nlev_amma
+      DO k=1,nlev_amma
          th_profamma(k)=0.
          q_profamma(k)=0.
@@ -365,5 +365,5 @@
 !Calcul des gradients verticaux
 !initialisation
-      do l=1,llm
+      DO l=1,llm
       d_t_z(l)=0.
       d_q_z(l)=0.
@@ -380,5 +380,5 @@
 
 
-      do l = 1, llm
+      DO l = 1, llm
        rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
        omega(l) = w_mod(l)*(-rg*rho(l))
@@ -414,5 +414,5 @@
        CALL lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
 
-        do l=1,llm
+        DO l=1,llm
        d_t_adv(l) =  (dth_rico(l) +  dt_dyn(l))
        d_q_adv(l,1) = (dqh_rico(l) +  dq_dyn(l,1))
@@ -446,5 +446,5 @@
 
 ! Advective forcings are given in K or g/kg ... BY HOUR
-      do l = 1, llm
+      DO l = 1, llm
        ug(l)= u_mod(l)
        vg(l)= v_mod(l)
@@ -539,5 +539,5 @@
       tsurf = ts_prof
       WRITE(*,*) 'SST suivante: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        omega(l) = omega_mod(l)
        omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
@@ -620,5 +620,5 @@
       tsurf = ts_prof
       WRITE(*,*) 'SST suivante: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        omega(l) = w_mod(l)
        omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
@@ -715,9 +715,9 @@
 !wind nudging 
       IF (nudge_u.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
         enddo
       else
-        do l=1,llm
+        DO l=1,llm
         u(l) = u_mod_cas(l) 
         enddo
@@ -725,9 +725,9 @@
 
       IF (nudge_v.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
         enddo
       else
-        do l=1,llm
+        DO l=1,llm
         v(l) = v_mod_cas(l) 
         enddo
@@ -735,9 +735,9 @@
 
       IF (nudge_w.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
         enddo
       else
-        do l=1,llm
+        DO l=1,llm
         w(l) = w_mod_cas(l) 
         enddo
@@ -746,15 +746,15 @@
 !nudging of q and temp 
       IF (nudge_t.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
         enddo
       endif
       IF (nudge_q.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
         enddo
       endif
 
-      do l = 1, llm
+      DO l = 1, llm
        omega(l) = w_mod_cas(l)  ! juste car w_mod_cas en Pa/s (MPL 20170310)
        omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
@@ -905,5 +905,5 @@
 !geostrophic wind 
       IF (forc_geo.EQ.1) THEN
-        do l=1,llm
+        DO l=1,llm
         ug(l) = ug_mod_cas(l) 
         vg(l) = vg_mod_cas(l) 
@@ -912,5 +912,5 @@
 !wind nudging 
       IF (nudging_u.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
         enddo
@@ -922,5 +922,5 @@
 
       IF (nudging_v.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
         enddo
@@ -932,5 +932,5 @@
 
       IF (nudging_w.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
         enddo
@@ -943,15 +943,15 @@
 !nudging of q and temp 
       IF (nudging_t.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
         enddo
       endif
       IF (nudging_qv.gt.0.) THEN
-        do l=1,llm
+        DO l=1,llm
            q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
         enddo
       endif
 
-      do l = 1, llm
+      DO l = 1, llm
 ! Modif w_mod_cas -> omega_mod_cas (MM+MPL 20170309)
        omega(l) = omega_mod_cas(l)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_read_forc_cases.h	(revision 5158)
@@ -39,5 +39,5 @@
 ! compute altitudes of play levels.
       zlay(1) =zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
-      do l = 2,llm
+      DO l = 2,llm
         zlay(l) = zlay(l-1)+rd*tsurf*(psurf-play(1))/(rg*psurf)
       enddo
@@ -48,5 +48,5 @@
 !----------------------------------------------------------------------
       zlay(1) = zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
-      do l=1,llm
+      DO l=1,llm
         ! Above the max altutide of the input file
 
@@ -74,5 +74,5 @@
         dq_dyn(l,1) = dqtdtls(kmax)-frac*(dqtdtls(kmax)-dqtdtls(kmax-1))
         dt_cooling(l)=thlpcar(kmax)-frac*(thlpcar(kmax)-thlpcar(kmax-1))
-        do k=2,kmax
+        DO k=2,kmax
           print *,'k l height(k) height(k-1) zlay(l) frac=',k,l,height(k),height(k-1),zlay(l),frac
           frac = (height(k)-zlay(l))/(height(k)-height(k-1))
@@ -167,5 +167,5 @@
        mxcalc=llm
        print *, airefi, ' airefi '
-       do l = 1, llm
+       DO l = 1, llm
        rho(l)  = play(l)/(rd*t_rico(l)*(1.+(rv/rd-1.)*q_rico(l)))
        temp(l) = t_rico(l)
@@ -214,5 +214,5 @@
       tsurf = ts_prof
       WRITE(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod(l)
        q(l,1) = q_mod(l)
@@ -266,5 +266,5 @@
 !      tsurf = ts_proftwp
       WRITE(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod(l)
        q(l,1) = q_mod(l)
@@ -296,5 +296,5 @@
 
 !champs initiaux:
-      do k=1,nlev_amma
+      DO k=1,nlev_amma
          th_ammai(k)=th_amma(k)
          q_ammai(k)=q_amma(k)
@@ -322,5 +322,5 @@
 !      tsurf = ts_proftwp
       WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
-      do l = 1, llm
+      DO l = 1, llm
 ! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
 !      temp(l) = t_mod(l)*(play(l)/pzero)**rkappa 
@@ -372,5 +372,5 @@
 
 !champs initiaux:
-      do k=1,nlev_dice
+      DO k=1,nlev_dice
          t_dicei(k)=t_dice(k)
          qv_dicei(k)=qv_dice(k)
@@ -420,5 +420,5 @@
 ! initial and boundary conditions :
       WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
-      do l = 1, llm
+      DO l = 1, llm
 ! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
 !      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa 
@@ -480,5 +480,5 @@
       fich_gabls4='gabls4_driver.nc'
       
-       	
+
       CALL read_gabls4(fich_gabls4,nlev_gabls4,nt_gabls4,nsol_gabls4,zz_gabls4,depth_sn_gabls4,ug_gabls4,vg_gabls4 &
      & ,plev_gabls4,th_gabls4,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,ht_gabls4,hq_gabls4,tg_gabls4,tsnow_gabls4,snow_dens_gabls4)
@@ -487,5 +487,5 @@
 
 !champs initiaux:
-      do k=1,nlev_gabls4
+      DO k=1,nlev_gabls4
          t_gabi(k)=t_gabls4(k)
          qv_gabi(k)=qv_gabls4(k)
@@ -527,5 +527,5 @@
 ! initial and boundary conditions :
       WRITE(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
-      do l = 1, llm
+      DO l = 1, llm
 ! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
 !      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa 
@@ -539,5 +539,5 @@
        vg(l)=vg_mod(l)
 
-!	tg=tsurf
+!    tg=tsurf
 
        print *,'***** tsurf=',tsurf
@@ -637,5 +637,5 @@
 ! tsurf read in lmdz1d.def
       WRITE(*,*) 'Tsurf initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        play(l)=play_mod(l)*100.
        presnivs(l)=play(l)
@@ -670,5 +670,5 @@
 ! plev at half levels is given in proh.inp.19 or proh.inp.40 files
       plev(1)= ap(llm+1)+bp(llm+1)*psurf
-      do l = 1, llm
+      DO l = 1, llm
       plev(l+1) = ap(llm-l+1)+bp(llm-l+1)*psurf
       print *,'Read_forc: l height play plev zlay temp',                    &
@@ -733,5 +733,5 @@
       tsurf = ts_prof
       WRITE(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod(l)
        tetal(l)=thl_mod(l)
@@ -809,5 +809,5 @@
       tsurf = ts_prof
       WRITE(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod(l)
        tetal(l)=thl_mod(l)
@@ -873,5 +873,5 @@
       psurf=plev_prof_cas(1)
       WRITE(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod_cas(l)
        q(l,1) = q_mod_cas(l)
@@ -934,5 +934,5 @@
      &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
 
-      do l = 1, nlev_cas
+      DO l = 1, nlev_cas
       print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
       enddo
@@ -962,5 +962,5 @@
       psurf=plev_prof_cas(1)
       WRITE(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod_cas(l)
        q(l,1) = qv_mod_cas(l)
@@ -1032,5 +1032,5 @@
      &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
 
-      do l = 1, nlev_cas
+      DO l = 1, nlev_cas
       print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
       enddo
@@ -1061,5 +1061,5 @@
       psurf=plev_prof_cas(1)
       WRITE(*,*) 'SST initiale: ',tsurf
-      do l = 1, llm
+      DO l = 1, llm
        temp(l) = t_mod_cas(l)
        q(l,1) = qv_mod_cas(l)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/cargs.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/cargs.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/cargs.h	(revision 5158)
@@ -35,32 +35,32 @@
 
 void getarg_c_(const int *argno, char *arg
-	       /* Hidden argument */
-	       , const int arg_len);
+           /* Hidden argument */
+           , const int arg_len);
 
 void getarg_c (const int *argno, char *arg
-	       /* Hidden argument */
-	       , const int arg_len);
+           /* Hidden argument */
+           , const int arg_len);
 
 void putarg_c_(const int *argno, const char *arg
-	       /* Hidden argument */
-	       , int arg_len);
+           /* Hidden argument */
+           , int arg_len);
 
 void putarg_c (const int *argno, const char *arg
-	       /* Hidden argument */
-	       , int arg_len);
+           /* Hidden argument */
+           , int arg_len);
 
 void putarg_info_(const int *argc, const char *cterm
-		  /* Hidden argument */
-		  , int cterm_len);
+          /* Hidden argument */
+          , int cterm_len);
 
 void putarg_info (const int *argc, const char *cterm
-		  /* Hidden argument */
-		  , int cterm_len);
+          /* Hidden argument */
+          , int cterm_len);
 
 /* From ifsaux/support/cmpl_binding.F90 */
 
 void cmpl_getarg_(const int *argno, char *arg
-		  /* Hidden argument */
-		  , const int arg_len);
+          /* Hidden argument */
+          , const int arg_len);
 
 int cmpl_iargc_(); 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/drhook.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/drhook.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/drhook.h	(revision 5158)
@@ -147,19 +147,19 @@
 extern void
 c_drhook_watch_(const int *onoff,
-		const char *array_name,
-		const void *array_ptr,
-		const int *nbytes,
-		const int *abort_if_changed,
-		const int *printkey,
-		const int *nvals,
-		const int *print_traceback_when_set
-		/* Hidden length */
-		,int array_name_len);
+        const char *array_name,
+        const void *array_ptr,
+        const int *nbytes,
+        const int *abort_if_changed,
+        const int *printkey,
+        const int *nvals,
+        const int *print_traceback_when_set
+        /* Hidden length */
+        ,int array_name_len);
 
 extern void
 c_drhook_check_watch_(const char *where,
-		      const int *allow_abort
-		      /* Hidden length */
-		      , int where_len);
+              const int *allow_abort
+              /* Hidden length */
+              , int where_len);
 
 /* see dr_hook_prt.F90 for below */
@@ -172,7 +172,7 @@
 
 extern void ec_meminfo_(const int *KU, const char *CDSTRING, 
-			const int *KCOMM, const int *KBARR, 
-			const int *KIOTASK, const int *KCALL,
-			int len_CDSTRING); /* see ec_meminfo.F90 */
+            const int *KCOMM, const int *KBARR,
+            const int *KIOTASK, const int *KCALL,
+            int len_CDSTRING); /* see ec_meminfo.F90 */
 
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/easy_netcdf.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/easy_netcdf.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/easy_netcdf.F90	(revision 5158)
@@ -392,5 +392,5 @@
 
     ndimlens(:) = 0
-    do j = 1,ndims
+    DO j = 1,ndims
       istatus = nf90_inquire_dimension(this%ncid, idimids(j), len=ndimlens(j))
       if (istatus /= NF90_NOERR) then
@@ -404,5 +404,5 @@
     if (present(ntotal)) then
       ntotal = 1
-      do j = 1, ndims
+      DO j = 1, ndims
         ntotal = ntotal * ndimlens(j)
       end do
@@ -613,5 +613,5 @@
     ! Compute number of elements of the variable in the file
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
     end do
@@ -658,5 +658,5 @@
     ! Compute number of elements of the variable in the file
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
     end do
@@ -707,5 +707,5 @@
     ! i.e. excluding the slowest varying dimension, indexed by "index"
     ntotal = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       ntotal = ntotal * ndimlens(j)
     end do
@@ -761,5 +761,5 @@
     ! Ensure variable has only one dimension in the file
     n = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -819,5 +819,5 @@
     ! Ensure variable has only one dimension in the file
     n = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -878,5 +878,5 @@
     ! Ensure variable has only one dimension in the file
     n = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -938,5 +938,5 @@
     ! Ensure variable has only one dimension aside from the last one
     n = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -1021,5 +1021,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 2 .and. ndimlens(j) > 1) then
@@ -1133,5 +1133,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 2 .and. ndimlens(j) > 1) then
@@ -1202,5 +1202,5 @@
       vcount(1:2) = [ndimlen1,1]
       
-      do j = 1,ndimlen2
+      DO j = 1,ndimlen2
         vstart(2) = j
         istatus = nf90_get_var(this%ncid, ivarid, matrix(:,j), start=vstart, count=vcount)
@@ -1252,5 +1252,5 @@
     ! dimensions aside from the last one
     ntotal = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       ntotal = ntotal * ndimlens(j)
       if (j > 2 .and. ndimlens(j) > 1) then
@@ -1376,5 +1376,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 3 .and. ndimlens(j) > 1) then
@@ -1512,5 +1512,5 @@
     ! dimensions aside from the last one
     ntotal = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       ntotal = ntotal * ndimlens(j)
       if (j > 3 .and. ndimlens(j) > 1) then
@@ -1654,5 +1654,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 4 .and. ndimlens(j) > 1) then
@@ -1804,5 +1804,5 @@
 
     ! Pad with blanks since nf90_get_att does not do this
-    do j = i_attr_len+1,len(attr_str)
+    DO j = i_attr_len+1,len(attr_str)
       attr_str(j:j) = ' '
     end do
@@ -1878,5 +1878,5 @@
 
     ! Pad with blanks since nf90_get_att does not do this
-    do j = i_attr_len+1,len(attr_str)
+    DO j = i_attr_len+1,len(attr_str)
       attr_str(j:j) = ' '
     end do
@@ -2705,5 +2705,5 @@
     end if
 
-    do jdim = 1,ndims
+    DO jdim = 1,ndims
       istatus = nf90_inquire_dimension(infile%ncid, idimids(jdim), &
            &  name=dimname, len=dimlen)
@@ -2771,5 +2771,5 @@
 
     ! Map dimension IDs
-    do jdim = 1,ndims
+    DO jdim = 1,ndims
       istatus = nf90_inquire_dimension(infile%ncid, idimids_in(jdim), name=dim_name)
       if (istatus /= NF90_NOERR) then
@@ -2801,5 +2801,5 @@
 
     ! Copy attributes
-    do jattr = 1,nattr
+    DO jattr = 1,nattr
       istatus = nf90_inq_attname(infile%ncid, ivarid_in, jattr, attr_name)
       if (istatus /= NF90_NOERR) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/ecsort_shared.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/ecsort_shared.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/ecsort_shared.h	(revision 5158)
@@ -421,10 +421,10 @@
       if (imod == 0) iadd = 0
       ista(1) = 1
-      do j=2,inumt
+      DO j=2,inumt
         ista(j) = ista(j-1) + inc + iadd
         if (iadd > 0 .and. j > imod) iadd = 0
       enddo
       ista(inumt+1) = n + 1
-      do j=1,inumt
+      DO j=1,inumt
         ichunk(j) = ista(j+1) - ista(j)
       enddo
@@ -452,5 +452,5 @@
     ITID = OML_MY_THREAD()
 !$OMP DO SCHEDULE(DYNAMIC,1)
-    do j=1,inumt
+    DO j=1,inumt
       j1 = ista(j)
       inum = ichunk(j)
@@ -490,5 +490,5 @@
     inc = 2
     imax = (inumt+inc-1)/inc
-    do jj=1,imax
+    DO jj=1,imax
       if (LLdebug) write(0,1001) jj,'<before_merge> jj,inc,imax,inumt=',jj,inc,imax,inumt
 !$OMP PARALLEL PRIVATE(j,j1,j2,inum,iamax,ibmax,jmid,iret,ZHOOK_SUBHANDLE3,ITID)
@@ -496,5 +496,5 @@
       ITID = OML_MY_THREAD()
 !$OMP DO SCHEDULE(DYNAMIC,1)
-      do j=1,inumt,inc
+      DO j=1,inumt,inc
         j1 = j
         j2 = j + inc - 1
@@ -568,5 +568,5 @@
     allocate(data(n))
 !$OMP DO SCHEDULE(DYNAMIC,1)
-    do j=1,sda
+    DO j=1,sda
       data(1:n) = a(iindex(1:n),j)
       a(1:n,j) = data(1:n)
@@ -580,5 +580,5 @@
     allocate(data(n))
 !$OMP DO SCHEDULE(DYNAMIC,1)
-    do i=1,lda
+    DO i=1,lda
       data(1:n) = a(i,iindex(1:n))
       a(i,1:n) = data(1:n)
@@ -613,5 +613,5 @@
 WRITE(0,1000) jj,cdstr//': n,key,k1,k2,kadd,a(index(k1:k2)+kadd,:)=',&
      &                     n,key,k1,k2,kadd
-do j=k1,k2
+DO j=k1,k2
   i = index(j)+kadd
   WRITE(0,'(2i6)',advance='no') j,i-kadd
@@ -649,5 +649,5 @@
   i = left
   j = 2*left
-  do while (j <= right)
+  DO while (j <= right)
     if (j < right) then
       if (a(index(j)) < a(index(j+1))) j = j + 1
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/privpub.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/privpub.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/privpub.h	(revision 5158)
@@ -131,6 +131,6 @@
 
 extern void abor1fl_(const char *filename, const int *linenum, 
-		     const char *s, 
-		     int filenamelen, int slen);
+             const char *s,
+             int filenamelen, int slen);
 extern void abor1_(const char *s, int slen);
 
@@ -485,7 +485,7 @@
 #ifdef LITTLE
   unsigned int pmethod:8; /* Value 0 .. 255 ; 
-			     0 means not packed;
-			     1,2,3,5,9,11-19,21-29 methods implemented
-			     255 means not really packed, but PCMA-header exists for MDI's */
+                 0 means not packed;
+                 1,2,3,5,9,11-19,21-29 methods implemented
+                 255 means not really packed, but PCMA-header exists for MDI's */
 
   unsigned int signbit:1;  /* signed = 1, unsigned = 0 */
@@ -496,48 +496,48 @@
 
   unsigned int base_type:2; /* other = 0, int = 1, flp = 2, complex flp = 3 
-			       notes: 
-			       - if other, look for other_type
-			       - precion_bits used for length as 2^precision_bits
-			       - if int, check also signed/unsigned part
-			    */
+                   notes:
+                   - if other, look for other_type
+                   - precion_bits used for length as 2^precision_bits
+                   - if int, check also signed/unsigned part
+                */
   
   unsigned int other_type:14; /* used when base_type == 0 ; currently defined
-				 undefined   = 00 000 000 000 000 =     0 = 0x0
-				 Bitfield    = 00 000 000 000 001 =     1 = 0x1
-				 (note: also precision_bits must be 5 i.e. 2^5 == 32; 
-				 preferably unsigned)
-				 string      = 00 000 000 000 010 =     2 = 0x2 
-				 (note: alias to char(8); 
-				 also precision_bits should be 3 i.e. 2^3 == 8 bytes;
-				 byte_swappable must be == 0 i.e. raw)
-				 yyyymmdd    = 00 000 000 000 100 =     4 = 0x4
-				 (note: preferably unsigned)
-				 hhmmss      = 00 000 000 001 000 =     8 = 0x8
-				 (note: preferably unsigned)
-				 linkoffset_t = 00 000 000 010 000 =    16 = 0x10
-				 (note: preferably unsigned)
-				 linklen_t    = 00 000 000 100 000 =    32 = 0x20
-				 (note: preferably unsigned)
-				 bufr-data   = 00 000 001 000 000 =    64 = 0x40
-				 (note: also byte_swappable must be == 0 i.e. raw;
-				 also precision_bits must be 5 i.e. 2^5 == 32)
-				 grib-data   = 00 000 010 000 000 =   128 = 0x80
-				 (note: also byte_swappable must be == 0 i.e. raw;
-				 also precision_bits must be 5 i.e. 2^5 == 32)
-				 blob        = 00 000 100 000 000 =   256 = 0x100
-				 (note: precision_bits used for length; up to 2^16 bytes; enough ?;
-				 byte_swappable must be == 0 i.e. raw)
-				 long blob   = 00 001 000 000 000 =  512 = 0x200
-				 (note: precision_bits used for length; up to 2^31 bytes; enough ?;
-				 byte_swappable must be == 0 i.e. raw)
-				 char        = 00 010 000 000 000 =  1024 = 0x400
-				 (note: precision_bits used for length;
-				 byte_swappable must be == 0 i.e. raw)
-				 varchar     = 00 100 000 000 000 =  2048 = 0x800
-				 (note: precision_bits used for maximum length;
-				 byte_swappable must be == 0 i.e. raw)
-				 reserved_1  = 01 000 000 000 000 =  4096 = 0x1000
-				 reserved_2  = 10 000 000 000 000 =  8192 = 0x2000
-			      */ 
+                 undefined   = 00 000 000 000 000 =     0 = 0x0
+                 Bitfield    = 00 000 000 000 001 =     1 = 0x1
+                 (note: also precision_bits must be 5 i.e. 2^5 == 32;
+                 preferably unsigned)
+                 string      = 00 000 000 000 010 =     2 = 0x2
+                 (note: alias to char(8);
+                 also precision_bits should be 3 i.e. 2^3 == 8 bytes;
+                 byte_swappable must be == 0 i.e. raw)
+                 yyyymmdd    = 00 000 000 000 100 =     4 = 0x4
+                 (note: preferably unsigned)
+                 hhmmss      = 00 000 000 001 000 =     8 = 0x8
+                 (note: preferably unsigned)
+                 linkoffset_t = 00 000 000 010 000 =    16 = 0x10
+                 (note: preferably unsigned)
+                 linklen_t    = 00 000 000 100 000 =    32 = 0x20
+                 (note: preferably unsigned)
+                 bufr-data   = 00 000 001 000 000 =    64 = 0x40
+                 (note: also byte_swappable must be == 0 i.e. raw;
+                 also precision_bits must be 5 i.e. 2^5 == 32)
+                 grib-data   = 00 000 010 000 000 =   128 = 0x80
+                 (note: also byte_swappable must be == 0 i.e. raw;
+                 also precision_bits must be 5 i.e. 2^5 == 32)
+                 blob        = 00 000 100 000 000 =   256 = 0x100
+                 (note: precision_bits used for length; up to 2^16 bytes; enough ?;
+                 byte_swappable must be == 0 i.e. raw)
+                 long blob   = 00 001 000 000 000 =  512 = 0x200
+                 (note: precision_bits used for length; up to 2^31 bytes; enough ?;
+                 byte_swappable must be == 0 i.e. raw)
+                 char        = 00 010 000 000 000 =  1024 = 0x400
+                 (note: precision_bits used for length;
+                 byte_swappable must be == 0 i.e. raw)
+                 varchar     = 00 100 000 000 000 =  2048 = 0x800
+                 (note: precision_bits used for maximum length;
+                 byte_swappable must be == 0 i.e. raw)
+                 reserved_1  = 01 000 000 000 000 =  4096 = 0x1000
+                 reserved_2  = 10 000 000 000 000 =  8192 = 0x2000
+                  */
 #else /* Big endian */
   unsigned int other_type:14;
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_adding_ica_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_adding_ica_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_adding_ica_lw.F90	(revision 5158)
@@ -83,5 +83,5 @@
     ! also the "source", which is the upwelling flux due to emission
     ! below that level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       ! Next loop over columns. We could do this by indexing the
       ! entire inner dimension as follows, e.g. for the first line:
@@ -90,5 +90,5 @@
       ! routine by a factor of 2!  Rather, we do it with an explicit
       ! loop.
-      do jcol = 1,ncol
+      DO jcol = 1,ncol
         ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
         inv_denominator(jcol,jlev) = 1.0_jprb &
@@ -114,6 +114,6 @@
     ! Work back down through the atmosphere computing the fluxes at
     ! each half-level
-    do jlev = 1,nlev
-      do jcol = 1,ncol
+    DO jlev = 1,nlev
+      DO jcol = 1,ncol
         ! Shonk & Hogan (2008) Eq 14 (after simplification):
         flux_dn(jcol,jlev+1) &
@@ -201,8 +201,8 @@
     ! also the "source", which is the upwelling flux due to emission
     ! below that level
-    do jlev = nlev,i_cloud_top,-1
+    DO jlev = nlev,i_cloud_top,-1
       if (is_clear_sky_layer(jlev)) then
         ! Reflectance of this layer is zero, simplifying the expression
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           albedo(jcol,jlev) = transmittance(jcol,jlev)*transmittance(jcol,jlev)*albedo(jcol,jlev+1)
           source(jcol,jlev) = source_up(jcol,jlev) &
@@ -212,5 +212,5 @@
       else
         ! Loop over columns; explicit loop seems to be faster
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
           inv_denominator(jcol,jlev) = 1.0_jprb &
@@ -231,5 +231,5 @@
     flux_up(:,i_cloud_top) = source(:,i_cloud_top) &
          &                 + albedo(:,i_cloud_top)*flux_dn(:,i_cloud_top)
-    do jlev = i_cloud_top-1,1,-1
+    DO jlev = i_cloud_top-1,1,-1
       flux_up(:,jlev) = transmittance(:,jlev)*flux_up(:,jlev+1) + source_up(:,jlev)
     end do
@@ -237,7 +237,7 @@
     ! Work back down through the atmosphere from cloud top computing
     ! the fluxes at each half-level
-    do jlev = i_cloud_top,nlev
+    DO jlev = i_cloud_top,nlev
       if (is_clear_sky_layer(jlev)) then
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           flux_dn(jcol,jlev+1) = transmittance(jcol,jlev)*flux_dn(jcol,jlev) &
                &               + source_dn(jcol,jlev)
@@ -246,5 +246,5 @@
         end do
       else
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           ! Shonk & Hogan (2008) Eq 14 (after simplification):
           flux_dn(jcol,jlev+1) &
@@ -309,6 +309,6 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = 1,nlev
-      do jcol = 1,ncol
+    DO jlev = 1,nlev
+      DO jcol = 1,ncol
         flux_dn(jcol,jlev+1) = transmittance(jcol,jlev)*flux_dn(jcol,jlev) + source_dn(jcol,jlev)
       end do
@@ -322,6 +322,6 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = nlev,1,-1
-      do jcol = 1,ncol
+    DO jlev = nlev,1,-1
+      DO jcol = 1,ncol
         flux_up(jcol,jlev) = transmittance(jcol,jlev)*flux_up(jcol,jlev+1) + source_up(jcol,jlev)
       end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_adding_ica_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_adding_ica_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_adding_ica_sw.F90	(revision 5158)
@@ -84,5 +84,5 @@
     ! half-level by working down through the atmosphere
     flux_dn_direct(:,1) = incoming_toa
-    do jlev = 1,nlev
+    DO jlev = 1,nlev
       flux_dn_direct(:,jlev+1) = flux_dn_direct(:,jlev)*trans_dir_dir(:,jlev)
     end do
@@ -100,5 +100,5 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       ! Next loop over columns. We could do this by indexing the
       ! entire inner dimension as follows, e.g. for the first line:
@@ -107,5 +107,5 @@
       ! routine by a factor of 2!  Rather, we do it with an explicit
       ! loop.
-      do jcol = 1,ncol
+      DO jcol = 1,ncol
         ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
         inv_denominator(jcol,jlev) = 1.0_jprb / (1.0_jprb-albedo(jcol,jlev+1)*reflectance(jcol,jlev))
@@ -132,6 +132,6 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = 1,nlev
-      do jcol = 1,ncol
+    DO jlev = 1,nlev
+      DO jcol = 1,ncol
         ! Shonk & Hogan (2008) Eq 14 (after simplification):
         flux_dn_diffuse(jcol,jlev+1) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics.F90	(revision 5158)
@@ -241,5 +241,5 @@
 
       if (ao%use_hydrophilic) then
-        do jtype = 1,n_type_philic
+        DO jtype = 1,n_type_philic
           ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
           ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
@@ -264,5 +264,5 @@
 
       if (ao%use_hydrophilic) then
-        do jtype = 1,n_type_philic
+        DO jtype = 1,n_type_philic
           ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
           ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
@@ -278,5 +278,5 @@
     if (allocated(ao%wavelength_mono)) then
       ! Monochromatic wavelengths also required
-      do jwl = 1,nmono
+      DO jwl = 1,nmono
         ! Wavelength (m) to wavenumber (cm-1)
         wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl)
@@ -290,5 +290,5 @@
         else
           iwn = 1
-          do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
+          DO while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
             iwn = iwn + 1
           end do
@@ -408,5 +408,5 @@
 
       if (ao%use_hydrophilic) then
-        do jtype = 1,ao%n_type_philic
+        DO jtype = 1,ao%n_type_philic
           ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype))
           ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype) &
@@ -440,5 +440,5 @@
 
       if (ao%use_hydrophilic) then
-        do jtype = 1,ao%n_type_philic
+        DO jtype = 1,ao%n_type_philic
           ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype))
           ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype) &
@@ -560,5 +560,5 @@
       ! Aerosol mixing ratios have been provided
 
-      do jtype = 1,config%n_aerosol_types
+      DO jtype = 1,config%n_aerosol_types
         if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
           write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
@@ -593,6 +593,6 @@
 
       ! Loop over position
-      do jlev = istartlev,iendlev
-        do jcol = istartcol,iendcol
+      DO jlev = istartlev,iendlev
+        DO jcol = istartcol,iendcol
           ! Compute relative humidity with respect to liquid
           ! saturation and the index to the relative-humidity index of
@@ -613,5 +613,5 @@
           scat_g_lw_aerosol = 0.0_jprb
 
-          do jtype = 1,config%n_aerosol_types
+          DO jtype = 1,config%n_aerosol_types
 
             itype = ao%itype(jtype)
@@ -623,5 +623,5 @@
             ! dimension being spectral band.
             if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
-              do jband = 1,config%n_bands_sw
+              DO jband = 1,config%n_bands_sw
                 local_od_sw(jband) = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
                      &  * ao%mass_ext_sw_phobic(jband,itype)
@@ -654,5 +654,5 @@
               ! Hydrophilic aerosols require the look-up tables to
               ! be indexed with irh
-              do jband = 1,config%n_bands_sw
+              DO jband = 1,config%n_bands_sw
                 local_od_sw(jband) = factor * aerosol%mixing_ratio(jcol,jlev,jtype) &
                      &  * ao%mass_ext_sw_philic(jband,irh,itype)
@@ -700,5 +700,5 @@
           ! properties (noting that any gas scattering will have an
           ! asymmetry factor of zero)
-          do jg = 1,config%n_g_sw
+          DO jg = 1,config%n_g_sw
             iband = config%i_band_from_reordered_g_sw(jg)
             local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband)
@@ -725,5 +725,5 @@
                  &                         scat_g_lw_aerosol)  
 
-            do jg = 1,config%n_g_lw
+            DO jg = 1,config%n_g_lw
               iband = config%i_band_from_reordered_g_lw(jg)
               local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband)
@@ -740,5 +740,5 @@
             end do
           else
-            do jg = 1,config%n_g_lw
+            DO jg = 1,config%n_g_lw
               od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
                    &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg))
@@ -830,9 +830,9 @@
 
       ! Loop over position
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
 ! Added for DWD (2020)
 !NEC$ forced_collapse
-        do jlev = istartlev,iendlev
-          do jb = 1,config%n_bands_sw
+        DO jlev = istartlev,iendlev
+          DO jb = 1,config%n_bands_sw
             od_sw_aerosol(jb,jlev) = aerosol%od_sw(jb,jlev,jcol)
             scat_sw_aerosol(jb,jlev) = aerosol%ssa_sw(jb,jlev,jcol) * od_sw_aerosol(jb,jlev)
@@ -852,7 +852,7 @@
         ! properties (noting that any gas scattering will have an
         ! asymmetry factor of zero)
-        do jlev = istartlev,iendlev
+        DO jlev = istartlev,iendlev
           if (od_sw_aerosol(1,jlev) > 0.0_jprb) then
-            do jg = 1,config%n_g_sw
+            DO jg = 1,config%n_g_sw
               iband = config%i_band_from_reordered_g_sw(jg)
               local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband,jlev)
@@ -890,9 +890,9 @@
  
         ! Loop over position
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
 ! Added for DWD (2020)
 !NEC$ forced_collapse
-          do jlev = istartlev,iendlev
-            do jb = 1,config%n_bands_lw
+          DO jlev = istartlev,iendlev
+            DO jb = 1,config%n_bands_lw
               od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol)
               scat_lw_aerosol(jb,jlev) = aerosol%ssa_lw(jb,jlev,jcol) * od_lw_aerosol(jb,jlev)
@@ -903,6 +903,6 @@
             end do
           end do
-          do jlev = istartlev,iendlev
-            do jg = 1,config%n_g_lw
+          DO jlev = istartlev,iendlev
+            DO jg = 1,config%n_g_lw
               iband = config%i_band_from_reordered_g_lw(jg)
               if (od_lw_aerosol(iband,jlev) > 0.0_jprb) then
@@ -924,18 +924,18 @@
 
         ! Loop over position
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
 ! Added for DWD (2020)
 !NEC$ forced_collapse
-          do jlev = istartlev,iendlev
+          DO jlev = istartlev,iendlev
             ! If aerosol longwave scattering is not included then we
             ! weight the optical depth by the single scattering
             ! co-albedo
-            do jb = 1, config%n_bands_lw
+            DO jb = 1, config%n_bands_lw
               od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol) &
                  &  * (1.0_jprb - aerosol%ssa_lw(jb,jlev,jcol))
             end do
           end do
-          do jlev = istartlev,iendlev
-            do jg = 1,config%n_g_lw
+          DO jlev = istartlev,iendlev
+            DO jg = 1,config%n_g_lw
               od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
                    &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg),jlev)
@@ -1049,5 +1049,5 @@
     if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_extinction',0,hook_handle)
 
-    do jtype = 1,config%n_aerosol_types
+    DO jtype = 1,config%n_aerosol_types
       if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
         write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
@@ -1067,10 +1067,10 @@
 
     ! Loop over position
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ext = 0.0_jprb
       ! Get relative-humidity index
       irh = ao%calc_rh_index(relative_humidity(jcol))
       ! Add extinction coefficients from each aerosol type
-      do jtype = 1,config%n_aerosol_types
+      DO jtype = 1,config%n_aerosol_types
         if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
           ext = ext + mixing_ratio(jcol,jtype) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_data.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_data.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_data.F90	(revision 5158)
@@ -613,5 +613,5 @@
     iend   = ubound(itypes,1)
 
-    do jtype = istart, iend
+    DO jtype = istart, iend
       if (itypes(jtype) == 0) then
         call this%set_empty_type(jtype)
@@ -649,5 +649,5 @@
     else
       calc_rh_index = 1
-      do while (rh > this%rh_lower(calc_rh_index + 1))
+      DO while (rh > this%rh_lower(calc_rh_index + 1))
         calc_rh_index = calc_rh_index + 1
       end do
@@ -676,5 +676,5 @@
     end if
 
-    do jtype = 1,size(i_type_map)
+    DO jtype = 1,size(i_type_map)
       if (i_type_map(jtype) > 0) then
         write(nulout,'(i4,a,a)') jtype, ' -> hydrophobic type ', &
@@ -708,5 +708,5 @@
 
     ! Find index of first character
-    do while (i_line_current < iline)
+    DO while (i_line_current < iline)
       i_start_new = scan(str(istart:iend), new_line(' '))
       if (i_start_new == 0) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_description.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_description.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_description.F90	(revision 5158)
@@ -137,5 +137,5 @@
 
     ! Loop over hydrophilic types
-    do ja = 1,size(this%bin_philic)
+    DO ja = 1,size(this%bin_philic)
       ! Check if we have a match
       if (to_string(this%code_philic(:,ja)) == code_str &
@@ -146,5 +146,5 @@
     end do
     ! Repeat for the hydrophobic types
-    do ja = 1,size(this%bin_phobic)
+    DO ja = 1,size(this%bin_phobic)
       if (to_string(this%code_phobic(:,ja)) == code_str &
            &  .and. to_string(this%optical_model_phobic(1:len(optical_model_str),ja)) &
@@ -207,5 +207,5 @@
     if (lhydrophilic) then
       ! Loop over hydrophilic aerosol types
-      do ja = 1,size(this%bin_philic)
+      DO ja = 1,size(this%bin_philic)
         current_score = 0
         if (to_string(this%code_philic(:,ja)) == code_str) then
@@ -258,5 +258,5 @@
     else
       ! Loop over hydrophobic aerosol types
-      do ja = 1,size(this%bin_phobic)
+      DO ja = 1,size(this%bin_phobic)
         current_score = 0
         if (to_string(this%code_phobic(:,ja)) == code_str) then
@@ -325,5 +325,5 @@
     character(len=size(arr)) :: str
     integer :: jc
-    do jc = 1,size(arr)
+    DO jc = 1,size(arr)
       str(jc:jc) = arr(jc)
     end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud.F90	(revision 5158)
@@ -247,5 +247,5 @@
       ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we
       ! don't take the logarithm of the first pressure in each column.
-      do jcol = i1,i2
+      DO jcol = i1,i2
         this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length) &
              &                            * thermodynamics%temperature_hl(jcol,2) &
@@ -254,6 +254,6 @@
       end do
 
-      do jlev = 2,nlev-1
-        do jcol = i1,i2
+      DO jlev = 2,nlev-1
+        DO jcol = i1,i2
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -267,6 +267,6 @@
        ! to top-of-atmosphere).  In case pressure_hl(:,nlev+1)=0, we
        ! don't take the logarithm of the last pressure in each column.
-      do jlev = 1,nlev-2
-        do jcol = i1,i2
+      DO jlev = 1,nlev-2
+        DO jcol = i1,i2
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -276,5 +276,5 @@
       end do
 
-      do jcol = i1,i2
+      DO jcol = i1,i2
         this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length) &
             &                            * thermodynamics%temperature_hl(jcol,nlev) &
@@ -487,5 +487,5 @@
     end if
 
-    do jcol = i1,i2
+    DO jcol = i1,i2
       eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) &
            &  * (0.5_jprb / pressure_hl(jcol,isurf))
@@ -585,5 +585,5 @@
     end if
 
-    do jcol = i1,i2
+    DO jcol = i1,i2
       eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) &
            &  * (0.5_jprb / pressure_hl(jcol,isurf))
@@ -628,14 +628,14 @@
     ntype = size(this%mixing_ratio,3)
     
-    do jlev = 1,nlev
-      do jcol = istartcol,iendcol
+    DO jlev = 1,nlev
+      DO jcol = istartcol,iendcol
         sum_mixing_ratio(jcol) = 0.0_jprb
       end do
-      do jh = 1, ntype
-        do jcol = istartcol,iendcol
+      DO jh = 1, ntype
+        DO jcol = istartcol,iendcol
           sum_mixing_ratio(jcol) = sum_mixing_ratio(jcol) + this%mixing_ratio(jcol,jlev,jh)
         end do
       end do
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         if (this%fraction(jcol,jlev)        < cloud_fraction_threshold &
              &  .or. sum_mixing_ratio(jcol) < cloud_mixing_ratio_threshold) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_cover.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_cover.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_cover.F90	(revision 5158)
@@ -157,5 +157,5 @@
     cum_product = 1.0_jprb - frac(1)
     cum_cloud_cover(1) = frac(1)
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
       ! Compute the combined cloud cover of layers jlev and jlev+1
       pair_cloud_cover(jlev) = max(frac(jlev),frac(jlev+1))
@@ -240,5 +240,5 @@
     cum_product = 1.0_jprb - frac(1)
     cum_cloud_cover(1) = frac(1)
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
       ! Convert to "alpha" overlap parameter if necessary
       if (do_overlap_conversion) then
@@ -256,5 +256,5 @@
 #ifdef __SX__
     end do
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
 #endif
       if (frac(jlev) >= MaxCloudFrac) then
@@ -383,5 +383,5 @@
     jlev = 1
     nobj = 0
-    do while (jlev <= nlev)
+    DO while (jlev <= nlev)
       if (frac(jlev) > min_frac) then
         ! Starting a new object: store its top
@@ -390,5 +390,5 @@
         ! Find its maximum cloud fraction
         jlev = jlev + 1
-        do while (jlev <= nlev) 
+        DO while (jlev <= nlev)
           if (frac(jlev) < frac(jlev-1)) then
             exit
@@ -398,5 +398,5 @@
         i_max_obj(nobj) = jlev - 1
         ! Find its base
-        do while (jlev <= nlev)
+        DO while (jlev <= nlev)
           if (frac(jlev) > frac(jlev-1) .or. frac(jlev) <= min_frac) then
             exit
@@ -433,5 +433,5 @@
 
         ! Compute the combined cloud cover of pairs of layers
-        do jlev = 1,nlev-1
+        DO jlev = 1,nlev-1
           pair_cloud_cover(jlev) &
                &  = overlap_param(jlev)*max(frac(jlev),frac(jlev+1)) &
@@ -442,5 +442,5 @@
         ! adjacent objects as the product of the layerwise overlap
         ! parameters between their layers of maximum cloud fraction
-        do jobj = 1,nobj-1
+        DO jobj = 1,nobj-1
           alpha_obj(jobj) &
                &  = product(overlap_param(i_max_obj(jobj):i_max_obj(jobj+1)-1))
@@ -454,5 +454,5 @@
              &                     frac(1:nlev-1), frac(2:nlev))
         ! Compute the combined cloud cover of pairs of layers
-        do jlev = 1,nlev-1
+        DO jlev = 1,nlev-1
           pair_cloud_cover(jlev) &
                &  = overlap_alpha(jlev)*max(frac(jlev),frac(jlev+1)) &
@@ -463,5 +463,5 @@
         ! adjacent objects as the product of the layerwise overlap
         ! parameters between their layers of maximum cloud fraction
-        do jobj = 1,nobj-1
+        DO jobj = 1,nobj-1
           alpha_obj(jobj) &
                &  = product(overlap_alpha(i_max_obj(jobj):i_max_obj(jobj+1)-1))
@@ -474,7 +474,7 @@
       ! of each object: this will later be converted to the cumulative
       ! cloud cover working down from TOA
-      do jobj = 1,nobj
+      DO jobj = 1,nobj
         cum_cloud_cover(i_top_obj(jobj)) = frac(i_top_obj(jobj))
-        do jlev = i_top_obj(jobj), i_base_obj(jobj)-1
+        DO jlev = i_top_obj(jobj), i_base_obj(jobj)-1
           if (frac(jlev) >= MaxCloudFrac) then
             ! Cloud cover has reached one
@@ -494,5 +494,5 @@
       ! Sequentially combine objects until there is only one left
       ! covering the full vertical extent of clouds in the profile
-      do while (nobj > 1)
+      DO while (nobj > 1)
         ! Find the most correlated adjacent pair of objects
         alpha_max = 0.0_jprb
@@ -504,5 +504,5 @@
 
         jobj = 1
-        do while (jobj < nobj)
+        DO while (jobj < nobj)
           if (alpha_obj(jobj) > alpha_max) then
             alpha_max = alpha_obj(jobj)
@@ -531,5 +531,5 @@
         ! Scale the combined cloud cover of the lower object to
         ! account for its overlap with the upper object
-        do jlev = i_top_obj(iobj2),i_base_obj(iobj2)
+        DO jlev = i_top_obj(iobj2),i_base_obj(iobj2)
           cum_cloud_cover(jlev) = cum_cloud_cover(i_base_obj(iobj1)) &
                +  cum_cloud_cover(jlev) * scaling
@@ -552,5 +552,5 @@
       ! Ensure that the combined cloud cover of pairs of layers is
       ! consistent with the overhang
-      do jlev = 1,nlev-1
+      DO jlev = 1,nlev-1
         pair_cloud_cover(jlev) = max(pair_cloud_cover(jlev), &
              &     frac(jlev)+cum_cloud_cover(jlev+1)-cum_cloud_cover(jlev))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_generator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_generator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_generator.F90	(revision 5158)
@@ -152,5 +152,5 @@
 
     total_cloud_cover = cum_cloud_cover(nlev);
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
       overhang(jlev) = cum_cloud_cover(jlev+1)-cum_cloud_cover(jlev)
     end do
@@ -166,10 +166,10 @@
       ! Find range of cloudy layers
       jlev = 1
-      do while (frac(jlev) <= 0.0_jprb) 
+      DO while (frac(jlev) <= 0.0_jprb)
         jlev = jlev + 1
       end do
       ibegin = jlev
       iend = jlev
-      do jlev = jlev+1,nlev
+      DO jlev = jlev+1,nlev
         if (frac(jlev) > 0.0_jprb) then
           iend = jlev
@@ -180,5 +180,5 @@
       overlap_param_inhom = overlap_param
 
-      do jlev = ibegin,iend-1
+      DO jlev = ibegin,iend-1
         if (overlap_param(jlev) > 0.0_jprb) then
           overlap_param_inhom(jlev) &
@@ -208,10 +208,10 @@
         
         ! Loop over ng columns
-        do jg = 1,ng
+        DO jg = 1,ng
           ! Find the cloud top height corresponding to the current
           ! random number, and store in itrigger
           trigger = rand_top(jg) * total_cloud_cover
           jlev = ibegin
-          do while (trigger > cum_cloud_cover(jlev) .and. jlev < iend)
+          DO while (trigger > cum_cloud_cover(jlev) .and. jlev < iend)
             jlev = jlev + 1
           end do
@@ -328,5 +328,5 @@
     ! Loop from the layer below the local cloud top down to the
     ! bottom-most cloudy layer
-    do jlev = itrigger+1,iend+1
+    DO jlev = itrigger+1,iend+1
       do_fill_od_scaling = .false.
       if (jlev <= iend) then
@@ -367,5 +367,5 @@
 
         ! Loop through the sequence of cloudy layers
-        do jcloud = 2,n_layers_to_scale
+        DO jcloud = 2,n_layers_to_scale
           ! Use second random number, and inhomogeneity overlap
           ! parameter, to decide whether the first random number
@@ -464,5 +464,5 @@
     ! Loop from the layer below the local cloud top down to the
     ! bottom-most cloudy layer
-    do jlev = itrigger+1,iend
+    DO jlev = itrigger+1,iend
       iy = iy+1
       if (is_cloudy(jlev-1)) then
@@ -495,5 +495,5 @@
         
     ! Loop through the sequence of cloudy layers
-    do jcloud = 2,n_layers_to_scale
+    DO jcloud = 2,n_layers_to_scale
       ! Use second random number, and inhomogeneity overlap
       ! parameter, to decide whether the first random number
@@ -675,5 +675,5 @@
 
     ! Loop down through layers starting at the first cloudy layer
-    do jlev = ibegin,iend
+    DO jlev = ibegin,iend
 
       if (is_any_cloud(jlev)) then
@@ -681,5 +681,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-        do jg = 1,ng
+        DO jg = 1,ng
           ! The intention is that all these operations are vectorizable,
           ! since all are vector operations on vectors of length ng...
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_optics.F90	(revision 5158)
@@ -294,6 +294,6 @@
     end if
 
-    do jlev = 1,nlev
-      do jcol = istartcol,iendcol
+    DO jlev = 1,nlev
+      DO jcol = istartcol,iendcol
         ! Only do anything if cloud is present (assume that
         ! cloud%crop_cloud_fraction has already been called)
@@ -463,5 +463,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-            do jb = 1, config%n_bands_lw
+            DO jb = 1, config%n_bands_lw
               od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) + od_lw_ice(jb)
               if (scat_od_lw_liq(jb)+scat_od_lw_ice(jb) > 0.0_jprb) then
@@ -481,5 +481,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-            do jb = 1, config%n_bands_lw
+            DO jb = 1, config%n_bands_lw
               od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) - scat_od_lw_liq(jb) &
                     &                   + od_lw_ice(jb) - scat_od_lw_ice(jb)
@@ -488,5 +488,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-          do jb = 1, config%n_bands_sw
+          DO jb = 1, config%n_bands_sw
             od_sw_cloud(jb,jlev,jcol) = od_sw_liq(jb) + od_sw_ice(jb)
             g_sw_cloud(jb,jlev,jcol) = (g_sw_liq(jb) * scat_od_sw_liq(jb) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloudless_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloudless_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloudless_lw.F90	(revision 5158)
@@ -95,9 +95,9 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       ! Compute the reflectance and transmittance of all layers,
       ! neglecting clouds
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_lw_aerosol_scattering) then
           ! Scattering case: first compute clear-sky reflectance,
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloudless_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloudless_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloudless_sw.F90	(revision 5158)
@@ -103,5 +103,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ! Only perform calculation if sun above the horizon
       if (single_level%cos_sza(jcol) > 0.0_jprb) then
@@ -114,5 +114,5 @@
           ! Delta-Eddington scaling has already been performed to the
           ! aerosol part of od, ssa and g
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             call calc_two_stream_gammas_sw(ng, cos_sza, &
                  &  ssa(:,jlev,jcol), g(:,jlev,jcol), &
@@ -128,5 +128,5 @@
         else
           ! Apply delta-Eddington scaling to the aerosol-gas mixture
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             od_total  =  od(:,jlev,jcol)
             ssa_total = ssa(:,jlev,jcol)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_config.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_config.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_config.F90	(revision 5158)
@@ -1556,5 +1556,5 @@
     ! contains the weights of interest.  We now find the non-zero weights
     nweights = 0
-    do jband = 1,size(mapping,2)
+    DO jband = 1,size(mapping,2)
       if (mapping(2,jband) > 0.0_jprb) then
         nweights = nweights+1
@@ -1573,9 +1573,9 @@
            &  wavenumber2, ' cm-1):'
       if (this%do_cloud_aerosol_per_sw_g_point) then
-        do jband = 1, nweights
+        DO jband = 1, nweights
           write(nulout, '(a,i0,a,f8.4)') '  Shortwave g point ', iband(jband), ': ', weight(jband)
         end do
       else
-        do jband = 1, nweights
+        DO jband = 1, nweights
           wavenumber1_band = this%gas_optics_sw%spectral_def%wavenumber1_band(iband(jband))
           wavenumber2_band = this%gas_optics_sw%spectral_def%wavenumber2_band(iband(jband))
@@ -1722,5 +1722,5 @@
     ! Count the number of albedo/emissivity intervals
     ninterval = 0
-    do jint = 1,NMaxAlbedoIntervals
+    DO jint = 1,NMaxAlbedoIntervals
       if (this%i_sw_albedo_index(jint) > 0) then
         ninterval = jint
@@ -1776,5 +1776,5 @@
         write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', size(this%i_albedo_from_band_sw), &
              &  ' shortwave intervals to albedo intervals:'
-        do jband = 1,size(this%i_albedo_from_band_sw)
+        DO jband = 1,size(this%i_albedo_from_band_sw)
           write(nulout,'(a,i0)',advance='no') ' ', this%i_albedo_from_band_sw(jband)
         end do
@@ -1800,5 +1800,5 @@
     ! Count the number of albedo/emissivity intervals
     ninterval = 0
-    do jint = 1,NMaxAlbedoIntervals
+    DO jint = 1,NMaxAlbedoIntervals
       if (this%i_lw_emiss_index(jint) > 0) then
         ninterval = jint
@@ -1854,5 +1854,5 @@
         write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', size(this%i_emiss_from_band_lw), &
              &  ' longwave intervals to emissivity intervals:'
-        do jband = 1,size(this%i_emiss_from_band_lw)
+        DO jband = 1,size(this%i_emiss_from_band_lw)
           write(nulout,'(a,i0)',advance='no') ' ', this%i_emiss_from_band_lw(jband)
         end do
@@ -1884,5 +1884,5 @@
       is_not_found = .true.
 
-      do jc = 0,size(enum_str)-1
+      DO jc = 0,size(enum_str)-1
         if (trim(str) == trim(enum_str(jc))) then
           icode = jc
@@ -1894,5 +1894,5 @@
         write(nulerr,'(a,a,a,a,a)',advance='no') '*** Error: ', trim(var_name), &
              &  ' must be one of: "', enum_str(0), '"'
-        do jc = 1,size(enum_str)-1
+        DO jc = 1,size(enum_str)-1
           write(nulerr,'(a,a,a)',advance='no') ', "', trim(enum_str(jc)), '"'
         end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ecckd.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ecckd.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ecckd.F90	(revision 5158)
@@ -186,5 +186,5 @@
     istart = 1
     this%i_gas_mapping = 0
-    do jgas = 1, this%ngas
+    DO jgas = 1, this%ngas
       if (jgas < this%ngas) then
         inext = istart + scan(constituent_id(istart:nchar), ' ')
@@ -194,5 +194,5 @@
       ! Find gas code
       i_gas_code = 0
-      do jjgas = 1, NMaxGases
+      DO jjgas = 1, NMaxGases
         if (constituent_id(istart:inext-2) == trim(GasLowerCaseName(jjgas))) then
           i_gas_code = jjgas
@@ -239,5 +239,5 @@
          &  this%ntemp, ' temperatures, ', this%nplanck, ' planck-function entries'
     write(nulout, '(a)') '  Gases:'
-    do jgas = 1,this%ngas
+    DO jgas = 1,this%ngas
       if (this%single_gas(jgas)%i_gas_code > 0) then
         write(nulout, '(a,a,a)', advance='no') '    ', &
@@ -326,9 +326,9 @@
     global_multiplier = 1.0_jprb / (AccelDueToGravity * 0.001_jprb * AirMolarMass)
 
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       log_pressure_fl = log(0.5_jprb * (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)))
 
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         ! Find interpolation points in pressure
         pindex1 = (log_pressure_fl(jlev)-this%log_pressure1) &
@@ -356,5 +356,5 @@
       optical_depth_fl(:,:,jcol) = 0.0_jprb
       
-      do jgas = 1,this%ngas
+      DO jgas = 1,this%ngas
 
         associate (single_gas => this%single_gas(jgas))
@@ -367,5 +367,5 @@
             multiplier = simple_multiplier * mole_fraction_fl(jcol,:,igascode)
 
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &        + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
@@ -379,5 +379,5 @@
             multiplier = simple_multiplier  * (mole_fraction_fl(jcol,:,igascode) &
                  &                            - single_gas%reference_mole_frac)
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &        + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
@@ -390,5 +390,5 @@
             ! Composite gases
             molar_abs => this%single_gas(jgas)%molar_abs
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &  + (simple_multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
@@ -402,5 +402,5 @@
             molar_abs_conc => this%single_gas(jgas)%molar_abs_conc
             mole_frac1 = exp(single_gas%log_mole_frac1)
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               ! Take care of mole_fraction == 0
               log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode), mole_frac1))
@@ -419,5 +419,5 @@
               !      &                +tw2 * (pw1 * molar_abs_conc(:,ip1,it1+1,ic1+1) &
               !      &                       +pw2 * molar_abs_conc(:,ip1+1,it1+1,ic1+1)))
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &  + (simple_multiplier(jlev) * mole_fraction_fl(jcol,jlev,igascode)) * ( &
@@ -442,5 +442,5 @@
       ! Rayleigh scattering
       if (this%is_sw .and. present(rayleigh_od_fl)) then
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           rayleigh_od_fl(:,jlev,jcol) = global_multiplier &
                &  * (pressure_hl(jcol,jlev+1) - pressure_hl(jcol,jlev)) * this%rayleigh_molar_scat
@@ -469,5 +469,5 @@
     integer    :: it1, jt
 
-    do jt = 1,nt
+    DO jt = 1,nt
       tindex1 = (temperature(jt) - this%temperature1_planck) &
            &   * (1.0_jprb / this%d_temperature_planck)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ecckd_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ecckd_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ecckd_interface.F90	(revision 5158)
@@ -252,5 +252,5 @@
 
       ! Calculate the Planck function for each g point
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         call config%gas_optics_lw%calc_planck_function(nlev+1, &
              &  thermodynamics%temperature_hl(jcol,:), planck_hl(:,:,jcol))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_flux.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_flux.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_flux.F90	(revision 5158)
@@ -370,5 +370,5 @@
              &               config%i_band_from_reordered_g_sw, &
              &               this%sw_dn_surf_band, istartcol, iendcol)
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           this%sw_dn_surf_band(:,jcol) &
                &  = this%sw_dn_surf_band(:,jcol) &
@@ -376,5 +376,5 @@
         end do
       else
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           call indexed_sum(this%sw_dn_direct_surf_g(:,jcol), &
                &           config%i_band_from_reordered_g_sw, &
@@ -397,5 +397,5 @@
                &               config%i_band_from_reordered_g_sw, &
                &               this%sw_dn_surf_clear_band, istartcol, iendcol)
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             this%sw_dn_surf_clear_band(:,jcol) &
                  &  = this%sw_dn_surf_clear_band(:,jcol) &
@@ -403,5 +403,5 @@
           end do
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%sw_dn_direct_surf_clear_g(:,jcol), &
                  &           config%i_band_from_reordered_g_sw, &
@@ -433,5 +433,5 @@
                &               this%sw_dn_diffuse_surf_canopy, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%sw_dn_direct_surf_g(:,jcol), &
                  &           config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw), &
@@ -449,6 +449,6 @@
         this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) = 0.0_jprb
         this%sw_dn_direct_surf_canopy (:,istartcol:iendcol) = 0.0_jprb
-        do jband = 1,config%n_bands_sw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_sw
+          DO jalbedoband = 1,nalbedoband
             if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
               ! Initially, "diffuse" is actually "total"
@@ -481,5 +481,5 @@
                &               this%lw_dn_surf_canopy, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%lw_dn_surf_g(:,jcol), &
                  &           config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw), &
@@ -495,5 +495,5 @@
                &               lw_dn_surf_band, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%lw_dn_surf_g(:,jcol), &
                  &           config%i_band_from_reordered_g_lw, &
@@ -503,6 +503,6 @@
         nalbedoband = size(config%lw_emiss_weights,1)
         this%lw_dn_surf_canopy(:,istartcol:iendcol) = 0.0_jprb
-        do jband = 1,config%n_bands_lw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_lw
+          DO jalbedoband = 1,nalbedoband
             if (config%lw_emiss_weights(jalbedoband,jband) /= 0.0_jprb) then
               this%lw_dn_surf_canopy(jalbedoband,istartcol:iendcol) &
@@ -613,5 +613,5 @@
     iend   = ubound(source,1)
 
-    do jg = istart, iend
+    DO jg = istart, iend
       ig = ind(jg)
       dest(ig) = dest(ig) + source(jg)
@@ -637,5 +637,5 @@
     iend   = ubound(source,1)
 
-    do jg = istart, iend
+    DO jg = istart, iend
       ig = ind(jg)
       dest(ig) = dest(ig) + source(jg)
@@ -657,7 +657,7 @@
     dest = 0.0
 
-    do jg = lbound(source,1), ubound(source,1)
+    DO jg = lbound(source,1), ubound(source,1)
       ig = ind(jg)
-      do jc = ist, iend
+      DO jc = ist, iend
         dest(ig,jc) = dest(ig,jc) + source(jg,jc)
       end do
@@ -680,6 +680,6 @@
     nlev   = size(source,2)
 
-    do jlev = 1,nlev
-      do jg = istart, iend
+    DO jlev = 1,nlev
+      DO jg = istart, iend
         ig = ind(jg)
         dest(ig,jlev) = dest(ig,jlev) + source(jg,jlev)
@@ -706,6 +706,6 @@
     nlev   = size(source,2)
 
-    do jlev = 1,nlev
-      do jg = istart, iend
+    DO jlev = 1,nlev
+      DO jg = istart, iend
         ig = ind(jg)
         dest(ig,jlev) = dest(ig,jlev) + source(jg,jlev)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_gas.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_gas.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_gas.F90	(revision 5158)
@@ -208,6 +208,6 @@
     this%is_well_mixed(igas) = .false.
 
-    do jk = 1,this%nlev
-      do jc = i1,i2
+    DO jk = 1,this%nlev
+      DO jc = i1,i2
         this%mixing_ratio(jc,jk,igas) = mixing_ratio(jc-i1+1,jk)
       end do
@@ -293,6 +293,6 @@
     this%is_well_mixed(igas)           = .true.
 
-    do jk = 1,this%nlev
-      do jc = i1,i2
+    DO jk = 1,this%nlev
+      DO jc = i1,i2
         this%mixing_ratio(jc,jk,igas) = mixing_ratio
       end do
@@ -396,5 +396,5 @@
       end if
     else
-      do ig = 1,this%ntype
+      DO ig = 1,this%ntype
         call this%set_units(iunits, igas=this%icode(ig), scale_factor=new_sf)
       end do
@@ -443,5 +443,5 @@
       end if
     else
-      do ig = 1,this%ntype
+      DO ig = 1,this%ntype
         call this%assert_units(iunits, igas=this%icode(ig), scale_factor=sf)
       end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_general_cloud_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_general_cloud_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_general_cloud_optics.F90	(revision 5158)
@@ -53,5 +53,5 @@
     ! Count number of cloud types
     config%n_cloud_types = 0
-    do jtype = 1,NMaxCloudTypes
+    DO jtype = 1,NMaxCloudTypes
       if (len_trim(config%cloud_type_name(jtype)) > 0) then
         config%n_cloud_types = jtype
@@ -85,5 +85,5 @@
 
     ! Load cloud optics data
-    do jtype = 1,config%n_cloud_types
+    DO jtype = 1,config%n_cloud_types
       if (config%cloud_type_name(jtype)(1:1) == '/') then
         file_name = trim(config%cloud_type_name(jtype))
@@ -191,5 +191,5 @@
 
     ! Loop over cloud types
-    do jtype = 1,config%n_cloud_types
+    DO jtype = 1,config%n_cloud_types
       ! Compute in-cloud water path
       if (config%is_homogeneous) then
@@ -238,6 +238,6 @@
     ! Scale the combined longwave optical properties
     if (config%do_lw_cloud_scattering) then
-      do jcol = istartcol, iendcol
-        do jlev = 1,nlev
+      DO jcol = istartcol, iendcol
+        DO jlev = 1,nlev
           if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
             ! Note that original cloud optics does not do
@@ -259,6 +259,6 @@
     if (config%do_sw) then
       if (.not. config%do_sw_delta_scaling_with_gases) then
-        do jcol = istartcol, iendcol
-          do jlev = 1,nlev
+        DO jcol = istartcol, iendcol
+          DO jlev = 1,nlev
             if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
               call delta_eddington_extensive(od_sw_cloud(:,jlev,jcol), &
@@ -269,6 +269,6 @@
       end if
 
-      do jcol = istartcol, iendcol
-        do jlev = 1,nlev
+      DO jcol = istartcol, iendcol
+        DO jlev = 1,nlev
           if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
             ! Scale to get asymmetry factor and single scattering albedo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_general_cloud_optics_data.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_general_cloud_optics_data.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_general_cloud_optics_data.F90	(revision 5158)
@@ -279,6 +279,6 @@
 
     if (present(scat_od)) then
-      do jcol = 1,ncol
-        do jlev = 1,nlev
+      DO jcol = 1,ncol
+        DO jlev = 1,nlev
           if (cloud_fraction(jcol, jlev) > 0.0_jprb) then
             re_index = max(1.0_jprb, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) &
@@ -301,6 +301,6 @@
     else
       ! No scattering: return the absorption optical depth
-      do jcol = 1,ncol
-        do jlev = 1,nlev
+      DO jcol = 1,ncol
+        DO jlev = 1,nlev
           if (water_path(jcol, jlev) > 0.0_jprb) then
             re_index = max(1.0, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_lw.F90	(revision 5158)
@@ -119,9 +119,9 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       ! Is there any cloud in the profile?
       is_cloudy_profile = .false.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
           is_cloudy_profile = .true.
@@ -135,5 +135,5 @@
       ! the clear-sky layers since these will be needed when we come
       ! to do the total-sky fluxes.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_clear .or. cloud%fraction(jcol,jlev) &
              &                 < config%cloud_fraction_threshold) then
@@ -201,5 +201,5 @@
       ! now.
       if (is_cloudy_profile .or. .not. config%do_clear) then
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           ! Compute combined gas+aerosol+cloud optical properties;
           ! note that for clear layers, the reflectance and
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_sw.F90	(revision 5158)
@@ -123,5 +123,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ! Only perform calculation if sun above the horizon
       if (single_level%cos_sza(jcol) > 0.0_jprb) then
@@ -131,5 +131,5 @@
         ! Is there any cloud in the profile?
         is_cloudy_profile = .false.
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
             is_cloudy_profile = .true.
@@ -146,5 +146,5 @@
           ! Delta-Eddington scaling has already been performed to the
           ! aerosol part of od, ssa and g
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             if (config%do_clear .or. cloud%fraction(jcol,jlev) &
                  &                 < config%cloud_fraction_threshold) then
@@ -164,5 +164,5 @@
         else
           ! Apply delta-Eddington scaling to the aerosol-gas mixture
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             if (config%do_clear .or. cloud%fraction(jcol,jlev) &
                  &                 < config%cloud_fraction_threshold) then
@@ -229,5 +229,5 @@
         ! fluxes now.
         if (is_cloudy_profile .or. .not. config%do_clear) then
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             ! Compute combined gas+aerosol+cloud optical properties;
             ! note that for clear layers, the reflectance and
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ice_optics_fu.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ice_optics_fu.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ice_optics_fu.F90	(revision 5158)
@@ -73,5 +73,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jb = 1, nb
+    DO jb = 1, nb
       od(jb) = iwp_gm_2 * (coeff(jb,1) + coeff(jb,2) * inv_de_um)
       scat_od(jb) = od(jb) * (1.0_jprb - (coeff(jb,3) + de_um*(coeff(jb,4) &
@@ -124,5 +124,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jb = 1, nb
+    DO jb = 1, nb
       od(jb) = iwp_gm_2 * (coeff(jb,1) + inv_de_um*(coeff(jb,2) &
          &  + inv_de_um*coeff(jb,3)))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ifs_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ifs_rrtm.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ifs_rrtm.F90	(revision 5158)
@@ -362,6 +362,6 @@
 !    end if
 
-    do jlev=1,nlev
-      do jcol= istartcol,iendcol
+    DO jlev=1,nlev
+      DO jcol= istartcol,iendcol
         pressure_fl(jcol,jlev) &
             &  = 0.5_jprb * (thermodynamics%pressure_hl(jcol,jlev+istartlev-1) &
@@ -461,11 +461,11 @@
       ! arrays have dimensions in a different order to the inputs,
       ! so there is some inefficiency here.
-      do jgreorder = 1,config%n_g_lw
+      DO jgreorder = 1,config%n_g_lw
         iband = config%i_band_from_reordered_g_lw(jgreorder)
         ig = config%i_g_from_reordered_g_lw(jgreorder)
         
         ! Top-of-atmosphere half level
-        do jlev = 1,nlev
-          do jcol = istartcol,iendcol
+        DO jlev = 1,nlev
+          DO jcol = istartcol,iendcol
             ! Some g points can return negative optical depths;
             ! specifically original g points 54-56 which causes
@@ -479,6 +479,6 @@
     else
       ! G points have not been reordered 
-      do jcol = istartcol,iendcol
-        do jlev = 1,nlev
+      DO jcol = istartcol,iendcol
+        DO jlev = 1,nlev
           ! Check for negative optical depth
           od_lw(:,jlev,jcol) = max(config%min_gas_od_lw, ZOD_LW(:,nlev+1-jlev,jcol))
@@ -515,6 +515,6 @@
     ! Scale the incoming solar per band, if requested
     if (config%use_spectral_solar_scaling) then
-      do jg = 1,JPGPT_SW
-        do jcol = istartcol,iendcol 
+      DO jg = 1,JPGPT_SW
+        DO jcol = istartcol,iendcol
           ZINCSOL(jcol,jg) = ZINCSOL(jcol,jg) * &
             &   single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw(jg))
@@ -527,5 +527,5 @@
     ! ZINCSOL will be zero.
     if (present(incoming_sw)) then
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         if (single_level%cos_sza(jcol) > 0.0_jprb) then
 ! Added for DWD (2020)
@@ -541,8 +541,8 @@
 !    if (.true.) then
       ! Account for reordered g points
-      do jgreorder = 1,config%n_g_sw
+      DO jgreorder = 1,config%n_g_sw
         ig = config%i_g_from_reordered_g_sw(jgreorder)
-        do jlev = 1,nlev
-          do jcol = istartcol,iendcol
+        DO jlev = 1,nlev
+          DO jcol = istartcol,iendcol
             ! Check for negative optical depth
             od_sw (jgreorder,nlev+1-jlev,jcol) &
@@ -558,7 +558,7 @@
     else
       ! G points have not been reordered
-      do jcol = istartcol,iendcol
-        do jlev = 1,nlev
-          do jg = 1,config%n_g_sw
+      DO jcol = istartcol,iendcol
+        DO jlev = 1,nlev
+          DO jg = 1,config%n_g_sw
             ! Check for negative optical depth
             od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg))
@@ -567,5 +567,5 @@
         end do
         if (present(incoming_sw)) then
-          do jg = 1,config%n_g_sw
+          DO jg = 1,config%n_g_sw
             incoming_sw(jg,jcol) = incoming_sw_scale(jcol) * ZINCSOL(jcol,jg)
           end do
@@ -636,6 +636,6 @@
     ! lowest interpolation bound, and the fraction into interpolation
     ! interval
-    do jlev = 1,nlev+1
-      do jcol = istartcol,iendcol
+    DO jlev = 1,nlev+1
+      DO jcol = istartcol,iendcol
         temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset)
         if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then
@@ -656,7 +656,7 @@
 
       ! Calculate Planck functions per band
-      do jband = 1,config%n_bands_lw
+      DO jband = 1,config%n_bands_lw
         factor = zfluxfac * delwave(jband)
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           planck_store(jcol,jband) = factor &
                &  * (totplnk(ind(jcol),jband) &
@@ -675,5 +675,5 @@
           ! Top-of-atmosphere half level - note that PFRAC is on model
           ! levels not half levels
-          do jgreorder = 1,config%n_g_lw
+          DO jgreorder = 1,config%n_g_lw
             iband = config%i_band_from_reordered_g_lw(jgreorder)
             ig = config%i_g_from_reordered_g_lw(jgreorder)
@@ -682,5 +682,5 @@
           end do
         else
-          do jgreorder = 1,config%n_g_lw
+          DO jgreorder = 1,config%n_g_lw
             iband = config%i_band_from_reordered_g_lw(jgreorder)
             ig = config%i_g_from_reordered_g_lw(jgreorder)
@@ -695,14 +695,14 @@
           ! Top-of-atmosphere half level - note that PFRAC is on model
           ! levels not half levels
-          do jg = 1,config%n_g_lw
+          DO jg = 1,config%n_g_lw
             iband = config%i_band_from_g_lw(jg)
             planck_hl(jg,1,:) = planck_store(:,iband) * PFRAC(:,jg,nlev)
           end do
         else
-          do jg = 1,config%n_g_lw
+          DO jg = 1,config%n_g_lw
             iband = config%i_band_from_g_lw(jg)
             planck_tmp(:,jg) = planck_store(:,iband) * PFRAC(:,jg,nlev+2-jlev)
           end do
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             planck_hl(:,jlev,jcol) = planck_tmp(jcol,:)
           end do
@@ -763,5 +763,5 @@
 
     ! Work out surface interpolations
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       Tsurf = temperature(jcol)
       if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then
@@ -782,7 +782,7 @@
 
     ! Calculate Planck functions per band
-    do jband = 1,config%n_bands_lw
+    DO jband = 1,config%n_bands_lw
       factor = zfluxfac * delwave(jband)
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         planck_store(jcol,jband) = factor &
              &  * (totplnk(ind(jcol),jband) &
@@ -798,5 +798,5 @@
       ! in pressure since the the functions above treat pressure
       ! decreasing with increasing index.
-      do jgreorder = 1,config%n_g_lw
+      DO jgreorder = 1,config%n_g_lw
         iband = config%i_band_from_reordered_g_lw(jgreorder)
         ig = config%i_g_from_reordered_g_lw(jgreorder)
@@ -805,5 +805,5 @@
     else
       ! G points have not been reordered 
-      do jg = 1,config%n_g_lw
+      DO jg = 1,config%n_g_lw
         iband = config%i_band_from_g_lw(jg)
         planck_surf(jg,:) = planck_store(:,iband) * PFRAC(:,jg)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_liquid_optics_socrates.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_liquid_optics_socrates.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_liquid_optics_socrates.F90	(revision 5158)
@@ -65,5 +65,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jb = 1, nb
+    DO jb = 1, nb
       od(jb) = lwp * (coeff(jb,1) + re*(coeff(jb,2) + re*coeff(jb,3))) &
          &  / (1.0_jprb + re*(coeff(jb,4) + re*(coeff(jb,5) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_lw_derivatives.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_lw_derivatives.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_lw_derivatives.F90	(revision 5158)
@@ -73,5 +73,5 @@
     ! Move up through the atmosphere computing the derivatives at each
     ! half-level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       lw_derivatives_g = lw_derivatives_g * transmittance(:,jlev)
       lw_derivatives(icol,jlev) = sum(lw_derivatives_g)
@@ -121,5 +121,5 @@
     ! Move up through the atmosphere computing the derivatives at each
     ! half-level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       lw_derivatives_g = lw_derivatives_g * transmittance(:,jlev)
       lw_derivatives(icol,jlev) = (1.0_jprb - weight) * lw_derivatives(icol,jlev) &
@@ -176,5 +176,5 @@
     ! Move up through the atmosphere computing the derivatives at each
     ! half-level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       ! Compute effect of overlap at half-level jlev+1, yielding
       ! derivatives just above that half-level
@@ -238,5 +238,5 @@
     ! Move up through the atmosphere computing the derivatives at each
     ! half-level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       ! Compute effect of overlap at half-level jlev+1, yielding
       ! derivatives just above that half-level
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_matrix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_matrix.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_matrix.F90	(revision 5158)
@@ -90,6 +90,6 @@
       mat_x_vec(1:iend,1) = A(1:iend,1,1)*b(1:iend,1)
     else
-      do j1 = 1,m
-        do j2 = 1,m
+      DO j1 = 1,m
+        DO j2 = 1,m
           mat_x_vec(1:iend,j1) = mat_x_vec(1:iend,j1) &
                &               + A(1:iend,j1,j2)*b(1:iend,j2)
@@ -124,6 +124,6 @@
     singlemat_x_vec = 0.0_jprb
 
-    do j1 = 1,m
-      do j2 = 1,m
+    DO j1 = 1,m
+      DO j2 = 1,m
         singlemat_x_vec(1:iend,j1) = singlemat_x_vec(1:iend,j1) &
              &                    + A(j1,j2)*b(1:iend,j2)
@@ -175,7 +175,7 @@
       m2block = 2*mblock 
       ! Do the top-left (C, D, F, G)
-      do j2 = 1,m2block
-        do j1 = 1,m2block
-          do j3 = 1,m2block
+      DO j2 = 1,m2block
+        DO j1 = 1,m2block
+          DO j3 = 1,m2block
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -183,8 +183,8 @@
         end do
       end do
-      do j2 = m2block+1,m
+      DO j2 = m2block+1,m
         ! Do the top-right (E & H)
-        do j1 = 1,m2block
-          do j3 = 1,m
+        DO j1 = 1,m2block
+          DO j3 = 1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -192,6 +192,6 @@
         end do
         ! Do the bottom-right (I)
-        do j1 = m2block+1,m
-          do j3 = m2block+1,m
+        DO j1 = m2block+1,m
+          DO j3 = m2block+1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -201,7 +201,7 @@
     else
       ! Ordinary dense matrix
-      do j2 = 1,m
-        do j1 = 1,m
-          do j3 = 1,m
+      DO j2 = 1,m
+        DO j1 = 1,m
+          DO j3 = 1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -237,7 +237,7 @@
     singlemat_x_mat = 0.0_jprb
 
-    do j2 = 1,m
-      do j1 = 1,m
-        do j3 = 1,m
+    DO j2 = 1,m
+      DO j1 = 1,m
+        DO j3 = 1,m
           singlemat_x_mat(1:iend,j1,j2) = singlemat_x_mat(1:iend,j1,j2) &
                &                        + A(j1,j3)*B(1:iend,j3,j2)
@@ -272,7 +272,7 @@
     mat_x_singlemat = 0.0_jprb
 
-    do j2 = 1,m
-      do j1 = 1,m
-        do j3 = 1,m
+    DO j2 = 1,m
+      DO j1 = 1,m
+        DO j3 = 1,m
           mat_x_singlemat(1:iend,j1,j2) = mat_x_singlemat(1:iend,j1,j2) &
                &                        + A(1:iend,j1,j3)*B(j3,j2)
@@ -310,5 +310,5 @@
 
     identity_minus_mat_x_mat = - identity_minus_mat_x_mat
-    do j = 1,m
+    DO j = 1,m
       identity_minus_mat_x_mat(1:iend,j,j) &
            &     = 1.0_jprb + identity_minus_mat_x_mat(1:iend,j,j)
@@ -348,10 +348,10 @@
       mblock = m/3
       m2block = 2*mblock
-      do j4 = 1,nrepeat
+      DO j4 = 1,nrepeat
         repeated_square = 0.0_jprb
         ! Do the top-left (C, D, F & G)
-        do j2 = 1,m2block
-          do j1 = 1,m2block
-            do j3 = 1,m2block
+        DO j2 = 1,m2block
+          DO j1 = 1,m2block
+            DO j3 = 1,m2block
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -359,8 +359,8 @@
           end do
         end do
-        do j2 = m2block+1, m
+        DO j2 = m2block+1, m
           ! Do the top-right (E & H)
-          do j1 = 1,m2block
-            do j3 = 1,m
+          DO j1 = 1,m2block
+            DO j3 = 1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -368,6 +368,6 @@
           end do
           ! Do the bottom-right (I)
-          do j1 = m2block+1, m
-            do j3 = m2block+1,m
+          DO j1 = m2block+1, m
+            DO j3 = m2block+1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -381,9 +381,9 @@
     else
       ! Ordinary dense matrix
-      do j4 = 1,nrepeat
+      DO j4 = 1,nrepeat
         repeated_square = 0.0_jprb
-        do j2 = 1,m
-          do j1 = 1,m
-            do j3 = 1,m
+        DO j2 = 1,m
+          DO j1 = 1,m
+            DO j3 = 1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -521,5 +521,5 @@
     U33 = A(1:iend,3,3) - L31*A(1:iend,1,3) - L32*U23
 
-    do j = 1,3
+    DO j = 1,3
       ! Solve Ly = B(:,:,j) by forward substitution
       ! y1 = B(:,1,j)
@@ -621,15 +621,15 @@
     LU(1:iend,1:m,1:m) = A(1:iend,1:m,1:m)
 
-    do j2 = 1, m
-      do j1 = 1, j2-1
+    DO j2 = 1, m
+      DO j1 = 1, j2-1
         s = LU(1:iend,j1,j2)
-        do j3 = 1, j1-1
+        DO j3 = 1, j1-1
           s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
         end do
         LU(1:iend,j1,j2) = s
       end do
-      do j1 = j2, m
+      DO j1 = j2, m
         s = LU(1:iend,j1,j2)
-        do j3 = 1, j2-1
+        DO j3 = 1, j2-1
           s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
         end do
@@ -638,5 +638,5 @@
       if (j2 /= m) then
         s = 1.0_jprb / LU(1:iend,j2,j2)
-        do j1 = j2+1, m
+        DO j1 = j2+1, m
           LU(1:iend,j1,j2) = LU(1:iend,j1,j2) * s
         end do
@@ -663,12 +663,12 @@
 
     ! First solve Ly=b
-    do j2 = 2, m
-      do j1 = 1, j2-1
+    DO j2 = 2, m
+      DO j1 = 1, j2-1
         x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
       end do
     end do
     ! Now solve Ux=y
-    do j2 = m, 1, -1
-      do j1 = j2+1, m
+    DO j2 = m, 1, -1
+      DO j1 = j2+1, m
         x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
       end do
@@ -694,5 +694,5 @@
     call lu_factorization(n,iend,m,A,LU)
 
-    do j = 1, m
+    DO j = 1, m
       call lu_substitution(n,iend,m,LU,B(1:,1:m,j),X(1:iend,1:m,j))
 !      call lu_substitution(n,iend,m,LU,B(1:n,1:m,j),X(1:iend,1:m,j))
@@ -807,12 +807,12 @@
 
     ! Compute the 1-norms of A
-    do j3 = 1,m
+    DO j3 = 1,m
       sum_column(:) = 0.0_jprb
-      do j2 = 1,m
-        do j1 = 1,iend
+      DO j2 = 1,m
+        DO j1 = 1,iend
           sum_column(j1) = sum_column(j1) + abs(A(j1,j2,j3))
         end do
       end do
-      do j1 = 1,iend
+      DO j1 = 1,iend
         if (sum_column(j1) > normA(j1)) then
           normA(j1) = sum_column(j1)
@@ -833,6 +833,6 @@
     ! Scale the input matrices by a power of 2
     scaling = 2.0_jprb**(-expo)
-    do j3 = 1,m
-      do j2 = 1,m
+    DO j3 = 1,m
+      DO j2 = 1,m
         A(1:iend,j2,j3) = A(1:iend,j2,j3) * scaling
       end do
@@ -844,5 +844,5 @@
 
     V = c(8)*A6 + c(6)*A4 + c(4)*A2
-    do j3 = 1,m
+    DO j3 = 1,m
       V(:,j3,j3) = V(:,j3,j3) + c(2)
     end do
@@ -850,5 +850,5 @@
     V = c(7)*A6 + c(5)*A4 + c(3)*A2
     ! Add a multiple of the identity matrix
-    do j3 = 1,m
+    DO j3 = 1,m
       V(:,j3,j3) = V(:,j3,j3) + c(1)
     end do
@@ -859,10 +859,10 @@
 
     ! Add the identity matrix
-    do j3 = 1,m
+    DO j3 = 1,m
       A(1:iend,j3,j3) = A(1:iend,j3,j3) + 1.0_jprb
     end do
 
     ! Loop through the matrices
-    do j1 = 1,iend
+    DO j1 = 1,iend
       if (expo(j1) > 0) then
         ! Square matrix j1 expo(j1) times          
@@ -983,6 +983,6 @@
 
     ! Compute V * diag_rdivide_V
-    do j1 = 1,3
-      do j2 = 1,3
+    DO j1 = 1,3
+      DO j2 = 1,3
         R(1:iend,j2,j1) = V(1:iend,j2,1)*diag_rdivide_V(1:iend,1,j1) &
              &          + V(1:iend,j2,2)*diag_rdivide_V(1:iend,2,j1) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_mcica_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_mcica_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_mcica_lw.F90	(revision 5158)
@@ -150,5 +150,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       ! Clear-sky calculation
@@ -156,5 +156,5 @@
         ! Scattering case: first compute clear-sky reflectance,
         ! transmittance etc at each model level
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           call calc_two_stream_gammas_lw(ng, ssa(:,jlev,jcol), g(:,jlev,jcol), &
                &  gamma1, gamma2)
@@ -174,5 +174,5 @@
         ! Non-scattering case: use simpler functions for
         ! transmission and emission
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           call calc_no_scattering_transmittance_lw(ng, od(:,jlev,jcol), &
                &  planck_hl(:,jlev,jcol), planck_hl(:,jlev+1, jcol), &
@@ -215,5 +215,5 @@
         is_clear_sky_layer = .true.
         i_cloud_top = nlev+1
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           ! Compute combined gas+aerosol+cloud optical properties
           if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
@@ -224,5 +224,5 @@
             end if
 
-            do jg = 1,ng
+            DO jg = 1,ng
               od_cloud_new(jg) = od_scaling(jg,jlev) &
                  &  * od_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol)
@@ -240,5 +240,5 @@
                 ! case that od_total > 0.0 and ssa_total > 0.0 but
                 ! od_total*ssa_total == 0 due to underflow
-                do jg = 1,ng
+                DO jg = 1,ng
                   if (od_total(jg) > 0.0_jprb) then
                     scat_od_total(jg) = ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
@@ -259,5 +259,5 @@
               else
 
-                do jg = 1,ng
+                DO jg = 1,ng
                   if (od_total(jg) > 0.0_jprb) then
                     scat_od = ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_mcica_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_mcica_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_mcica_sw.F90	(revision 5158)
@@ -142,5 +142,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ! Only perform calculation if sun above the horizon
       if (single_level%cos_sza(jcol) > 0.0_jprb) then
@@ -152,5 +152,5 @@
           ! Delta-Eddington scaling has already been performed to the
           ! aerosol part of od, ssa and g
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             call calc_two_stream_gammas_sw(ng, &
                  &  cos_sza, ssa(:,jlev,jcol), g(:,jlev,jcol), &
@@ -165,5 +165,5 @@
         else
           ! Apply delta-Eddington scaling to the aerosol-gas mixture
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             od_total  =  od(:,jlev,jcol)
             ssa_total = ssa(:,jlev,jcol)
@@ -219,8 +219,8 @@
         if (total_cloud_cover >= config%cloud_fraction_threshold) then
           ! Total-sky calculation
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             ! Compute combined gas+aerosol+cloud optical properties
             if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
-              do jg = 1,ng
+              DO jg = 1,ng
                 od_cloud_new(jg) = od_scaling(jg,jlev) &
                    &  * od_cloud(config%i_band_from_reordered_g_sw(jg),jlev,jcol)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_monochromatic.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_monochromatic.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_monochromatic.F90	(revision 5158)
@@ -164,5 +164,5 @@
     integer :: jlev
 
-    do jlev = 1,nlev
+    DO jlev = 1,nlev
       ! The fraction of the total optical depth in the current layer
       ! is proportional to the fraction of the mass of the atmosphere
@@ -192,5 +192,5 @@
              &  = StefanBoltzmann * single_level%skin_temperature(istartcol:iendcol)**4 &
              &  * single_level%lw_emissivity(istartcol:iendcol,1)
-        do jlev = 1,nlev+1
+        DO jlev = 1,nlev+1
           planck_hl(1,jlev,istartcol:iendcol) = StefanBoltzmann * thermodynamics%temperature_hl(istartcol:iendcol,jlev)**4
         end do
@@ -200,5 +200,5 @@
              &             single_level%skin_temperature(istartcol:iendcol)) &
              &  * single_level%lw_emissivity(istartcol:iendcol,1)
-        do jlev = 1,nlev+1
+        DO jlev = 1,nlev+1
           planck_hl(1,jlev,istartcol:iendcol) = Pi*planck_function(config%mono_lw_wavelength, &
                &             thermodynamics%temperature_hl(istartcol:iendcol,jlev))
@@ -261,6 +261,6 @@
     ! Convert cloud mixing ratio into liquid and ice water path
     ! in each layer
-    do jlev = 1, nlev
-      do jcol = istartcol, iendcol
+    DO jlev = 1, nlev
+      DO jcol = istartcol, iendcol
         ! Factor to convert from gridbox-mean mass mixing ratio to
         ! in-cloud water path involves the pressure difference in
@@ -288,5 +288,5 @@
 
     if (config%iverbose >= 4) then
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         write(*,'(a,i0,a,f7.3,a,f7.3)') 'Profile ', jcol, ': shortwave optical depth = ', &
              &  sum(od_sw_cloud(1,:,jcol)*cloud%fraction(jcol,:)), &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_overlap.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_overlap.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_overlap.F90	(revision 5158)
@@ -94,5 +94,5 @@
     ! multiply by "factor"
     denominator = 1.0_jprb
-    do jreg = 1,nreg
+    DO jreg = 1,nreg
       op_x_frac_min(jreg) = op(jreg) &
            &  * min(frac_upper(jreg), frac_lower(jreg))
@@ -103,6 +103,6 @@
       factor = 1.0_jprb / denominator
       ! Create the random part of the overlap matrix
-      do jupper = 1,nreg
-        do jlower = 1,nreg
+      DO jupper = 1,nreg
+        DO jlower = 1,nreg
           overlap_matrix(jupper,jlower) = factor &
                &  * (frac_lower(jlower)-op_x_frac_min(jlower)) &
@@ -115,5 +115,5 @@
     
     ! Add on the maximum part of the overlap matrix
-    do jreg = 1,nreg
+    DO jreg = 1,nreg
       overlap_matrix(jreg,jreg) = overlap_matrix(jreg,jreg) &
            &  + op_x_frac_min(jreg)
@@ -368,5 +368,5 @@
 
     ! Loop through each atmospheric column
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! For this column, outer space is treated as one clear-sky
       ! region, so the fractions are assigned as such
@@ -381,5 +381,5 @@
       ! half-level starting at 1 for the top-of-atmosphere, as well
       ! as indexing each level starting at 1 for the top-most level.
-      do jlev = 1,nlev+1
+      DO jlev = 1,nlev+1
         ! Fraction of each region just below the interface
         if (jlev > nlev) then
@@ -426,6 +426,6 @@
 
         ! Convert to directional overlap matrices
-        do jupper = 1,nreg
-          do jlower = 1,nreg
+        DO jupper = 1,nreg
+          DO jlower = 1,nreg
             if (frac_lower(jlower) >= frac_threshold) then
               u_matrix(jupper,jlower,jlev,jcol) = overlap_matrix(jupper,jlower) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_pdf_sampler.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_pdf_sampler.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_pdf_sampler.F90	(revision 5158)
@@ -189,5 +189,5 @@
     real(jprb) :: wfsd, wcdf
 
-    do jsamp = 1,nsamp
+    DO jsamp = 1,nsamp
       if (mask(jsamp)) then
         ! Bilinear interpolation with bounds
@@ -237,6 +237,6 @@
     real(jprb) :: wfsd, wcdf
 
-    do jz = 1,nz
-      do jg = 1,ng
+    DO jz = 1,nz
+      DO jg = 1,ng
         if (cdf(jg, jz) > 0.0_jprb) then
           ! Bilinear interpolation with bounds
@@ -291,9 +291,9 @@
     real(jprb) :: wfsd, wcdf
 
-    do jz = 1,nz
+    DO jz = 1,nz
 
       if (mask(jz)) then
         
-        do jg = 1,ng
+        DO jg = 1,ng
           if (cdf(jg, jz) > 0.0_jprb) then
             ! Bilinear interpolation with bounds
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_random_numbers.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_random_numbers.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_random_numbers.F90	(revision 5158)
@@ -165,5 +165,5 @@
       ! populate the state
       rseed = real(abs(this%iseed),jprd)
-      do jstr = 1,this%nmaxstreams
+      DO jstr = 1,this%nmaxstreams
         ! Note that nint returns an integer of type jpib (8-byte)
         ! which may be converted to double if that is the type of
@@ -174,5 +174,5 @@
 
       ! One warmup of the C++ minstd_rand algorithm
-      do jstr = 1,this%nmaxstreams
+      DO jstr = 1,this%nmaxstreams
         this%istate(jstr) = mod(IMinstdA * this%istate(jstr), IMinstdM)
       end do
@@ -182,5 +182,5 @@
       call random_seed(size=nseed)
       allocate(iseednative(nseed))
-      do jseed = 1,nseed
+      DO jseed = 1,nseed
         iseednative(jseed) = this%iseed + jseed - 1
       end do
@@ -208,5 +208,5 @@
 
       ! C++ minstd_rand algorithm
-      do i = 1, imax
+      DO i = 1, imax
         ! The following calculation is computed entirely with 8-byte
         ! numbers (whether real or integer)
@@ -243,7 +243,7 @@
 
       ! C++ minstd_ran algorithm
-      do jblock = 1,size(randnum,2)
+      DO jblock = 1,size(randnum,2)
         ! These lines should be vectorizable
-        do i = 1, imax
+        DO i = 1, imax
           this%istate(i) = mod(IMinstdA * this%istate(i), IMinstdM)
           randnum(i,jblock) = IMinstdScale * this%istate(i)
@@ -278,8 +278,8 @@
 
       ! C++ minstd_ran algorithm
-      do jblock = 1,size(randnum,2)
+      DO jblock = 1,size(randnum,2)
         if (mask(jblock)) then
           ! These lines should be vectorizable
-          do i = 1, imax
+          DO i = 1, imax
             this%istate(i) = mod(IMinstdA * this%istate(i), IMinstdM)
             randnum(i,jblock) = IMinstdScale * this%istate(i)
@@ -290,5 +290,5 @@
     else
 
-      do jblock = 1,size(randnum,2)
+      DO jblock = 1,size(randnum,2)
         if (mask(jblock)) then
           call random_number(randnum(:,jblock))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_regions.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_regions.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_regions.F90	(revision 5158)
@@ -122,6 +122,6 @@
         ! sigma, then the 16th percentile of the lognormal is very
         ! close to exp(mu-sigma).
-        do jcol = istartcol,iendcol
-          do jlev = 1,nlev
+        DO jcol = istartcol,iendcol
+          DO jlev = 1,nlev
             if (cloud_fraction(jcol,jlev) < frac_threshold) then
               reg_fracs(1,jlev,jcol)       = 1.0_jprb
@@ -145,6 +145,6 @@
         ! cover of the denser region - see region_fractions routine
         ! below
-        do jcol = istartcol,iendcol
-          do jlev = 1,nlev
+        DO jcol = istartcol,iendcol
+          DO jlev = 1,nlev
             if (cloud_fraction(jcol,jlev) < frac_threshold) then
               reg_fracs(1,jlev,jcol)    = 1.0_jprb
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_save.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_save.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_save.F90	(revision 5158)
@@ -868,5 +868,5 @@
          &   dim2_name="column", dim1_name="level", &
          &   units_str="1", long_name="Ozone mass mixing ratio")
-    do jgas = 1,NMaxGases
+    DO jgas = 1,NMaxGases
       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
         write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
@@ -959,5 +959,5 @@
     call gas%get(IO3, IMassMixingRatio, mixing_ratio)
     call out_file%put("o3_mmr", mixing_ratio)
-    do jgas = 1,NMaxGases
+    DO jgas = 1,NMaxGases
       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
         write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_single_level.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_single_level.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_single_level.F90	(revision 5158)
@@ -196,5 +196,5 @@
     end if
 
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       this%iseed(jcol) = jcol
     end do
@@ -265,8 +265,8 @@
 
         sw_albedo_band = 0.0_jprb
-        do jband = 1,config%n_bands_sw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_sw
+          DO jalbedoband = 1,nalbedoband
             if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
-              do jcol = istartcol,iendcol
+              DO jcol = istartcol,iendcol
                 sw_albedo_band(jcol,jband) &
                     &  = sw_albedo_band(jcol,jband) & 
@@ -282,6 +282,6 @@
         if (allocated(this%sw_albedo_direct)) then
           sw_albedo_band = 0.0_jprb
-          do jband = 1,config%n_bands_sw
-            do jalbedoband = 1,nalbedoband
+          DO jband = 1,config%n_bands_sw
+            DO jalbedoband = 1,nalbedoband
               if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
                 sw_albedo_band(istartcol:iendcol,jband) &
@@ -327,8 +327,8 @@
         end if
         lw_albedo_band = 0.0_jprb
-        do jband = 1,config%n_bands_lw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_lw
+          DO jalbedoband = 1,nalbedoband
             if (config%lw_emiss_weights(jalbedoband,jband) /= 0.0_jprb) then
-              do jcol = istartcol,iendcol
+              DO jcol = istartcol,iendcol
                 lw_albedo_band(jcol,jband) &
                     &  = lw_albedo_band(jcol,jband) & 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_lw.F90	(revision 5158)
@@ -313,5 +313,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -325,5 +325,5 @@
       ! cloud%crop_cloud_fraction has already been called
       is_clear_sky_layer = .true.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -336,5 +336,5 @@
       ! In this section the reflectance, transmittance and sources
       ! are computed for each layer
-      do jlev = 1,nlev ! Start at top-of-atmosphere
+      DO jlev = 1,nlev ! Start at top-of-atmosphere
         ! --------------------------------------------------------
         ! Section 3.1: Layer-specific initialization
@@ -395,5 +395,5 @@
             ! approximate order of gas optical depth.
             ng3D = ng
-            do jg = 1, ng
+            DO jg = 1, ng
               if (od_region(jg,1) > config%max_gas_od_3D) then
                 ng3D = jg-1
@@ -488,5 +488,5 @@
               end if
 
-              do jreg = 1, nreg-1
+              DO jreg = 1, nreg-1
                 ! Compute lateral transfer rate from region jreg to
                 ! jreg+1 following Hogan & Shonk (2013) Eq. 47, but
@@ -536,5 +536,5 @@
           ! g-point, mapping from the cloud properties
           ! defined in each band.
-          do jg = 1,ng
+          DO jg = 1,ng
             ! Mapping from g-point to band
             iband = config%i_band_from_reordered_g_lw(jg)
@@ -544,5 +544,5 @@
 
             ! Loop over cloudy regions
-            do jreg = 2,nreg
+            DO jreg = 2,nreg
               ! Add scaled cloud optical depth to clear-sky value
               od_region(jg,jreg) = od_region(jg,1) &
@@ -603,5 +603,5 @@
           ! exponential, then computing the various
           ! transmission/reflectance matrices from that.
-          do jreg = 1,nregActive
+          DO jreg = 1,nregActive
             ! Write the diagonal elements of -Gamma1*z1
             Gamma_z1(1:ng3D,jreg,jreg) &
@@ -628,5 +628,5 @@
             ! non-zeros in the cloudy-sky regions even if the cloud
             ! fraction is zero
-            do jreg = nregActive+1,nreg
+            DO jreg = nregActive+1,nreg
               Gamma_z1(1:ng3D,jreg,jreg) = Gamma_z1(1:ng3D,1,1)
               Gamma_z1(1:ng3D,nreg+jreg,jreg) = Gamma_z1(1:ng3D,nreg+1,1)
@@ -656,5 +656,5 @@
           end if
 
-          do jreg = 1,nregActive-1
+          DO jreg = 1,nregActive-1
             ! Add the terms assocated with 3D transport to Gamma1*z1.
             ! First the rate from region jreg to jreg+1
@@ -775,5 +775,5 @@
           ! formulas for reflectance and transmittance, and equivalent
           ! solutions to the coupled ODEs for the sources.
-          do jreg = 2, nregActive
+          DO jreg = 2, nregActive
             call calc_reflectance_transmittance_lw(ng-ng3D, &
                  &  od_region(ng3D+1:ng,jreg), &
@@ -806,6 +806,6 @@
       ! Calculate the upwelling radiation emitted by the surface, and
       ! copy the surface albedo into total_albedo 
-      do jreg = 1,nreg
-        do jg = 1,ng
+      DO jreg = 1,nreg
+        DO jg = 1,ng
           ! region_fracs(jreg,nlev,jcol) is the fraction of each
           ! region in the lowest model level
@@ -816,5 +816,5 @@
       ! Equivalent surface values for computing clear-sky fluxes 
       if (config%do_clear) then
-        do jg = 1,ng
+        DO jg = 1,ng
           total_source_clear(jg,nlev+1) = emission(jg,jcol)
         end do
@@ -826,5 +826,5 @@
       ! Loop back up through the atmosphere computing the total albedo
       ! and the total upwelling due to emission below each level
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
         if (config%do_clear) then
           ! Use adding method for clear-sky arrays; note that there
@@ -876,5 +876,5 @@
           total_albedo_below = 0.0_jprb
           total_source_below = 0.0_jprb
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             inv_denom_scalar(:) = 1.0_jprb / (1.0_jprb &
                  &  - total_albedo(:,jreg,jreg,jlev+1)*reflectance(:,jreg,jreg,jlev))
@@ -918,6 +918,6 @@
             ! essentially diag(total_albedo) = matmul(transpose(v_matrix),
             ! diag(total_albedo_below)).
-            do jreg = 1,nreg
-              do jreg2 = 1,nreg
+            DO jreg = 1,nreg
+              DO jreg2 = 1,nreg
                 total_albedo(:,jreg,jreg,jlev) &
                      &  = total_albedo(:,jreg,jreg,jlev) &
@@ -966,5 +966,5 @@
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_clear) then
           ! Scalar operations for clear-sky fluxes
@@ -999,5 +999,5 @@
                &  flux_dn_above) + total_source(:,:,jlev+1)
         else
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             ! Scalar operations for all regions, requiring that
             ! reflectance, transmittance and total_albedo are diagonal
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_sw.F90	(revision 5158)
@@ -329,5 +329,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -405,5 +405,5 @@
       is_clear_sky_layer = .true.
       i_cloud_top = nlev+1
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -417,5 +417,5 @@
       ! In this section the reflectance, transmittance and sources
       ! are computed for each layer
-      do jlev = 1,nlev ! Start at top-of-atmosphere
+      DO jlev = 1,nlev ! Start at top-of-atmosphere
         ! --------------------------------------------------------
         ! Section 3.1: Layer-specific initialization
@@ -470,5 +470,5 @@
             ! approximate order of gas optical depth.
             ng3D = ng
-            do jg = 1, ng
+            DO jg = 1, ng
               if (od_region(jg,1) > config%max_gas_od_3D) then
                 ng3D = jg-1
@@ -554,5 +554,5 @@
               end if
 
-              do jreg = 1, nreg-1
+              DO jreg = 1, nreg-1
                 ! Compute lateral transfer rates from region jreg to
                 ! jreg+1 following Hogan & Shonk (2013) Eq. 47, but
@@ -616,5 +616,5 @@
           ! g-point, mapping from the cloud properties
           ! defined in each band.
-          do jg = 1,ng
+          DO jg = 1,ng
             ! Mapping from g-point to band
             iband = config%i_band_from_reordered_g_sw(jg)
@@ -630,5 +630,5 @@
 
             ! Loop over cloudy regions
-            do jreg = 2,nreg
+            DO jreg = 2,nreg
               scat_od_cloud = od_cloud(iband,jlev,jcol) &
                    &  * ssa_cloud(iband,jlev,jcol)*od_scaling(jreg,jlev,jcol)
@@ -680,5 +680,5 @@
           ! exponential, then computing the various
           ! transmission/reflectance matrices from that.
-          do jreg = 1,nregactive
+          DO jreg = 1,nregactive
             ! Write the diagonal elements of -Gamma1*z1
             Gamma_z1(1:ng3D,jreg,jreg) &
@@ -702,5 +702,5 @@
           end do
 
-          do jreg = 1,nregactive-1
+          DO jreg = 1,nregactive-1
             ! Write the elements of -Gamma1*z1 concerned with 3D
             ! transport
@@ -821,5 +821,5 @@
           ! Compute reflectance, transmittance and associated terms
           ! for each cloudy region, using the Meador-Weaver formulas
-          do jreg = 2, nregactive
+          DO jreg = 2, nregactive
             call calc_reflectance_transmittance_sw(ng-ng3D, &
                  &  mu0, &
@@ -854,6 +854,6 @@
       ! beam incident on the surface, and copy the surface albedo
       ! into total_albedo
-      do jreg = 1,nreg
-        do jg = 1,ng
+      DO jreg = 1,nreg
+        DO jg = 1,ng
           total_albedo(jg,jreg,jreg,nlev+1) = albedo_diffuse(jg,jcol)
           total_albedo_direct(jg,jreg,jreg,nlev+1) &
@@ -876,5 +876,5 @@
       ! Work back up through the atmosphere computing the total albedo
       ! of the atmosphere below that point using the adding method
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
 
         ! --------------------------------------------------------
@@ -996,6 +996,6 @@
           ! radiation:
           total_albedo(:,:,:,jlev) = 0.0_jprb
-          do jreg = 1,nreg    ! Target layer (jlev-1)
-            do jreg2 = 1,nreg ! Current layer (jlev)
+          DO jreg = 1,nreg    ! Target layer (jlev-1)
+            DO jreg2 = 1,nreg ! Current layer (jlev)
               total_albedo(:,jreg,jreg,jlev) = total_albedo(:,jreg,jreg,jlev) &
                    &  + sum(total_albedo_below(:,:,jreg2),2) &
@@ -1005,6 +1005,6 @@
           ! ...then direct radiation:
           total_albedo_direct(:,:,:,jlev) = 0.0_jprb
-          do jreg = 1,nreg    ! Target layer (jlev-1)
-            do jreg2 = 1,nreg ! Current layer (jlev)
+          DO jreg = 1,nreg    ! Target layer (jlev-1)
+            DO jreg2 = 1,nreg ! Current layer (jlev)
               total_albedo_direct(:,jreg,jreg,jlev) = total_albedo_direct(:,jreg,jreg,jlev) &
                    &  + sum(total_albedo_below_direct(:,:,jreg2),2) &
@@ -1032,5 +1032,5 @@
           ! First diffuse radiation:
           albedo_part = total_albedo_below
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             albedo_part(:,jreg,jreg) = 0.0_jprb
           end do
@@ -1041,5 +1041,5 @@
           ! ...then direct radiation:
           albedo_part = total_albedo_below_direct
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             albedo_part(:,jreg,jreg) = 0.0_jprb
           end do
@@ -1060,6 +1060,6 @@
             ! essentially diag(total_albedo) += matmul(transpose(v_matrix),
             ! diag(total_albedo_below)).
-            do jreg = 1,nreg
-              do jreg2 = 1,nreg
+            DO jreg = 1,nreg
+              DO jreg2 = 1,nreg
                 total_albedo(:,jreg,jreg,jlev) &
                      &  = total_albedo(:,jreg,jreg,jlev) &
@@ -1076,5 +1076,5 @@
             ! "Explicit entrapment"
 
-            do jreg2 = 1,nreg
+            DO jreg2 = 1,nreg
               ! Loop through each region in the lower layer. For one
               ! of the regions in the lower layer, we are imagining it
@@ -1111,5 +1111,5 @@
                      &  / max(config%cloud_fraction_threshold, region_fracs(jreg2,jlev,jcol))
 
-                do jreg = 1, nreg-1
+                DO jreg = 1, nreg-1
                   ! Compute lateral transfer rates from region jreg to
                   ! jreg+1 as before, but without length scale which
@@ -1140,5 +1140,5 @@
               inv_effective_size = min(cloud%inv_cloud_effective_size(jcol,jlev-1), &
                    &                   1.0_jprb/config%min_cloud_effective_size)
-              do jreg = 1,nreg-1
+              DO jreg = 1,nreg-1
                 ! Diffuse transport down and up with one random
                 ! scattering event
@@ -1168,5 +1168,5 @@
               ! trival limit, so we cap the maximum input to expm by
               ! scaling down if necessary
-              do jg = 1,ng
+              DO jg = 1,ng
                 max_entr = -min(entrapment(jg,1,1),entrapment(jg,2,2))
                 if (max_entr > config%max_cloud_od) then
@@ -1198,6 +1198,6 @@
 #ifndef EXPLICIT_EDGE_ENTRAPMENT
               ! Scale to get the contribution to the diffuse albedo
-              do jreg3 = 1,nreg
-                do jreg = 1,nreg
+              DO jreg3 = 1,nreg
+                DO jreg = 1,nreg
                   albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
                        &  * v_matrix(jreg2,jreg,jlev,jcol) * total_albedo_below(:,jreg2,jreg2)
@@ -1211,11 +1211,11 @@
               albedo_part = 0.0_jprb
               ! Scale to get the contribution to the diffuse albedo
-              do jreg3 = 1,nreg     ! TO upper region
-                do jreg = 1,nreg    ! FROM upper region
+              DO jreg3 = 1,nreg     ! TO upper region
+                DO jreg = 1,nreg    ! FROM upper region
                   transfer_scaling = 1.0_jprb - (1.0_jprb - config%overhang_factor) & 
                        &  * cloud%overlap_param(jcol,jlev-1) &
                        &  * min(region_fracs(jreg,jlev,jcol), region_fracs(jreg,jlev,jcol)) &
                        &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
-                  do jreg4 = 1,nreg ! VIA first lower region (jreg2 is second lower region)
+                  DO jreg4 = 1,nreg ! VIA first lower region (jreg2 is second lower region)
                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
                       albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
@@ -1237,5 +1237,5 @@
               ! Now do the same for the direct albedo
               entrapment = 0.0_jprb
-              do jreg = 1,nreg-1
+              DO jreg = 1,nreg-1
                 ! Direct transport down and diffuse up with one random
                 ! scattering event
@@ -1265,5 +1265,5 @@
               ! trival limit, so we cap the maximum input to expm by
               ! scaling down if necessary
-              do jg = 1,ng
+              DO jg = 1,ng
                 max_entr = -min(entrapment(jg,1,1),entrapment(jg,2,2))
                 if (max_entr > config%max_cloud_od) then
@@ -1290,6 +1290,6 @@
 
 #ifndef EXPLICIT_EDGE_ENTRAPMENT
-              do jreg3 = 1,nreg
-                do jreg = 1,nreg
+              DO jreg3 = 1,nreg
+                DO jreg = 1,nreg
                   albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
                        &  * v_matrix(jreg2,jreg,jlev,jcol) * total_albedo_below_direct(:,jreg2,jreg2)
@@ -1299,11 +1299,11 @@
               entrapment = albedo_part
               albedo_part = 0.0_jprb
-              do jreg3 = 1,nreg
-                do jreg = 1,nreg
+              DO jreg3 = 1,nreg
+                DO jreg = 1,nreg
                   transfer_scaling = 1.0_jprb - (1.0_jprb - config%overhang_factor) & 
                        &  * cloud%overlap_param(jcol,jlev-1) &
                        &  * min(region_fracs(jreg,jlev,jcol), region_fracs(jreg,jlev-1,jcol)) &
                        &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
-                  do jreg4 = 1,nreg
+                  DO jreg4 = 1,nreg
                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
                      albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
@@ -1344,6 +1344,6 @@
           end if
 
-          do jreg = 1,nreg          ! Target layer (jlev-1)
-            do jreg2 = 1,nregactive ! Current layer (jlev)
+          DO jreg = 1,nreg          ! Target layer (jlev-1)
+            DO jreg2 = 1,nregactive ! Current layer (jlev)
               x_direct_above(:,jreg) = x_direct_above(:,jreg) &
                    &  + x_direct(:,jreg2) * v_matrix(jreg2,jreg,jlev,jcol)
@@ -1369,5 +1369,5 @@
       ! Direct downwelling flux (into a plane perpendicular to the
       ! sun) entering the top of each region in the top-most layer
-      do jreg = 1,nreg
+      DO jreg = 1,nreg
         direct_dn_below(:,jreg) = incoming_sw(:,jcol)*region_fracs(jreg,1,jcol)
       end do
@@ -1422,5 +1422,5 @@
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
 
 #ifdef PRINT_ENTRAPMENT_DATA
@@ -1676,5 +1676,5 @@
          &                             + tan_diffuse_angle_3d*tan_diffuse_angle_3d) * 0.5_jprb
 
-    do jreg = istartreg,iendreg
+    DO jreg = istartreg,iendreg
       ! Geometric series enhancement due to multiple scattering: the
       ! amplitude enhancement is equal to the limit of
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spectral_definition.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spectral_definition.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spectral_definition.F90	(revision 5158)
@@ -170,5 +170,5 @@
     else
       find_wavenumber = 1
-      do while (wavenumber > this%wavenumber2(find_wavenumber) &
+      DO while (wavenumber > this%wavenumber2(find_wavenumber) &
            &    .and. find_wavenumber < this%nwav)
         find_wavenumber = find_wavenumber + 1
@@ -244,7 +244,7 @@
            &                                          temperature)
 
-      do jband = 1,this%nband
+      DO jband = 1,this%nband
         weight = 0.0_jprb
-        do jwav = 1,nwav
+        DO jwav = 1,nwav
           ! Work out wavenumber range for which this cloud wavenumber
           ! will be applicable
@@ -281,5 +281,5 @@
             ! Find interpolating points
             iwav = 2
-            do while (wavenumber(iwav) < this%wavenumber2_band(jband))
+            DO while (wavenumber(iwav) < this%wavenumber2_band(jband))
               iwav = iwav+1
             end do
@@ -314,5 +314,5 @@
       mapping = 0.0_jprb
       ! Loop over wavenumbers representing cloud
-      do jwav = 1,nwav
+      DO jwav = 1,nwav
         ! Clear the weights. The weight says for one wavenumber in the
         ! cloud file, what is its fractional contribution to each of
@@ -356,5 +356,5 @@
                  &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
             if (isd1-isd0 > 1) then
-              do isd = isd0+1,isd1-1
+              DO isd = isd0+1,isd1-1
                 ! Intermediate trapezia
                 weight(isd) = 0.5_jprb * (this%wavenumber1(isd)+this%wavenumber2(isd) &
@@ -403,5 +403,5 @@
                  &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
             if (isd2-isd1 > 1) then
-              do isd = isd1+1,isd2-1
+              DO isd = isd1+1,isd2-1
                 ! Intermediate trapezia
                 weight(isd) = weight(isd) + 0.5_jprb * (2.0_jprb*wavenum2 &
@@ -424,5 +424,5 @@
         weight = weight * planck_weight
 
-        do jg = 1,this%ng
+        DO jg = 1,this%ng
           mapping(jg, jwav) = sum(weight * this%gpoint_fraction(:,jg))
         end do
@@ -434,5 +434,5 @@
 
       ! Normalize mapping matrix
-      do jg = 1,this%ng
+      DO jg = 1,this%ng
         mapping(jg,:) = mapping(jg,:) * (1.0_jprb/sum(mapping(jg,:)))
       end do
@@ -548,5 +548,5 @@
     ! Check wavelength is monotonically increasing
     if (ninterval > 2) then
-      do jint = 2,ninterval-1
+      DO jint = 2,ninterval-1
         if (wavelength_bound(jint) <= wavelength_bound(jint-1)) then
           write(nulerr, '(a)') '*** Error: wavelength bounds must be monotonically increasing'
@@ -568,6 +568,6 @@
       end if
 
-      do jband = 1,this%nband
-        do jint = 1,ninterval
+      DO jband = 1,this%nband
+        DO jint = 1,ninterval
           if (jint == 1) then
             ! First input interval in wavelength space: lower
@@ -643,5 +643,5 @@
       
       ! All bounded intervals
-      do jint = 2,ninterval-1
+      DO jint = 2,ninterval-1
         wavenumber1_bound = 0.01_jprb / wavelength_bound(jint)
         wavenumber2_bound = 0.01_jprb / wavelength_bound(jint-1)
@@ -661,6 +661,6 @@
       end if
 
-      do jg = 1,this%ng
-        do jin = 1,ninput
+      DO jg = 1,this%ng
+        DO jin = 1,ninput
           mapping(jin,jg) = sum(this%gpoint_fraction(:,jg) * planck, &
                &                 mask=(i_input==jin))
@@ -675,5 +675,5 @@
     if (.not. use_fluxes_local) then
       ! Normalize mapping matrix
-      do jg = 1,size(mapping,dim=2)
+      DO jg = 1,size(mapping,dim=2)
         mapping(:,jg) = mapping(:,jg) * (1.0_jprb/sum(mapping(:,jg)))
       end do
@@ -736,5 +736,5 @@
     is_band_unassigned = .true.
 
-    do jint = 1,ninterval
+    DO jint = 1,ninterval
       inext = minloc(wavelength1, dim=1, mask=is_band_unassigned)
       if (jint > 1) then
@@ -782,8 +782,8 @@
       write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' bands (wavenumber ranges in cm-1)'
       if (nout <= 40) then
-        do jout = 1,nout
+        DO jout = 1,nout
           write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
                &                        nint(this%wavenumber2_band(jout)), ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -791,8 +791,8 @@
         end do
       else
-        do jout = 1,30
+        DO jout = 1,30
           write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
                &                        nint(this%wavenumber2_band(jout)), ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -802,5 +802,5 @@
         write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(nout)), ' to', &
              &                        nint(this%wavenumber2_band(nout)), ':'
-        do jin = 1,nin
+        DO jin = 1,nin
           write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
         end do
@@ -810,7 +810,7 @@
       write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' g-points'
       if (nout <= 40) then
-        do jout = 1,nout
+        DO jout = 1,nout
           write(nulout,'(i3,a)',advance='no') jout, ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -818,7 +818,7 @@
         end do
       else
-        do jout = 1,30
+        DO jout = 1,30
           write(nulout,'(i3,a)',advance='no') jout, ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -827,5 +827,5 @@
         write(nulout,'(a)') '  ...'
         write(nulout,'(i3,a)',advance='no') nout, ':'
-        do jin = 1,nin
+        DO jin = 1,nin
           write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
         end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_thermodynamics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_thermodynamics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_thermodynamics.F90	(revision 5158)
@@ -143,6 +143,6 @@
     end if
 
-    do jlev = 1,nlev
-       do jcol = istartcol,iendcol
+    DO jlev = 1,nlev
+       DO jcol = istartcol,iendcol
           pressure = 0.5 * (this%pressure_hl(jcol,jlev)+this%pressure_hl(jcol,jlev+1))
           temperature = 0.5 * (this%temperature_hl(jcol,jlev)+this%temperature_hl(jcol,jlev+1))
@@ -265,5 +265,5 @@
       ! be half the separation between the half-levels at the edge of
       ! the two adjacent layers
-      do jlev = 2,nlev-1
+      DO jlev = 2,nlev-1
         layer_separation(i1:i2,jlev) = (0.5_jprb * R_over_g) * temperature_hl(i1:i2,jlev+1) &
              &                    * log(pressure_hl(i1:i2,jlev+2)/pressure_hl(i1:i2,jlev))
@@ -276,5 +276,5 @@
       ! don't take the logarithm of the last pressure in each column.
 
-      do jlev = 1,nlev-2
+      DO jlev = 1,nlev-2
         layer_separation(i1:i2,jlev) = (0.5_jprb * R_over_g) * temperature_hl(i1:i2,jlev+1) &
              &                    * log(pressure_hl(i1:i2,jlev)/pressure_hl(i1:i2,jlev+2))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_lw.F90	(revision 5158)
@@ -206,5 +206,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -215,5 +215,5 @@
       is_clear_sky_layer = .true.
       i_cloud_top = nlev+1
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -236,5 +236,5 @@
       if (.not. config%do_lw_aerosol_scattering) then
         ! No scattering in clear-sky flux calculation
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           ! Array-wise assignments
           gamma1 = 0.0_jprb
@@ -252,5 +252,5 @@
       else
         ! Scattering in clear-sky flux calculation
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           ! Array-wise assignments
           gamma1 = 0.0_jprb
@@ -279,5 +279,5 @@
         ! Save the spectral fluxes if required
         if (config%do_save_spectral_flux) then
-          do jlev = 1,nlev+1
+          DO jlev = 1,nlev+1
             call indexed_sum(flux_up_clear(:,jlev), &
                  &           config%i_spec_from_reordered_g_lw, &
@@ -305,5 +305,5 @@
       end if
 
-      do jlev = i_cloud_top,nlev ! Start at cloud top and work down
+      DO jlev = i_cloud_top,nlev ! Start at cloud top and work down
 
         ! Array-wise assignments
@@ -323,5 +323,5 @@
           source_dn(:,2:,jlev)     = 0.0_jprb
         else
-          do jreg = 2,nreg
+          DO jreg = 2,nreg
             ! Cloudy sky
             ! Add scaled cloud optical depth to clear-sky value
@@ -375,5 +375,5 @@
           end do
           ! Emission is scaled by the size of each region
-          do jreg = 1,nregions
+          DO jreg = 1,nregions
             source_up(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * source_up(:,jreg,jlev)
             source_dn(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * source_dn(:,jreg,jlev)
@@ -392,6 +392,6 @@
       ! Calculate the upwelling radiation emitted by the surface, and
       ! copy the surface albedo into total_albedo 
-      do jreg = 1,nregions
-        do jg = 1,ng
+      DO jreg = 1,nregions
+        DO jg = 1,ng
           ! region_fracs(jreg,nlev,jcol) is the fraction of each region in the
           ! lowest model level
@@ -404,5 +404,5 @@
       ! atmosphere and the total upwelling due to emission below each
       ! level below using the adding method
-      do jlev = nlev,i_cloud_top,-1
+      DO jlev = nlev,i_cloud_top,-1
 
         total_albedo_below        = 0.0_jprb
@@ -411,5 +411,5 @@
           total_albedo_below = 0.0_jprb
           total_source_below = 0.0_jprb
-          do jg = 1,ng
+          DO jg = 1,ng
             inv_denom(jg,1) = 1.0_jprb &
                  &  / (1.0_jprb - total_albedo(jg,1,jlev+1)*reflectance(jg,1,jlev))
@@ -445,6 +445,6 @@
           ! the operation we perform is essentially diag(total_albedo)
           ! = matmul(transpose(v_matrix), diag(total_albedo_below)).
-          do jreg = 1,nregions
-            do jreg2 = 1,nregions
+          DO jreg = 1,nregions
+            DO jreg2 = 1,nregions
               total_albedo(:,jreg,jlev) &
                    &  = total_albedo(:,jreg,jlev) &
@@ -462,5 +462,5 @@
       ! Section 6: Copy over downwelling fluxes above cloud top
       ! --------------------------------------------------------
-      do jlev = 1,i_cloud_top
+      DO jlev = 1,i_cloud_top
         if (config%do_clear) then
           ! Clear-sky fluxes have already been averaged: use these
@@ -493,5 +493,5 @@
              &           flux%lw_up_band(:,jcol,i_cloud_top))
       end if
-      do jlev = i_cloud_top-1,1,-1
+      DO jlev = i_cloud_top-1,1,-1
         flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev)
         flux%lw_up(jcol,jlev) = sum(flux_up(:,1))
@@ -510,13 +510,13 @@
       ! scattering layer, using overlap matrix to translate to the
       ! regions of the first layer of cloud
-      do jreg = 1,nregions
+      DO jreg = 1,nregions
         flux_dn(:,jreg)  = v_matrix(jreg,1,i_cloud_top,jcol)*flux_dn_clear(:,i_cloud_top)
       end do
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = i_cloud_top,nlev
+      DO jlev = i_cloud_top,nlev
 
         if (is_clear_sky_layer(jlev)) then
-          do jg = 1,ng
+          DO jg = 1,ng
             flux_dn(jg,1) = (transmittance(jg,1,jlev)*flux_dn(jg,1) &
                  &  + reflectance(jg,1,jlev)*total_source(jg,1,jlev+1) + source_dn(jg,1,jlev) ) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_sw.F90	(revision 5158)
@@ -196,5 +196,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -249,5 +249,5 @@
       ! cloud%crop_cloud_fraction has already been called
       is_clear_sky_layer = .true.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -260,5 +260,5 @@
       ! In this section the reflectance, transmittance and sources
       ! are computed for each layer
-      do jlev = 1,nlev ! Start at top-of-atmosphere
+      DO jlev = 1,nlev ! Start at top-of-atmosphere
 
         ! Array-wise assignments
@@ -271,5 +271,5 @@
           nreg = 1
         end if
-        do jreg = 1,nreg
+        DO jreg = 1,nreg
           if (jreg == 1) then
             od_total  =  od(:,jlev,jcol)
@@ -277,5 +277,5 @@
             g_total   =   g(:,jlev,jcol)
           else
-            do jg = 1,ng
+            DO jg = 1,ng
               ! Mapping from g-point to band
               iband = config%i_band_from_reordered_g_sw(jg)
@@ -321,5 +321,5 @@
 
       ! Copy surface albedo in clear-sky region
-      do jg = 1,ng
+      DO jg = 1,ng
         total_albedo(jg,1,nlev+1) = albedo_diffuse(jg,jcol)
       end do
@@ -327,5 +327,5 @@
       ! If direct albedo is available, use it; otherwise copy from
       ! diffuse albedo
-      do jg = 1,ng
+      DO jg = 1,ng
         total_albedo_direct(jg,1,nlev+1) &
              &  = mu0 * albedo_direct(jg,jcol)
@@ -335,5 +335,5 @@
       ! underneath
       if (.not. is_clear_sky_layer(nlev)) then
-        do jreg = 2,nregions
+        DO jreg = 2,nregions
           total_albedo(:,jreg,nlev+1)        = total_albedo(:,1,nlev+1)
           total_albedo_direct(:,jreg,nlev+1) = total_albedo_direct(:,1,nlev+1)
@@ -348,5 +348,5 @@
       ! Work up from the surface computing the total albedo of the
       ! atmosphere below that point using the adding method
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
 
         total_albedo_below        = 0.0_jprb
@@ -357,5 +357,5 @@
           ! "below" quantities since with no cloud overlap to worry
           ! about, these are the same
-          do jg = 1,ng
+          DO jg = 1,ng
             inv_denom(jg,1) = 1.0_jprb &
                  &  / (1.0_jprb - total_albedo_clear(jg,jlev+1)*reflectance(jg,1,jlev))
@@ -371,5 +371,5 @@
 
         if (is_clear_sky_layer(jlev)) then
-          do jg = 1,ng
+          DO jg = 1,ng
             inv_denom(jg,1) = 1.0_jprb &
                  &  / (1.0_jprb - total_albedo(jg,1,jlev+1)*reflectance(jg,1,jlev))
@@ -403,6 +403,6 @@
           ! the operation we perform is essentially diag(total_albedo)
           ! = matmul(transpose(v_matrix)), diag(total_albedo_below)).
-          do jreg = 1,nregions
-            do jreg2 = 1,nregions
+          DO jreg = 1,nregions
+            DO jreg2 = 1,nregions
               total_albedo(:,jreg,jlev) &
                    &  = total_albedo(:,jreg,jlev) &
@@ -429,5 +429,5 @@
       ! Direct downwelling flux (into a plane perpendicular to the
       ! sun) entering the top of each region in the top-most layer
-      do jreg = 1,nregions
+      DO jreg = 1,nregions
         direct_dn(:,jreg) = incoming_sw(:,jcol)*region_fracs(jreg,1,jcol)
       end do
@@ -491,7 +491,7 @@
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_clear) then
-          do jg = 1,ng
+          DO jg = 1,ng
             flux_dn_clear(jg) = (transmittance(jg,1,jlev)*flux_dn_clear(jg) + direct_dn_clear(jg) &
                &  * (trans_dir_dir(jg,1,jlev)*total_albedo_clear_direct(jg,jlev+1)*reflectance(jg,1,jlev) &
@@ -505,5 +505,5 @@
 
         if (is_clear_sky_layer(jlev)) then
-          do jg = 1,ng
+          DO jg = 1,ng
             flux_dn(jg,1) = (transmittance(jg,1,jlev)*flux_dn(jg,1) + direct_dn(jg,1) &
                  &  * (trans_dir_dir(jg,1,jlev)*total_albedo_direct(jg,1,jlev+1)*reflectance(jg,1,jlev) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_two_stream.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_two_stream.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_two_stream.F90	(revision 5158)
@@ -91,5 +91,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       ! Fu et al. (1997), Eq 2.9 and 2.10:
       !      gamma1(jg) = LwDiffusivity * (1.0_jprb - 0.5_jprb*ssa(jg) &
@@ -141,5 +141,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       !      gamma1(jg) = 2.0_jprb  - ssa(jg) * (1.25_jprb + 0.75_jprb*g(jg))
       !      gamma2(jg) = 0.75_jprb *(ssa(jg) * (1.0_jprb - g(jg)))
@@ -212,5 +212,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       if (od(jg) > 1.0e-3_jprd) then
         k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
@@ -302,5 +302,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
            1.E-12_jprd)) ! Eq 18 of Meador & Weaver (1980)
@@ -370,5 +370,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       ! Compute upward and downward emission assuming the Planck
       ! function to vary linearly with optical depth within the layer
@@ -474,5 +474,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
 
         gamma4 = 1.0_jprd - gamma3(jg)
@@ -607,5 +607,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       od_over_mu0 = max(gamma0(jg) * depth, 0.0_jprd)
       ! In the IFS this appears to be faster without testing the value
@@ -721,5 +721,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       ! Note that if the minimum value is reduced (e.g. to 1.0e-24)
       ! then noise starts to appear as a function of solar zenith
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radsurf_intermediate.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radsurf_intermediate.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radsurf_intermediate.F90	(revision 5158)
@@ -357,5 +357,5 @@
       ! Put shortwave albedo on g-point grid and permute
       i_albedo_from_g = config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw)
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         this%sw_albedo_diffuse(:,:,jcol) = surface%sw_albedo(jcol,i_albedo_from_g,:)
         if (allocated(surface%sw_albedo_direct)) then
@@ -366,5 +366,5 @@
       end do
     else
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         ! No change to spectral resolution: simply permute 
         this%sw_albedo_diffuse(:,:,jcol) = surface%sw_albedo(jcol,:,:)
@@ -391,8 +391,8 @@
 
       ! Loop over column and tile
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         cos_sza = single_level%cos_sza(jcol)
 
-        do jtile = 1,surface%ntile
+        DO jtile = 1,surface%ntile
           tile_fraction = surface%tile_fraction(jcol,jtile)
 
@@ -647,11 +647,11 @@
     if (config%use_canopy_full_spectrum_lw) then
       ! Put longwave emissivity on g-point grid and permute      
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         this%lw_emissivity(:,:,jcol) = surface%lw_emissivity(jcol,config%i_emiss_from_band_lw( &
              &                           config%i_band_from_reordered_g_lw),:)
       end do
       ! Compute Planck function at each facet
-      do jfacet = 1,surface%nfacet
-        do jcol = istartcol,iendcol
+      DO jfacet = 1,surface%nfacet
+        DO jcol = istartcol,iendcol
           ! FIX this function assumes contiguous data for planck_facet
           ! so copies into a temporary
@@ -661,6 +661,6 @@
         end do
       end do
-      do jtile = 1,surface%ntile
-        do jcol = istartcol,iendcol
+      DO jtile = 1,surface%ntile
+        DO jcol = istartcol,iendcol
           iregion = surface%i_region_1(jcol,jtile)
           if (iregion > 0) then
@@ -676,15 +676,15 @@
         call radiation_abort()
       end if
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         ! No change to spectral resolution: simply permute
         this%lw_emissivity(:,:,jcol) = surface%lw_emissivity(jcol,:,:)
       end do
       ! Broadband calculation: Stefan-Boltzmann law
-      do jfacet = 1,surface%nfacet
+      DO jfacet = 1,surface%nfacet
         this%planck_facet(1,jfacet,istartcol:iendcol) &
              &  = StefanBoltzmann*surface%skin_temperature(istartcol:iendcol,jfacet)**4
       end do
-      do jtile = 1,surface%ntile
-        do jcol = istartcol,iendcol
+      DO jtile = 1,surface%ntile
+        DO jcol = istartcol,iendcol
           iregion = surface%i_region_1(jcol,jtile)
           if (iregion > 0) then
@@ -712,7 +712,7 @@
 
       ! Loop over column and tile
-      do jcol = istartcol,iendcol
-
-        do jtile = 1,surface%ntile
+      DO jcol = istartcol,iendcol
+
+        DO jtile = 1,surface%ntile
           tile_fraction = surface%tile_fraction(jcol,jtile)
 
@@ -1009,5 +1009,5 @@
 
     ! Scale optical depths to extinction
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       layer_depth = R_over_g &
              &  * (thermodynamics%pressure_hl(jcol,iendlev+1) &
@@ -1090,6 +1090,6 @@
 
       ! Loop over column and tile
-      do jcol = istartcol,iendcol
-        do jtile = 1,surface%ntile
+      DO jcol = istartcol,iendcol
+        DO jtile = 1,surface%ntile
           tile_fraction = surface%tile_fraction(jcol,jtile)
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radsurf_properties.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radsurf_properties.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radsurf_properties.F90	(revision 5158)
@@ -250,5 +250,5 @@
       ifacet = 1
       iregion = 1
-      do jtile = 1,this%ntile
+      DO jtile = 1,this%ntile
         this%i_ground_facet(:,jtile) = ifacet
         ifacet = ifacet + 1
@@ -360,5 +360,5 @@
       ifacet  = 1
       iregion = 1;
-      do jtile = 1,ntile
+      DO jtile = 1,ntile
         write(nulout,'(a,i0,a,a)') '  Tile ', jtile, ': ', trim(TileRepresentationName(i_representation(jtile)))
         write(nulout,'(a,i0,a)') '    Facet ', ifacet, ': ground'
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/raise.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/raise.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/raise.h	(revision 5158)
@@ -21,6 +21,6 @@
 
 extern void abor1fl_(const char *filename, const int *linenum, 
-		     const char *s, 
-		     int filenamelen, int slen);
+             const char *s,
+             int filenamelen, int slen);
 extern void abor1_(const char *s, int slen);
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver.F90	(revision 5158)
@@ -311,5 +311,5 @@
   tstart = omp_get_wtime() 
 #endif
-  do jrepeat = 1,driver_config%nrepeat
+  DO jrepeat = 1,driver_config%nrepeat
     
     if (driver_config%do_parallel) then
@@ -321,5 +321,5 @@
      
       !$OMP PARALLEL DO PRIVATE(istartcol, iendcol) SCHEDULE(RUNTIME)
-      do jblock = 1, nblock
+      DO jblock = 1, nblock
         ! Specify the range of columns to process.
         istartcol = (jblock-1) * driver_config%nblocksize &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_config.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_config.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_config.F90	(revision 5158)
@@ -400,5 +400,5 @@
     ! wavelength bound, noting that the number of diagnostics is one
     ! fewer than the number of valid bounds
-    do jdiag = 0,NMaxSpectralDiag
+    DO jdiag = 0,NMaxSpectralDiag
       if (this%sw_diag_wavelength_bound(jdiag+1) < 0.0_jprb) then
         this%n_sw_diag = max(0,jdiag-1)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_read_input.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_read_input.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_read_input.F90	(revision 5158)
@@ -563,5 +563,5 @@
 
     ! Loop through all radiatively important gases
-    do jgas = 1,NMaxGases
+    DO jgas = 1,NMaxGases
       if (jgas == IH2O) then
         if (file%exists('q')) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_ifs_driver.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_ifs_driver.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_ifs_driver.F90	(revision 5158)
@@ -369,5 +369,5 @@
   tstart = omp_get_wtime()
 #endif
-  do jrepeat = 1,driver_config%nrepeat
+  DO jrepeat = 1,driver_config%nrepeat
 
 !    if (driver_config%do_parallel) then
@@ -379,5 +379,5 @@
 
       !$OMP PARALLEL DO PRIVATE(istartcol, iendcol) SCHEDULE(RUNTIME)
-      do jblock = 1, nblock
+      DO jblock = 1, nblock
         ! Specify the range of columns to process.
         istartcol = (jblock-1) * driver_config%nblocksize &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_ifs_driver_blocked.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_ifs_driver_blocked.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_ifs_driver_blocked.F90	(revision 5158)
@@ -371,5 +371,5 @@
   tstart = omp_get_wtime()
 #endif
-  do jrepeat = 1,driver_config%nrepeat
+  DO jrepeat = 1,driver_config%nrepeat
 
 !    if (driver_config%do_parallel) then
@@ -378,5 +378,5 @@
       !$OMP PARALLEL DO SCHEDULE(DYNAMIC,1)&
       !$OMP&PRIVATE(JRL,IBEG,IEND,IL,IB)
-      do jrl=1,ncol,nproma
+      DO jrl=1,ncol,nproma
         ibeg=jrl
         iend=min(ibeg+nproma-1,ncol)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ifs_blocking.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ifs_blocking.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ifs_blocking.F90	(revision 5158)
@@ -329,6 +329,6 @@
   !$OMP PARALLEL DO SCHEDULE(RUNTIME)&
   !$OMP&PRIVATE(IB,IFLD)
-  do ib=1,ngpblks
-    do ifld=1,ifs_config%ifldstot
+  DO ib=1,ngpblks
+    DO ifld=1,ifs_config%ifldstot
       zrgp(:,ifld,ib) = 0._jprb
     enddo
@@ -351,5 +351,5 @@
     !$OMP PARALLEL DO SCHEDULE(RUNTIME)&
     !$OMP&PRIVATE(JRL,IBEG,IEND,IL,IB,JAER,JOFF,JLEV,JALB)
-    do jrl=1,ncol,nproma
+    DO jrl=1,ncol,nproma
 
       ibeg=jrl
@@ -363,5 +363,5 @@
       zrgp(1:il,ifs_config%iamu0,ib)  =  single_level%cos_sza(ibeg:iend)   ! cosine of solar zenith ang (mu0)
 
-      do jemiss=1,yderad%nlwemiss
+      DO jemiss=1,yderad%nlwemiss
         zrgp(1:il,ifs_config%iemiss+jemiss-1,ib)  =  single_level%lw_emissivity(ibeg:iend,jemiss)
       enddo
@@ -378,19 +378,19 @@
       ! zrgp(1:il,islon,ib)    = ???
 
-      do jalb=1,yderad%nsw
+      DO jalb=1,yderad%nsw
         zrgp(1:il,ifs_config%iald+jalb-1,ib)  =  single_level%sw_albedo(ibeg:iend,jalb)
       enddo
 
       if (allocated(single_level%sw_albedo_direct)) then
-        do jalb=1,yderad%nsw
+        DO jalb=1,yderad%nsw
           zrgp(1:il,ifs_config%ialp+jalb-1,ib)  =  single_level%sw_albedo_direct(ibeg:iend,jalb)
         end do
       else
-        do jalb=1,yderad%nsw
+        DO jalb=1,yderad%nsw
           zrgp(1:il,ifs_config%ialp+jalb-1,ib)  =  single_level%sw_albedo(ibeg:iend,jalb)
         end do
       end if
       
-      do jlev=1,nlev
+      DO jlev=1,nlev
         zrgp(1:il,ifs_config%iti+jlev-1,ib)   = temperature_fl(ibeg:iend,jlev) ! full level temperature
         zrgp(1:il,ifs_config%ipr+jlev-1,ib)   = pressure_fl(ibeg:iend,jlev) ! full level pressure
@@ -398,5 +398,5 @@
       enddo
 
-      do jlev=1,nlev
+      DO jlev=1,nlev
         zrgp(1:il,ifs_config%iwv+jlev-1,ib)   = gas%mixing_ratio(ibeg:iend,jlev,IH2O) ! this is already in MassMixingRatio units
         if (rad_config%do_clouds) then
@@ -421,6 +421,6 @@
       if (yderad%naermacc == 1) then
         joff=ifs_config%iaero
-        do jaer=1,rad_config%n_aerosol_types
-          do jlev=1,nlev
+        DO jaer=1,rad_config%n_aerosol_types
+          DO jlev=1,nlev
             zrgp(1:il,joff,ib) = aerosol%mixing_ratio(ibeg:iend,jlev,jaer)
             joff=joff+1
@@ -429,5 +429,5 @@
       endif
 
-      do jlev=1,nlev+1
+      DO jlev=1,nlev+1
         ! zrgp(1:il,ihpr+jlev-1,ib)  = ???
         zrgp(1:il,ifs_config%iaprs+jlev-1,ib) = thermodynamics%pressure_hl(ibeg:iend,jlev)
@@ -453,10 +453,10 @@
       ! local workaround variables for standalone input files
       if (rad_config%do_clouds) then
-        do jlev=1,nlev
+        DO jlev=1,nlev
           ! missing full-level temperature and pressure as well as land-sea-mask
           zrgp(1:il,ifs_config%ire_liq+jlev-1,ib) = cloud%re_liq(ibeg:iend,jlev)
           zrgp(1:il,ifs_config%ire_ice+jlev-1,ib) = cloud%re_ice(ibeg:iend,jlev)
         enddo
-        do jlev=1,nlev-1
+        DO jlev=1,nlev-1
           ! for the love of it, I can't figure this one out. Probably to do with
           ! my crude approach of setting PGEMU?
@@ -465,10 +465,10 @@
         if(present(iseed)) iseed(1:il,ib) = single_level%iseed(ibeg:iend)
       else
-        do jlev=1,nlev
+        DO jlev=1,nlev
           ! missing full-level temperature and pressure as well as land-sea-mask
           zrgp(1:il,ifs_config%ire_liq+jlev-1,ib) = 0._jprb
           zrgp(1:il,ifs_config%ire_ice+jlev-1,ib) = 0._jprb
         enddo
-        do jlev=1,nlev-1
+        DO jlev=1,nlev-1
           zrgp(1:il,ifs_config%ioverlap+jlev-1,ib) = 0._jprb
         enddo
@@ -531,5 +531,5 @@
     !$OMP PARALLEL DO SCHEDULE(RUNTIME)&
     !$OMP&PRIVATE(JRL,IBEG,IEND,IL,IB,JLEV,JG)
-    do jrl=1,ncol,nproma
+    DO jrl=1,ncol,nproma
       ibeg=jrl
       iend=min(ibeg+nproma-1,ncol)
@@ -537,5 +537,5 @@
       ib=(jrl-1)/nproma+1
 
-      do jlev=1,nlev+1
+      DO jlev=1,nlev+1
         flux%sw_up(ibeg:iend,jlev) = zrgp(1:il,ifs_config%ifrso+jlev-1,ib)
         flux%lw_up(ibeg:iend,jlev) = zrgp(1:il,ifs_config%ifrth+jlev-1,ib)
@@ -561,5 +561,5 @@
       emissivity_out(ibeg:iend) = zrgp(1:il,ifs_config%iemit,ib)
       if (yradiation%yrerad%lapproxswupdate) then
-        do jg=1,yradiation%yrerad%nsw
+        DO jg=1,yradiation%yrerad%nsw
           flux_diffuse_band(ibeg:iend,jg) = zrgp(1:il,ifs_config%iswdiffuseband+jg-1,ib)
           flux_direct_band(ibeg:iend,jg) = zrgp(1:il,ifs_config%iswdirectband+jg-1,ib)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_cloud_generator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_cloud_generator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_cloud_generator.F90	(revision 5158)
@@ -57,6 +57,6 @@
        &  od_scaling, total_cloud_cover)
 
-  do jlev = 1,nlev
-    do jcol = 1,ncol
+  DO jlev = 1,nlev
+    DO jcol = 1,ncol
       write(6,'(f5.2,a)',advance='no') od_scaling(jcol,jlev), ' '
     end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_random_number_generator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_random_number_generator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_random_number_generator.F90	(revision 5158)
@@ -29,5 +29,5 @@
   call random_number_generator%initialize(itype=IRngType, iseed=212075152, &
        &                                  nmaxstreams=streammax)
-  do jl = 1,1
+  DO jl = 1,1
     print *, 'initial_state = [ ', int(random_number_generator%istate(1:streammax),jpib), ' ]'
     call random_number_generator%uniform_distribution(vec)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_spartacus_math.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_spartacus_math.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/test_spartacus_math.F90	(revision 5158)
@@ -45,10 +45,10 @@
 
   write(*,*) 'A ='
-  do j = 1,m
+  DO j = 1,m
      write(*,*) A(1,j,:)
   end do
 
   write(*,*) 'B ='
-  do j = 1,m
+  DO j = 1,m
      write(*,*) B(1,j,:)
   end do
@@ -60,5 +60,5 @@
 
   write(*,*) 'C = A*B ='
-  do j = 1,m
+  DO j = 1,m
      write(*,*) C(1,j,:)
   end do
@@ -70,5 +70,5 @@
 
   write(*,*) 'C = A\B ='
-  do j = 1,m
+  DO j = 1,m
      write(*,*) C(1,j,:)
   end do
@@ -78,5 +78,5 @@
 
   write(*,*) 'expm(A) ='
-  do j = 1,m
+  DO j = 1,m
      write(*,*) A(1,j,:)
   end do
@@ -93,5 +93,5 @@
     
     write(*,*) 'fast_expm(A) = '
-    do j = 1,m
+    DO j = 1,m
       write(*,*) A(1,j,:)
     end do
@@ -106,5 +106,5 @@
     
     write(*,*) 'expm(A) = '
-    do j = 1,m
+    DO j = 1,m
       write(*,*) A(1,j,:)
     end do
@@ -115,5 +115,5 @@
     
     write(*,*) 'expm(zeros) = '
-    do j = 1,m
+    DO j = 1,m
       write(*,*) A(1,j,:)
     end do
@@ -124,5 +124,5 @@
     
     write(*,*) 'fast_expm(A) = '
-    do j = 1,m
+    DO j = 1,m
       write(*,*) A(1,j,:)
     end do
@@ -140,5 +140,5 @@
     
     write(*,*) 'expm(A) = '
-    do j = 1,m
+    DO j = 1,m
       write(*,*) A(1,j,:)
     end do
@@ -149,5 +149,5 @@
     
     write(*,*) 'expm(zeros) = '
-    do j = 1,m
+    DO j = 1,m
       write(*,*) A(1,j,:)
     end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/ifs/fcttre.func.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/ifs/fcttre.func.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/ifs/fcttre.func.h	(revision 5158)
@@ -170,7 +170,7 @@
 FOEELIQ2ICE( PTARE )  = EXP(      (PTARE-RTT)*(R3LES/(PTARE-R4LES) - R3IES/(PTARE-R4IES)))
 FOELSON( PTARE ) = EXP( -6096.9385_JPRB/PTARE + 21.2409642_JPRB &
-	             - 2.711193E-2_JPRB * PTARE    &
+                 - 2.711193E-2_JPRB * PTARE    &
                      + 1.673952E-5_JPRB * PTARE**2 &
-		     + 2.433502_JPRB * LOG(PTARE))
+             + 2.433502_JPRB * LOG(PTARE))
 
 REAL(KIND=JPRB) :: FOEEWM_V,FOEEWMCU_V,FOELES_V,FOEIES_V
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/aeropt_5wv_ecrad.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/aeropt_5wv_ecrad.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/lmdz/aeropt_5wv_ecrad.F90	(revision 5158)
@@ -54,8 +54,8 @@
 
       ! Loop over level
-     do jlev = istartlev,iendlev
+     DO jlev = istartlev,iendlev
 
         ! Loop over column
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
 
           ! Compute relative humidity with respect to liquid
@@ -71,5 +71,5 @@
           od_aerosol_mono = 0.0_jprb
 
-          do jtype = 1,config%n_aerosol_types
+          DO jtype = 1,config%n_aerosol_types
             ! Add the optical depth for this aerosol type to the total for all aerosols.  
             ! Note that the following expressions are array-wise
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_adding_ica_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_adding_ica_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_adding_ica_lw.F90	(revision 5158)
@@ -83,5 +83,5 @@
     ! also the "source", which is the upwelling flux due to emission
     ! below that level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       ! Next loop over columns. We could do this by indexing the
       ! entire inner dimension as follows, e.g. for the first line:
@@ -90,5 +90,5 @@
       ! routine by a factor of 2!  Rather, we do it with an explicit
       ! loop.
-      do jcol = 1,ncol
+      DO jcol = 1,ncol
         ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
         inv_denominator(jcol,jlev) = 1.0_jprb &
@@ -114,6 +114,6 @@
     ! Work back down through the atmosphere computing the fluxes at
     ! each half-level
-    do jlev = 1,nlev
-      do jcol = 1,ncol
+    DO jlev = 1,nlev
+      DO jcol = 1,ncol
         ! Shonk & Hogan (2008) Eq 14 (after simplification):
         flux_dn(jcol,jlev+1) &
@@ -201,8 +201,8 @@
     ! also the "source", which is the upwelling flux due to emission
     ! below that level
-    do jlev = nlev,i_cloud_top,-1
+    DO jlev = nlev,i_cloud_top,-1
       if (is_clear_sky_layer(jlev)) then
         ! Reflectance of this layer is zero, simplifying the expression
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           albedo(jcol,jlev) = transmittance(jcol,jlev)*transmittance(jcol,jlev)*albedo(jcol,jlev+1)
           source(jcol,jlev) = source_up(jcol,jlev) &
@@ -212,5 +212,5 @@
       else
         ! Loop over columns; explicit loop seems to be faster
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
           inv_denominator(jcol,jlev) = 1.0_jprb &
@@ -231,5 +231,5 @@
     flux_up(:,i_cloud_top) = source(:,i_cloud_top) &
          &                 + albedo(:,i_cloud_top)*flux_dn(:,i_cloud_top)
-    do jlev = i_cloud_top-1,1,-1
+    DO jlev = i_cloud_top-1,1,-1
       flux_up(:,jlev) = transmittance(:,jlev)*flux_up(:,jlev+1) + source_up(:,jlev)
     end do
@@ -237,7 +237,7 @@
     ! Work back down through the atmosphere from cloud top computing
     ! the fluxes at each half-level
-    do jlev = i_cloud_top,nlev
+    DO jlev = i_cloud_top,nlev
       if (is_clear_sky_layer(jlev)) then
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           flux_dn(jcol,jlev+1) = transmittance(jcol,jlev)*flux_dn(jcol,jlev) &
                &               + source_dn(jcol,jlev)
@@ -246,5 +246,5 @@
         end do
       else
-        do jcol = 1,ncol
+        DO jcol = 1,ncol
           ! Shonk & Hogan (2008) Eq 14 (after simplification):
           flux_dn(jcol,jlev+1) &
@@ -309,6 +309,6 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = 1,nlev
-      do jcol = 1,ncol
+    DO jlev = 1,nlev
+      DO jcol = 1,ncol
         flux_dn(jcol,jlev+1) = transmittance(jcol,jlev)*flux_dn(jcol,jlev) + source_dn(jcol,jlev)
       end do
@@ -322,6 +322,6 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = nlev,1,-1
-      do jcol = 1,ncol
+    DO jlev = nlev,1,-1
+      DO jcol = 1,ncol
         flux_up(jcol,jlev) = transmittance(jcol,jlev)*flux_up(jcol,jlev+1) + source_up(jcol,jlev)
       end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_adding_ica_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_adding_ica_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_adding_ica_sw.F90	(revision 5158)
@@ -84,5 +84,5 @@
     ! half-level by working down through the atmosphere
     flux_dn_direct(:,1) = incoming_toa
-    do jlev = 1,nlev
+    DO jlev = 1,nlev
       flux_dn_direct(:,jlev+1) = flux_dn_direct(:,jlev)*trans_dir_dir(:,jlev)
     end do
@@ -100,5 +100,5 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       ! Next loop over columns. We could do this by indexing the
       ! entire inner dimension as follows, e.g. for the first line:
@@ -107,5 +107,5 @@
       ! routine by a factor of 2!  Rather, we do it with an explicit
       ! loop.
-      do jcol = 1,ncol
+      DO jcol = 1,ncol
         ! Lacis and Hansen (1974) Eq 33, Shonk & Hogan (2008) Eq 10:
         inv_denominator(jcol,jlev) = 1.0_jprb / (1.0_jprb-albedo(jcol,jlev+1)*reflectance(jcol,jlev))
@@ -132,6 +132,6 @@
 ! Added for DWD (2020)
 !NEC$ outerloop_unroll(8)
-    do jlev = 1,nlev
-      do jcol = 1,ncol
+    DO jlev = 1,nlev
+      DO jcol = 1,ncol
         ! Shonk & Hogan (2008) Eq 14 (after simplification):
         flux_dn_diffuse(jcol,jlev+1) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics.F90	(revision 5158)
@@ -243,5 +243,5 @@
 
         if (ao%use_hydrophilic) then
-          do jtype = 1,n_type_philic
+          DO jtype = 1,n_type_philic
             ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
             ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
@@ -266,5 +266,5 @@
 
         if (ao%use_hydrophilic) then
-          do jtype = 1,n_type_philic
+          DO jtype = 1,n_type_philic
             ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype))
             ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, mass_ext_philic(:,:,jtype) &
@@ -280,5 +280,5 @@
       if (allocated(ao%wavelength_mono)) then
         ! Monochromatic wavelengths also required
-        do jwl = 1,nmono
+        DO jwl = 1,nmono
           ! Wavelength (m) to wavenumber (cm-1)
           wavenumber_target = 0.01_jprb / ao%wavelength_mono(jwl)
@@ -292,5 +292,5 @@
           else
             iwn = 1
-            do while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
+            DO while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
               iwn = iwn + 1
             end do
@@ -419,5 +419,5 @@
 
       if (ao%use_hydrophilic) then
-        do jtype = 1,ao%n_type_philic
+        DO jtype = 1,ao%n_type_philic
           ao%mass_ext_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype))
           ao%ssa_sw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_sw_philic(:,:,jtype) &
@@ -451,5 +451,5 @@
 
       if (ao%use_hydrophilic) then
-        do jtype = 1,ao%n_type_philic
+        DO jtype = 1,ao%n_type_philic
           ao%mass_ext_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype))
           ao%ssa_lw_philic(:,:,jtype) = matmul(mapping, ao_legacy%mass_ext_lw_philic(:,:,jtype) &
@@ -579,5 +579,5 @@
       ! Aerosol mixing ratios have been provided
 
-      do jtype = 1,config%n_aerosol_types
+      DO jtype = 1,config%n_aerosol_types
         if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
           write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
@@ -612,5 +612,5 @@
 
       ! Loop over column
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
 
         ! Reset temporary arrays
@@ -622,5 +622,5 @@
         scat_g_lw_aerosol = 0.0_jprb
 
-        do jlev = istartlev,iendlev
+        DO jlev = istartlev,iendlev
           ! Compute relative humidity with respect to liquid
           ! saturation and the index to the relative-humidity index of
@@ -634,5 +634,5 @@
         end do
 
-        do jtype = 1,config%n_aerosol_types
+        DO jtype = 1,config%n_aerosol_types
           itype = ao%itype(jtype)
 
@@ -643,7 +643,7 @@
           ! dimension being spectral band.
           if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
-            do jlev = istartlev,iendlev
+            DO jlev = istartlev,iendlev
               mixing_ratio = aerosol%mixing_ratio(jcol,jlev,jtype)
-              do jband = 1,config%n_bands_sw
+              DO jband = 1,config%n_bands_sw
                 local_od_sw = factor(jlev) * mixing_ratio &
                      &  * ao%mass_ext_sw_phobic(jband,itype)
@@ -656,5 +656,5 @@
               end do
               if (config%do_lw_aerosol_scattering) then
-                do jband = 1,config%n_bands_lw
+                DO jband = 1,config%n_bands_lw
                   local_od_lw = factor(jlev) * mixing_ratio &
                        &  * ao%mass_ext_lw_phobic(jband,itype)
@@ -670,5 +670,5 @@
                 ! weight the optical depth by the single scattering
                 ! co-albedo
-                do jband = 1,config%n_bands_lw
+                DO jband = 1,config%n_bands_lw
                   od_lw_aerosol(jband,jlev) = od_lw_aerosol(jband,jlev) &
                        &  + factor(jlev) * mixing_ratio &
@@ -682,8 +682,8 @@
             ! Hydrophilic aerosols require the look-up tables to
             ! be indexed with irh
-            do jlev = istartlev,iendlev
+            DO jlev = istartlev,iendlev
               mixing_ratio = aerosol%mixing_ratio(jcol,jlev,jtype)
               irh = irhs(jlev)
-              do jband = 1,config%n_bands_sw
+              DO jband = 1,config%n_bands_sw
                 local_od_sw = factor(jlev) * mixing_ratio &
                      &  * ao%mass_ext_sw_philic(jband,irh,itype)
@@ -696,5 +696,5 @@
               end do
               if (config%do_lw_aerosol_scattering) then
-                do jband = 1,config%n_bands_lw
+                DO jband = 1,config%n_bands_lw
                   local_od_lw = factor(jlev) * mixing_ratio &
                        &  * ao%mass_ext_lw_philic(jband,irh,itype)
@@ -710,5 +710,5 @@
                 ! weight the optical depth by the single scattering
                 ! co-albedo
-                do jband = 1,config%n_bands_lw
+                DO jband = 1,config%n_bands_lw
                   od_lw_aerosol(jband,jlev) = od_lw_aerosol(jband,jlev) &
                        &  + factor(jlev) * mixing_ratio &
@@ -740,6 +740,6 @@
 
           ! We can assume the band and g-point indices are the same
-          do jlev = 1,nlev
-            do jg = 1,config%n_g_sw
+          DO jlev = 1,nlev
+            DO jg = 1,config%n_g_sw
               local_scat = ssa_sw(jg,jlev,jcol)*od_sw(jg,jlev,jcol) + scat_sw_aerosol(jg,jlev)
               od_sw(jg,jlev,jcol) = od_sw(jg,jlev,jcol) + od_sw_aerosol(jg,jlev)
@@ -751,6 +751,6 @@
         else
 
-          do jlev = 1,nlev
-            do jg = 1,config%n_g_sw
+          DO jlev = 1,nlev
+            DO jg = 1,config%n_g_sw
               ! Need to map between bands and g-points
               iband = config%i_band_from_reordered_g_sw(jg)
@@ -781,6 +781,6 @@
                &                             scat_lw_aerosol, scat_g_lw_aerosol)
 
-          do jlev = istartlev,iendlev
-            do jg = 1,config%n_g_lw
+          DO jlev = istartlev,iendlev
+            DO jg = 1,config%n_g_lw
               iband = config%i_band_from_reordered_g_lw(jg)
               local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband,jlev)
@@ -802,12 +802,12 @@
           if (config%do_cloud_aerosol_per_lw_g_point) then
             ! We can assume band and g-point indices are the same
-            do jlev = istartlev,iendlev
-              do jg = 1,config%n_g_lw
+            DO jlev = istartlev,iendlev
+              DO jg = 1,config%n_g_lw
                 od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) + od_lw_aerosol(jg,jlev)
               end do
             end do
           else
-            do jlev = istartlev,iendlev
-              do jg = 1,config%n_g_lw
+            DO jlev = istartlev,iendlev
+              DO jg = 1,config%n_g_lw
                 od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
                      &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg),jlev)
@@ -901,9 +901,9 @@
 
       ! Loop over position
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
 ! Added for DWD (2020)
 !NEC$ forced_collapse
-        do jlev = istartlev,iendlev
-          do jb = 1,config%n_bands_sw
+        DO jlev = istartlev,iendlev
+          DO jb = 1,config%n_bands_sw
             od_sw_aerosol(jb,jlev) = aerosol%od_sw(jb,jlev,jcol)
             scat_sw_aerosol(jb,jlev) = aerosol%ssa_sw(jb,jlev,jcol) * od_sw_aerosol(jb,jlev)
@@ -923,7 +923,7 @@
         ! properties (noting that any gas scattering will have an
         ! asymmetry factor of zero)
-        do jlev = istartlev,iendlev
+        DO jlev = istartlev,iendlev
           if (od_sw_aerosol(1,jlev) > 0.0_jprb) then
-            do jg = 1,config%n_g_sw
+            DO jg = 1,config%n_g_sw
               iband = config%i_band_from_reordered_g_sw(jg)
               local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband,jlev)
@@ -961,9 +961,9 @@
 
         ! Loop over position
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
 ! Added for DWD (2020)
 !NEC$ forced_collapse
-          do jlev = istartlev,iendlev
-            do jb = 1,config%n_bands_lw
+          DO jlev = istartlev,iendlev
+            DO jb = 1,config%n_bands_lw
               od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol)
               scat_lw_aerosol(jb,jlev) = aerosol%ssa_lw(jb,jlev,jcol) * od_lw_aerosol(jb,jlev)
@@ -974,6 +974,6 @@
             end do
           end do
-          do jlev = istartlev,iendlev
-            do jg = 1,config%n_g_lw
+          DO jlev = istartlev,iendlev
+            DO jg = 1,config%n_g_lw
               iband = config%i_band_from_reordered_g_lw(jg)
               if (od_lw_aerosol(iband,jlev) > 0.0_jprb) then
@@ -995,18 +995,18 @@
 
         ! Loop over position
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
 ! Added for DWD (2020)
 !NEC$ forced_collapse
-          do jlev = istartlev,iendlev
+          DO jlev = istartlev,iendlev
             ! If aerosol longwave scattering is not included then we
             ! weight the optical depth by the single scattering
             ! co-albedo
-            do jb = 1, config%n_bands_lw
+            DO jb = 1, config%n_bands_lw
               od_lw_aerosol(jb,jlev) = aerosol%od_lw(jb,jlev,jcol) &
                  &  * (1.0_jprb - aerosol%ssa_lw(jb,jlev,jcol))
             end do
           end do
-          do jlev = istartlev,iendlev
-            do jg = 1,config%n_g_lw
+          DO jlev = istartlev,iendlev
+            DO jg = 1,config%n_g_lw
               od_lw(jg,jlev,jcol) = od_lw(jg,jlev,jcol) &
                    &  + od_lw_aerosol(config%i_band_from_reordered_g_lw(jg),jlev)
@@ -1120,5 +1120,5 @@
     if (lhook) call dr_hook('radiation_aerosol_optics:aerosol_extinction',0,hook_handle)
 
-    do jtype = 1,config%n_aerosol_types
+    DO jtype = 1,config%n_aerosol_types
       if (config%aerosol_optics%iclass(jtype) == IAerosolClassUndefined) then
         write(nulerr,'(a)') '*** Error: not all aerosol types are defined'
@@ -1138,10 +1138,10 @@
 
     ! Loop over position
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ext = 0.0_jprb
       ! Get relative-humidity index
       irh = ao%calc_rh_index(relative_humidity(jcol))
       ! Add extinction coefficients from each aerosol type
-      do jtype = 1,config%n_aerosol_types
+      DO jtype = 1,config%n_aerosol_types
         if (ao%iclass(jtype) == IAerosolClassHydrophobic) then
           ext = ext + mixing_ratio(jcol,jtype) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_data.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_data.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_data.F90	(revision 5158)
@@ -619,5 +619,5 @@
     iend   = ubound(itypes,1)
 
-    do jtype = istart, iend
+    DO jtype = istart, iend
       if (itypes(jtype) == 0) then
         call this%set_empty_type(jtype)
@@ -655,5 +655,5 @@
     else
       calc_rh_index = 1
-      do while (rh > this%rh_lower(calc_rh_index + 1))
+      DO while (rh > this%rh_lower(calc_rh_index + 1))
         calc_rh_index = calc_rh_index + 1
       end do
@@ -682,5 +682,5 @@
     end if
 
-    do jtype = 1,size(i_type_map)
+    DO jtype = 1,size(i_type_map)
       if (i_type_map(jtype) > 0) then
         write(nulout,'(i4,a,a)') jtype, ' -> hydrophobic type ', &
@@ -714,5 +714,5 @@
 
     ! Find index of first character
-    do while (i_line_current < iline)
+    DO while (i_line_current < iline)
       i_start_new = scan(str(istart:iend), new_line(' '))
       if (i_start_new == 0) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_description.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_description.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_description.F90	(revision 5158)
@@ -165,5 +165,5 @@
     
     ! Loop over hydrophilic types
-    do ja = 1,size(this%bin_philic)
+    DO ja = 1,size(this%bin_philic)
       ! Check if we have a match
       if (to_string(this%code_philic(:,ja)) == code_str &
@@ -176,5 +176,5 @@
     end do
     ! Repeat for the hydrophobic types
-    do ja = 1,size(this%bin_phobic)
+    DO ja = 1,size(this%bin_phobic)
       if (to_string(this%code_phobic(:,ja)) == code_str &
            &  .and. trim(to_string(this%optical_model_phobic(:,ja))) &
@@ -255,5 +255,5 @@
     if (lhydrophilic) then
       ! Loop over hydrophilic aerosol types
-      do ja = 1,size(this%bin_philic)
+      DO ja = 1,size(this%bin_philic)
         current_score = 0
         if (to_string(this%code_philic(:,ja)) == code_str) then
@@ -306,5 +306,5 @@
     else
       ! Loop over hydrophobic aerosol types
-      do ja = 1,size(this%bin_phobic)
+      DO ja = 1,size(this%bin_phobic)
         current_score = 0
         if (to_string(this%code_phobic(:,ja)) == code_str) then
@@ -376,5 +376,5 @@
     character(len=size(arr)) :: str
     integer :: jc
-    do jc = 1,size(arr)
+    DO jc = 1,size(arr)
       if (ichar(arr(jc)) == 0) then
         ! Replace NULL character with a space
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud.F90	(revision 5158)
@@ -251,5 +251,5 @@
       ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we
       ! don't take the logarithm of the first pressure in each column.
-      do jcol = i1,i2
+      DO jcol = i1,i2
         this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length) &
              &                            * thermodynamics%temperature_hl(jcol,2) &
@@ -258,6 +258,6 @@
       end do
 
-      do jlev = 2,nlev-1
-        do jcol = i1,i2
+      DO jlev = 2,nlev-1
+        DO jcol = i1,i2
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -271,6 +271,6 @@
        ! to top-of-atmosphere).  In case pressure_hl(:,nlev+1)=0, we
        ! don't take the logarithm of the last pressure in each column.
-      do jlev = 1,nlev-2
-        do jcol = i1,i2
+      DO jlev = 1,nlev-2
+        DO jcol = i1,i2
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -280,5 +280,5 @@
       end do
 
-      do jcol = i1,i2
+      DO jcol = i1,i2
         this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length) &
             &                            * thermodynamics%temperature_hl(jcol,nlev) &
@@ -340,5 +340,5 @@
       ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we
       ! don't take the logarithm of the first pressure in each column.
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length(jcol)) &
              &                            * thermodynamics%temperature_hl(jcol,2) &
@@ -347,6 +347,6 @@
       end do
 
-      do jlev = 2,nlev-1
-        do jcol = istartcol,iendcol
+      DO jlev = 2,nlev-1
+        DO jcol = istartcol,iendcol
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol)) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -360,6 +360,6 @@
        ! to top-of-atmosphere).  In case pressure_hl(:,nlev+1)=0, we
        ! don't take the logarithm of the last pressure in each column.
-      do jlev = 1,nlev-2
-        do jcol = istartcol,iendcol
+      DO jlev = 1,nlev-2
+        DO jcol = istartcol,iendcol
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol)) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -369,5 +369,5 @@
       end do
 
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length(jcol)) &
             &                            * thermodynamics%temperature_hl(jcol,nlev) &
@@ -423,5 +423,5 @@
       ! top-of-atmosphere to surface). In case pressure_hl(:,1)=0, we
       ! don't take the logarithm of the first pressure in each column.
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         this%overlap_param(jcol,1) = exp(-(R_over_g/decorrelation_length(jcol,1)) &
              &                            * thermodynamics%temperature_hl(jcol,2) &
@@ -430,6 +430,6 @@
       end do
 
-      do jlev = 2,nlev-1
-        do jcol = istartcol,iendcol
+      DO jlev = 2,nlev-1
+        DO jcol = istartcol,iendcol
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol,jlev)) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -443,6 +443,6 @@
        ! to top-of-atmosphere).  In case pressure_hl(:,nlev+1)=0, we
        ! don't take the logarithm of the last pressure in each column.
-      do jlev = 1,nlev-2
-        do jcol = istartcol,iendcol
+      DO jlev = 1,nlev-2
+        DO jcol = istartcol,iendcol
           this%overlap_param(jcol,jlev) = exp(-(0.5_jprb*R_over_g/decorrelation_length(jcol,jlev)) &
               &                            * thermodynamics%temperature_hl(jcol,jlev+1) &
@@ -452,5 +452,5 @@
       end do
 
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
       ! AI ATTENTION a verifier decorrelation_length(jcol,nlev-1) ou nlev
         this%overlap_param(jcol,nlev-1) = exp(-(R_over_g/decorrelation_length(jcol,nlev-1)) &
@@ -663,5 +663,5 @@
     end if
 
-    do jcol = i1,i2
+    DO jcol = i1,i2
       eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) &
            &  * (0.5_jprb / pressure_hl(jcol,isurf))
@@ -761,5 +761,5 @@
     end if
 
-    do jcol = i1,i2
+    DO jcol = i1,i2
       eta = (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)) &
            &  * (0.5_jprb / pressure_hl(jcol,isurf))
@@ -804,14 +804,14 @@
     ntype = size(this%mixing_ratio,3)
     
-    do jlev = 1,nlev
-      do jcol = istartcol,iendcol
+    DO jlev = 1,nlev
+      DO jcol = istartcol,iendcol
         sum_mixing_ratio(jcol) = 0.0_jprb
       end do
-      do jh = 1, ntype
-        do jcol = istartcol,iendcol
+      DO jh = 1, ntype
+        DO jcol = istartcol,iendcol
           sum_mixing_ratio(jcol) = sum_mixing_ratio(jcol) + this%mixing_ratio(jcol,jlev,jh)
         end do
       end do
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         if (this%fraction(jcol,jlev)        < cloud_fraction_threshold &
              &  .or. sum_mixing_ratio(jcol) < cloud_mixing_ratio_threshold) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_cover.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_cover.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_cover.F90	(revision 5158)
@@ -159,5 +159,5 @@
     cum_product = 1.0_jprb - frac(1)
     cum_cloud_cover(1) = frac(1)
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
       ! Compute the combined cloud cover of layers jlev and jlev+1
       pair_cloud_cover(jlev) = max(frac(jlev),frac(jlev+1))
@@ -242,5 +242,5 @@
     cum_product = 1.0_jprb - frac(1)
     cum_cloud_cover(1) = frac(1)
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
       ! Convert to "alpha" overlap parameter if necessary
       if (do_overlap_conversion) then
@@ -258,5 +258,5 @@
 #ifdef DWD_VECTOR_OPTIMIZATIONS
     end do
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
 #endif
       if (frac(jlev) >= MaxCloudFrac) then
@@ -385,5 +385,5 @@
     jlev = 1
     nobj = 0
-    do while (jlev <= nlev)
+    DO while (jlev <= nlev)
       if (frac(jlev) > min_frac) then
         ! Starting a new object: store its top
@@ -392,5 +392,5 @@
         ! Find its maximum cloud fraction
         jlev = jlev + 1
-        do while (jlev <= nlev) 
+        DO while (jlev <= nlev)
           if (frac(jlev) < frac(jlev-1)) then
             exit
@@ -400,5 +400,5 @@
         i_max_obj(nobj) = jlev - 1
         ! Find its base
-        do while (jlev <= nlev)
+        DO while (jlev <= nlev)
           if (frac(jlev) > frac(jlev-1) .or. frac(jlev) <= min_frac) then
             exit
@@ -435,5 +435,5 @@
 
         ! Compute the combined cloud cover of pairs of layers
-        do jlev = 1,nlev-1
+        DO jlev = 1,nlev-1
           pair_cloud_cover(jlev) &
                &  = overlap_param(jlev)*max(frac(jlev),frac(jlev+1)) &
@@ -444,5 +444,5 @@
         ! adjacent objects as the product of the layerwise overlap
         ! parameters between their layers of maximum cloud fraction
-        do jobj = 1,nobj-1
+        DO jobj = 1,nobj-1
           alpha_obj(jobj) &
                &  = product(overlap_param(i_max_obj(jobj):i_max_obj(jobj+1)-1))
@@ -456,5 +456,5 @@
              &                     frac(1:nlev-1), frac(2:nlev))
         ! Compute the combined cloud cover of pairs of layers
-        do jlev = 1,nlev-1
+        DO jlev = 1,nlev-1
           pair_cloud_cover(jlev) &
                &  = overlap_alpha(jlev)*max(frac(jlev),frac(jlev+1)) &
@@ -465,5 +465,5 @@
         ! adjacent objects as the product of the layerwise overlap
         ! parameters between their layers of maximum cloud fraction
-        do jobj = 1,nobj-1
+        DO jobj = 1,nobj-1
           alpha_obj(jobj) &
                &  = product(overlap_alpha(i_max_obj(jobj):i_max_obj(jobj+1)-1))
@@ -476,7 +476,7 @@
       ! of each object: this will later be converted to the cumulative
       ! cloud cover working down from TOA
-      do jobj = 1,nobj
+      DO jobj = 1,nobj
         cum_cloud_cover(i_top_obj(jobj)) = frac(i_top_obj(jobj))
-        do jlev = i_top_obj(jobj), i_base_obj(jobj)-1
+        DO jlev = i_top_obj(jobj), i_base_obj(jobj)-1
           if (frac(jlev) >= MaxCloudFrac) then
             ! Cloud cover has reached one
@@ -496,5 +496,5 @@
       ! Sequentially combine objects until there is only one left
       ! covering the full vertical extent of clouds in the profile
-      do while (nobj > 1)
+      DO while (nobj > 1)
         ! Find the most correlated adjacent pair of objects
         alpha_max = 0.0_jprb
@@ -506,5 +506,5 @@
 
         jobj = 1
-        do while (jobj < nobj)
+        DO while (jobj < nobj)
           if (alpha_obj(jobj) > alpha_max) then
             alpha_max = alpha_obj(jobj)
@@ -533,5 +533,5 @@
         ! Scale the combined cloud cover of the lower object to
         ! account for its overlap with the upper object
-        do jlev = i_top_obj(iobj2),i_base_obj(iobj2)
+        DO jlev = i_top_obj(iobj2),i_base_obj(iobj2)
           cum_cloud_cover(jlev) = cum_cloud_cover(i_base_obj(iobj1)) &
                +  cum_cloud_cover(jlev) * scaling
@@ -554,5 +554,5 @@
       ! Ensure that the combined cloud cover of pairs of layers is
       ! consistent with the overhang
-      do jlev = 1,nlev-1
+      DO jlev = 1,nlev-1
         pair_cloud_cover(jlev) = max(pair_cloud_cover(jlev), &
              &     frac(jlev)+cum_cloud_cover(jlev+1)-cum_cloud_cover(jlev))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_generator.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_generator.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_generator.F90	(revision 5158)
@@ -152,5 +152,5 @@
 
     total_cloud_cover = cum_cloud_cover(nlev);
-    do jlev = 1,nlev-1
+    DO jlev = 1,nlev-1
       overhang(jlev) = cum_cloud_cover(jlev+1)-cum_cloud_cover(jlev)
     end do
@@ -166,10 +166,10 @@
       ! Find range of cloudy layers
       jlev = 1
-      do while (frac(jlev) <= 0.0_jprb) 
+      DO while (frac(jlev) <= 0.0_jprb)
         jlev = jlev + 1
       end do
       ibegin = jlev
       iend = jlev
-      do jlev = jlev+1,nlev
+      DO jlev = jlev+1,nlev
         if (frac(jlev) > 0.0_jprb) then
           iend = jlev
@@ -180,5 +180,5 @@
       overlap_param_inhom = overlap_param
 
-      do jlev = ibegin,iend-1
+      DO jlev = ibegin,iend-1
         if (overlap_param(jlev) > 0.0_jprb) then
           overlap_param_inhom(jlev) &
@@ -208,10 +208,10 @@
         
         ! Loop over ng columns
-        do jg = 1,ng
+        DO jg = 1,ng
           ! Find the cloud top height corresponding to the current
           ! random number, and store in itrigger
           trigger = rand_top(jg) * total_cloud_cover
           jlev = ibegin
-          do while (trigger > cum_cloud_cover(jlev) .and. jlev < iend)
+          DO while (trigger > cum_cloud_cover(jlev) .and. jlev < iend)
             jlev = jlev + 1
           end do
@@ -328,5 +328,5 @@
     ! Loop from the layer below the local cloud top down to the
     ! bottom-most cloudy layer
-    do jlev = itrigger+1,iend+1
+    DO jlev = itrigger+1,iend+1
       do_fill_od_scaling = .false.
       if (jlev <= iend) then
@@ -367,5 +367,5 @@
 
         ! Loop through the sequence of cloudy layers
-        do jcloud = 2,n_layers_to_scale
+        DO jcloud = 2,n_layers_to_scale
           ! Use second random number, and inhomogeneity overlap
           ! parameter, to decide whether the first random number
@@ -463,5 +463,5 @@
     ! Loop from the layer below the local cloud top down to the
     ! bottom-most cloudy layer
-    do jlev = itrigger+1,iend
+    DO jlev = itrigger+1,iend
       iy = iy+1
       if (is_cloudy(jlev-1)) then
@@ -494,5 +494,5 @@
         
     ! Loop through the sequence of cloudy layers
-    do jcloud = 2,n_layers_to_scale
+    DO jcloud = 2,n_layers_to_scale
       ! Use second random number, and inhomogeneity overlap
       ! parameter, to decide whether the first random number
@@ -679,5 +679,5 @@
 
     ! Loop down through layers starting at the first cloudy layer
-    do jlev = ibegin,iend
+    DO jlev = ibegin,iend
 
       if (is_any_cloud(jlev)) then
@@ -685,5 +685,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-        do jg = 1,ng
+        DO jg = 1,ng
           ! The intention is that all these operations are vectorizable,
           ! since all are vector operations on vectors of length ng...
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_optics.F90	(revision 5158)
@@ -288,6 +288,6 @@
       end if
 
-      do jlev = 1,nlev
-        do jcol = istartcol,iendcol
+      DO jlev = 1,nlev
+        DO jcol = istartcol,iendcol
           ! Only do anything if cloud is present (assume that
           ! cloud%crop_cloud_fraction has already been called)
@@ -459,5 +459,5 @@
   ! Added for DWD (2020)
   !NEC$ shortloop
-              do jb = 1, config%n_bands_lw
+              DO jb = 1, config%n_bands_lw
                 od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) + od_lw_ice(jb)
                 if (scat_od_lw_liq(jb)+scat_od_lw_ice(jb) > 0.0_jprb) then
@@ -477,5 +477,5 @@
   ! Added for DWD (2020)
   !NEC$ shortloop
-              do jb = 1, config%n_bands_lw
+              DO jb = 1, config%n_bands_lw
                 od_lw_cloud(jb,jlev,jcol) = od_lw_liq(jb) - scat_od_lw_liq(jb) &
                       &                   + od_lw_ice(jb) - scat_od_lw_ice(jb)
@@ -484,5 +484,5 @@
   ! Added for DWD (2020)
   !NEC$ shortloop
-            do jb = 1, config%n_bands_sw
+            DO jb = 1, config%n_bands_sw
               od_sw_cloud(jb,jlev,jcol) = od_sw_liq(jb) + od_sw_ice(jb)
               g_sw_cloud(jb,jlev,jcol) = (g_sw_liq(jb) * scat_od_sw_liq(jb) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloudless_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloudless_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloudless_lw.F90	(revision 5158)
@@ -95,9 +95,9 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       ! Compute the reflectance and transmittance of all layers,
       ! neglecting clouds
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_lw_aerosol_scattering) then
           ! Scattering case: first compute clear-sky reflectance,
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloudless_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloudless_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloudless_sw.F90	(revision 5158)
@@ -103,5 +103,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ! Only perform calculation if sun above the horizon
       if (single_level%cos_sza(jcol) > 0.0_jprb) then
@@ -114,5 +114,5 @@
           ! Delta-Eddington scaling has already been performed to the
           ! aerosol part of od, ssa and g
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             call calc_two_stream_gammas_sw(ng, cos_sza, &
                  &  ssa(:,jlev,jcol), g(:,jlev,jcol), &
@@ -128,5 +128,5 @@
         else
           ! Apply delta-Eddington scaling to the aerosol-gas mixture
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             od_total  =  od(:,jlev,jcol)
             ssa_total = ssa(:,jlev,jcol)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_config.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_config.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_config.F90	(revision 5158)
@@ -1657,5 +1657,5 @@
     ! contains the weights of interest.  We now find the non-zero weights
     nweights = 0
-    do jband = 1,size(mapping,2)
+    DO jband = 1,size(mapping,2)
       if (mapping(2,jband) > 0.0_jprb) then
         nweights = nweights+1
@@ -1674,9 +1674,9 @@
            &  wavenumber2, ' cm-1):'
       if (this%do_cloud_aerosol_per_sw_g_point) then
-        do jband = 1, nweights
+        DO jband = 1, nweights
           write(nulout, '(a,i0,a,f8.4)') '  Shortwave g point ', iband(jband), ': ', weight(jband)
         end do
       else
-        do jband = 1, nweights
+        DO jband = 1, nweights
           wavenumber1_band = this%gas_optics_sw%spectral_def%wavenumber1_band(iband(jband))
           wavenumber2_band = this%gas_optics_sw%spectral_def%wavenumber2_band(iband(jband))
@@ -1728,5 +1728,5 @@
     allocate(diag_ind(ninterval+2))
     diag_ind = 0
-    do jint = 1,ninterval+2
+    DO jint = 1,ninterval+2
       diag_ind(jint) = jint
     end do
@@ -1894,5 +1894,5 @@
     ! Count the number of albedo/emissivity intervals
     ninterval = 0
-    do jint = 1,NMaxAlbedoIntervals
+    DO jint = 1,NMaxAlbedoIntervals
       if (this%i_sw_albedo_index(jint) > 0) then
         ninterval = jint
@@ -1948,5 +1948,5 @@
         write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', size(this%i_albedo_from_band_sw), &
              &  ' shortwave intervals to albedo intervals:'
-        do jband = 1,size(this%i_albedo_from_band_sw)
+        DO jband = 1,size(this%i_albedo_from_band_sw)
           write(nulout,'(a,i0)',advance='no') ' ', this%i_albedo_from_band_sw(jband)
         end do
@@ -1972,5 +1972,5 @@
     ! Count the number of albedo/emissivity intervals
     ninterval = 0
-    do jint = 1,NMaxAlbedoIntervals
+    DO jint = 1,NMaxAlbedoIntervals
       if (this%i_lw_emiss_index(jint) > 0) then
         ninterval = jint
@@ -2026,5 +2026,5 @@
         write(nulout, '(a,i0,a)',advance='no') 'Mapping from ', size(this%i_emiss_from_band_lw), &
              &  ' longwave intervals to emissivity intervals:'
-        do jband = 1,size(this%i_emiss_from_band_lw)
+        DO jband = 1,size(this%i_emiss_from_band_lw)
           write(nulout,'(a,i0)',advance='no') ' ', this%i_emiss_from_band_lw(jband)
         end do
@@ -2056,5 +2056,5 @@
       is_not_found = .true.
 
-      do jc = 0,size(enum_str)-1
+      DO jc = 0,size(enum_str)-1
         if (trim(str) == trim(enum_str(jc))) then
           icode = jc
@@ -2066,5 +2066,5 @@
         write(nulerr,'(a,a,a,a,a)',advance='no') '*** Error: ', trim(var_name), &
              &  ' must be one of: "', enum_str(0), '"'
-        do jc = 1,size(enum_str)-1
+        DO jc = 1,size(enum_str)-1
           write(nulerr,'(a,a,a)',advance='no') ', "', trim(enum_str(jc)), '"'
         end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_delta_eddington.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_delta_eddington.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_delta_eddington.h	(revision 5158)
@@ -86,5 +86,5 @@
   integer :: j
 
-  do j = 1,ng
+  DO j = 1,ng
     g            = scat_od_g(j) / max(scat_od(j), 1.0e-24)
     f            = g*g
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd.F90	(revision 5158)
@@ -209,5 +209,5 @@
     istart = 1
     this%i_gas_mapping = 0
-    do jgas = 1, this%ngas
+    DO jgas = 1, this%ngas
       if (jgas < this%ngas) then
         inext = istart + scan(constituent_id(istart:nchar), ' ')
@@ -217,5 +217,5 @@
       ! Find gas code
       i_gas_code = 0
-      do jjgas = 1, NMaxGases
+      DO jjgas = 1, NMaxGases
         if (constituent_id(istart:inext-2) == trim(GasLowerCaseName(jjgas))) then
           i_gas_code = jjgas
@@ -264,5 +264,5 @@
          &  this%ntemp, ' temperatures, ', this%nplanck, ' planck-function entries'
     write(nulout, '(a)') '  Gases:'
-    do jgas = 1,this%ngas
+    DO jgas = 1,this%ngas
       if (this%single_gas(jgas)%i_gas_code > 0) then
         write(nulout, '(a,a,a)', advance='no') '    ', &
@@ -373,6 +373,6 @@
 
     ! Interpolate input SSI to regular wavenumber grid
-    do jwav_grid = 1,nwav_grid
-      do jwav = 1,nwav-1
+    DO jwav_grid = 1,nwav_grid
+      DO jwav = 1,nwav-1
         if (wavenumber(jwav) < wavenumber_grid(jwav_grid) &
              &  .and. wavenumber(jwav+1) >= wavenumber_grid(jwav_grid)) then
@@ -426,5 +426,5 @@
            &  ReferenceTSI, ' W m-2, solar cycle amplitude (at solar maximum), update to original solar irradiance'
       iband = 0
-      do jg = 1,this%ng
+      DO jg = 1,this%ng
         if (this%spectral_def%i_band_number(jg) > iband) then
           iband = this%spectral_def%i_band_number(jg)
@@ -516,9 +516,9 @@
     global_multiplier = 1.0_jprb / (AccelDueToGravity * 0.001_jprb * AirMolarMass)
 
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       log_pressure_fl = log(0.5_jprb * (pressure_hl(jcol,1:nlev)+pressure_hl(jcol,2:nlev+1)))
 
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         ! Find interpolation points in pressure
         pindex1 = (log_pressure_fl(jlev)-this%log_pressure1) &
@@ -546,5 +546,5 @@
       optical_depth_fl(:,:,jcol) = 0.0_jprb
       
-      do jgas = 1,this%ngas
+      DO jgas = 1,this%ngas
 
         associate (single_gas => this%single_gas(jgas))
@@ -561,5 +561,5 @@
             end if
             
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &        + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
@@ -581,5 +581,5 @@
             end if
             
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &        + (multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
@@ -592,5 +592,5 @@
             ! Composite gases
             molar_abs => this%single_gas(jgas)%molar_abs
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &  + (simple_multiplier(jlev)*tw1(jlev)) * (pw1(jlev) * molar_abs(:,ip1(jlev),it1(jlev)) &
@@ -611,5 +611,5 @@
             molar_abs_conc => this%single_gas(jgas)%molar_abs_conc
             mole_frac1 = exp(single_gas%log_mole_frac1)
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               ! Take care of mole_fraction == 0
               log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode)*scaling, mole_frac1))
@@ -628,5 +628,5 @@
               !      &                +tw2 * (pw1 * molar_abs_conc(:,ip1,it1+1,ic1+1) &
               !      &                       +pw2 * molar_abs_conc(:,ip1+1,it1+1,ic1+1)))
-            do jlev = 1,nlev
+            DO jlev = 1,nlev
               optical_depth_fl(:,jlev,jcol) = optical_depth_fl(:,jlev,jcol) &
                    &  + (simple_multiplier(jlev) * mole_fraction_fl(jcol,jlev,igascode) * scaling) * ( &
@@ -651,5 +651,5 @@
       ! Rayleigh scattering
       if (this%is_sw .and. present(rayleigh_od_fl)) then
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           rayleigh_od_fl(:,jlev,jcol) = global_multiplier &
                &  * (pressure_hl(jcol,jlev+1) - pressure_hl(jcol,jlev)) * this%rayleigh_molar_scat
@@ -729,6 +729,6 @@
     od_fl(:,:,:) = 0.0_jprb
 
-    do jlev = 1,nlev
-      do jcol = istartcol,iendcol
+    DO jlev = 1,nlev
+      DO jcol = istartcol,iendcol
 
         log_pressure_fl = log(0.5_jprb * (pressure_hl(jcol,jlev)+pressure_hl(jcol,jlev+1)))
@@ -758,5 +758,5 @@
     end do
 
-    do jgas = 1,this%ngas
+    DO jgas = 1,this%ngas
 
       associate (single_gas => this%single_gas(jgas))
@@ -768,7 +768,7 @@
           molar_abs => this%single_gas(jgas)%molar_abs
 
-          do jlev = 1,nlev
-            do jg = 1, this%ng
-              do jcol = istartcol,iendcol
+          DO jlev = 1,nlev
+            DO jg = 1, this%ng
+              DO jcol = istartcol,iendcol
                 multiplier = simple_multiplier(jcol,jlev) * mole_fraction_fl(jcol,jlev,igascode)
 
@@ -785,7 +785,7 @@
           molar_abs => this%single_gas(jgas)%molar_abs
 
-          do jlev = 1,nlev
-            do jg = 1, this%ng
-              do jcol = istartcol,iendcol
+          DO jlev = 1,nlev
+            DO jg = 1, this%ng
+              DO jcol = istartcol,iendcol
                 multiplier = simple_multiplier(jcol,jlev)  * (mole_fraction_fl(jcol,jlev,igascode) &
                    &                            - single_gas%reference_mole_frac)
@@ -804,7 +804,7 @@
           molar_abs => this%single_gas(jgas)%molar_abs
 
-          do jlev = 1,nlev
-            do jg = 1, this%ng
-              do jcol = istartcol,iendcol
+          DO jlev = 1,nlev
+            DO jg = 1, this%ng
+              DO jcol = istartcol,iendcol
                 od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) &
                    &        + (simple_multiplier(jcol,jlev)*tw1(jcol,jlev)) *   &
@@ -823,6 +823,6 @@
             mole_frac1 = exp(single_gas%log_mole_frac1)
 
-            do jlev = 1,nlev
-              do jcol = istartcol,iendcol
+            DO jlev = 1,nlev
+              DO jcol = istartcol,iendcol
                 ! Take care of mole_fraction == 0
                 log_conc = log(max(mole_fraction_fl(jcol,jlev,igascode), mole_frac1))
@@ -835,8 +835,8 @@
             end do
 
-          do jlev = 1,nlev
-            do jg = 1, this%ng
+          DO jlev = 1,nlev
+            DO jg = 1, this%ng
 !NEC$ select_vector
-              do jcol = istartcol,iendcol
+              DO jcol = istartcol,iendcol
 
                 od_fl(jcol,jg,jlev) = od_fl(jcol,jg,jlev) &
@@ -866,7 +866,7 @@
 
       ! Ensure the optical depth is not negative
-      do jcol = istartcol,iendcol
-        do jlev = 1,nlev
-          do jg = 1, this%ng
+      DO jcol = istartcol,iendcol
+        DO jlev = 1,nlev
+          DO jg = 1, this%ng
             optical_depth_fl(jg,jlev,jcol) = max(0.0_jprb, od_fl(jcol,jg,jlev))
           end do
@@ -876,7 +876,7 @@
       ! Rayleigh scattering
       if (this%is_sw .and. present(rayleigh_od_fl)) then
-        do jcol = istartcol,iendcol
-          do jlev = 1,nlev
-            do jg = 1, this%ng
+        DO jcol = istartcol,iendcol
+          DO jlev = 1,nlev
+            DO jg = 1, this%ng
               rayleigh_od_fl(jg,jlev,jcol) = global_multiplier &
                &  * (pressure_hl(jcol,jlev+1) - pressure_hl(jcol,jlev)) * this%rayleigh_molar_scat(jg)
@@ -908,5 +908,5 @@
     integer    :: it1, jt
 
-    do jt = 1,nt
+    DO jt = 1,nt
       tindex1 = (temperature(jt) - this%temperature1_planck) &
            &   * (1.0_jprb / this%d_temperature_planck)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd_interface.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd_interface.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd_interface.F90	(revision 5158)
@@ -272,7 +272,7 @@
       ! rayleigh optical depth: convert to total optical depth and
       ! single-scattering albedo
-      do jcol = istartcol,iendcol
-        do jlev = 1, nlev
-          do jg = 1, config%n_g_sw
+      DO jcol = istartcol,iendcol
+        DO jlev = 1, nlev
+          DO jg = 1, config%n_g_sw
             od_sw(jg,jlev,jcol)  = od_sw(jg,jlev,jcol) + ssa_sw(jg,jlev,jcol)
             ssa_sw(jg,jlev,jcol) = ssa_sw(jg,jlev,jcol) / od_sw(jg,jlev,jcol)
@@ -308,5 +308,5 @@
 
       ! Calculate the Planck function for each g point
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         call config%gas_optics_lw%calc_planck_function(nlev+1, &
              &  thermodynamics%temperature_hl(jcol,:), planck_hl(:,:,jcol))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_flux.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_flux.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_flux.F90	(revision 5158)
@@ -423,5 +423,5 @@
              &               config%i_band_from_reordered_g_sw, &
              &               this%sw_dn_surf_band, istartcol, iendcol)
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           this%sw_dn_surf_band(:,jcol) &
                &  = this%sw_dn_surf_band(:,jcol) &
@@ -429,5 +429,5 @@
         end do
       else
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           call indexed_sum(this%sw_dn_direct_surf_g(:,jcol), &
                &           config%i_band_from_reordered_g_sw, &
@@ -450,5 +450,5 @@
                &               config%i_band_from_reordered_g_sw, &
                &               this%sw_dn_surf_clear_band, istartcol, iendcol)
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             this%sw_dn_surf_clear_band(:,jcol) &
                  &  = this%sw_dn_surf_clear_band(:,jcol) &
@@ -456,5 +456,5 @@
           end do
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%sw_dn_direct_surf_clear_g(:,jcol), &
                  &           config%i_band_from_reordered_g_sw, &
@@ -486,5 +486,5 @@
                &               this%sw_dn_diffuse_surf_canopy, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%sw_dn_direct_surf_g(:,jcol), &
                  &           config%i_albedo_from_band_sw(config%i_band_from_reordered_g_sw), &
@@ -502,6 +502,6 @@
         this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) = 0.0_jprb
         this%sw_dn_direct_surf_canopy (:,istartcol:iendcol) = 0.0_jprb
-        do jband = 1,config%n_bands_sw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_sw
+          DO jalbedoband = 1,nalbedoband
             if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
               ! Initially, "diffuse" is actually "total"
@@ -534,5 +534,5 @@
                &               this%lw_dn_surf_canopy, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%lw_dn_surf_g(:,jcol), &
                  &           config%i_emiss_from_band_lw(config%i_band_from_reordered_g_lw), &
@@ -548,5 +548,5 @@
                &               lw_dn_surf_band, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%lw_dn_surf_g(:,jcol), &
                  &           config%i_band_from_reordered_g_lw, &
@@ -556,6 +556,6 @@
         nalbedoband = size(config%lw_emiss_weights,1)
         this%lw_dn_surf_canopy(:,istartcol:iendcol) = 0.0_jprb
-        do jband = 1,config%n_bands_lw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_lw
+          DO jalbedoband = 1,nalbedoband
             if (config%lw_emiss_weights(jalbedoband,jband) /= 0.0_jprb) then
               this%lw_dn_surf_canopy(jalbedoband,istartcol:iendcol) &
@@ -602,5 +602,5 @@
              &               this%sw_up_toa_band, istartcol, iendcol)
       else
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           call indexed_sum(this%sw_dn_toa_g(:,jcol), &
                &           config%i_band_from_reordered_g_sw, &
@@ -618,5 +618,5 @@
                &               this%sw_up_toa_clear_band, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%sw_up_toa_clear_g(:,jcol), &
                  &               config%i_band_from_reordered_g_sw, &
@@ -634,5 +634,5 @@
              &               this%lw_up_toa_band, istartcol, iendcol)
       else
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           call indexed_sum(this%lw_up_toa_g(:,jcol), &
                &           config%i_band_from_reordered_g_lw, &
@@ -647,5 +647,5 @@
                &               this%lw_up_toa_clear_band, istartcol, iendcol)
         else
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             call indexed_sum(this%lw_up_toa_clear_g(:,jcol), &
                  &               config%i_band_from_reordered_g_lw, &
@@ -753,5 +753,5 @@
     iend   = ubound(source,1)
 
-    do jg = istart, iend
+    DO jg = istart, iend
       ig = ind(jg)
       dest(ig) = dest(ig) + source(jg)
@@ -777,5 +777,5 @@
     iend   = ubound(source,1)
 
-    do jg = istart, iend
+    DO jg = istart, iend
       ig = ind(jg)
       dest(ig) = dest(ig) + source(jg)
@@ -797,7 +797,7 @@
     dest = 0.0
 
-    do jg = lbound(source,1), ubound(source,1)
+    DO jg = lbound(source,1), ubound(source,1)
       ig = ind(jg)
-      do jc = ist, iend
+      DO jc = ist, iend
         dest(ig,jc) = dest(ig,jc) + source(jg,jc)
       end do
@@ -820,6 +820,6 @@
     nlev   = size(source,2)
 
-    do jlev = 1,nlev
-      do jg = istart, iend
+    DO jlev = 1,nlev
+      DO jg = istart, iend
         ig = ind(jg)
         dest(ig,jlev) = dest(ig,jlev) + source(jg,jlev)
@@ -846,6 +846,6 @@
     nlev   = size(source,2)
 
-    do jlev = 1,nlev
-      do jg = istart, iend
+    DO jlev = 1,nlev
+      DO jg = istart, iend
         ig = ind(jg)
         dest(ig,jlev) = dest(ig,jlev) + source(jg,jlev)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_gas.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_gas.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_gas.F90	(revision 5158)
@@ -209,6 +209,6 @@
     this%is_well_mixed(igas) = .false.
 
-    do jk = 1,this%nlev
-      do jc = i1,i2
+    DO jk = 1,this%nlev
+      DO jc = i1,i2
         this%mixing_ratio(jc,jk,igas) = mixing_ratio(jc-i1+1,jk)
       end do
@@ -294,6 +294,6 @@
     this%is_well_mixed(igas)           = .true.
 
-    do jk = 1,this%nlev
-      do jc = i1,i2
+    DO jk = 1,this%nlev
+      DO jc = i1,i2
         this%mixing_ratio(jc,jk,igas) = mixing_ratio
       end do
@@ -397,5 +397,5 @@
       end if
     else
-      do jg = 1,this%ntype
+      DO jg = 1,this%ntype
         call this%set_units(iunits, igas=this%icode(jg), scale_factor=new_sf)
       end do
@@ -416,5 +416,5 @@
     
     scaling = this%scale_factor
-    do jg = 1,NMaxGases
+    DO jg = 1,NMaxGases
       if (iunits == IMassMixingRatio .and. this%iunits(jg) == IVolumeMixingRatio) then
         scaling(jg) = scaling(jg) * GasMolarMass(jg) / AirMolarMass
@@ -481,5 +481,5 @@
       end if
     else
-      do jg = 1,this%ntype
+      DO jg = 1,this%ntype
         call this%assert_units(iunits, igas=this%icode(jg), scale_factor=sf, istatus=istatus)
       end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_general_cloud_optics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_general_cloud_optics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_general_cloud_optics.F90	(revision 5158)
@@ -53,5 +53,5 @@
     ! Count number of cloud types
     config%n_cloud_types = 0
-    do jtype = 1,NMaxCloudTypes
+    DO jtype = 1,NMaxCloudTypes
       if (len_trim(config%cloud_type_name(jtype)) > 0) then
         config%n_cloud_types = jtype
@@ -83,5 +83,5 @@
 
     ! Load cloud optics data
-    do jtype = 1,config%n_cloud_types
+    DO jtype = 1,config%n_cloud_types
       if (config%cloud_type_name(jtype)(1:1) == '/') then
         file_name = trim(config%cloud_type_name(jtype))
@@ -191,5 +191,5 @@
 
     ! Loop over cloud types
-    do jtype = 1,config%n_cloud_types
+    DO jtype = 1,config%n_cloud_types
       ! Compute in-cloud water path
       if (config%is_homogeneous) then
@@ -238,6 +238,6 @@
     ! Scale the combined longwave optical properties
     if (config%do_lw_cloud_scattering) then
-      do jcol = istartcol, iendcol
-        do jlev = 1,nlev
+      DO jcol = istartcol, iendcol
+        DO jlev = 1,nlev
           if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
             ! Note that original cloud optics does not do
@@ -259,6 +259,6 @@
     if (config%do_sw) then
       if (.not. config%do_sw_delta_scaling_with_gases) then
-        do jcol = istartcol, iendcol
-          do jlev = 1,nlev
+        DO jcol = istartcol, iendcol
+          DO jlev = 1,nlev
             if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
               call delta_eddington_extensive(od_sw_cloud(:,jlev,jcol), &
@@ -269,9 +269,9 @@
       end if
 
-      do jcol = istartcol, iendcol
-        do jlev = 1,nlev
+      DO jcol = istartcol, iendcol
+        DO jlev = 1,nlev
           if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
             ! Scale to get asymmetry factor and single scattering albedo
-            do jg = 1, config%n_bands_sw
+            DO jg = 1, config%n_bands_sw
               g_sw_cloud(jg,jlev,jcol) = g_sw_cloud(jg,jlev,jcol) &
                  &  / max(ssa_sw_cloud(jg,jlev,jcol), 1.0e-15_jprb)
@@ -308,5 +308,5 @@
     if (lhook) call dr_hook('radiation_general_cloud_optics:save',0,hook_handle)
 
-    do jtype = 1,config%n_cloud_types
+    DO jtype = 1,config%n_cloud_types
       if (config%do_sw) then
         associate(co_sw => config%cloud_optics_sw(jtype))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_general_cloud_optics_data.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_general_cloud_optics_data.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_general_cloud_optics_data.F90	(revision 5158)
@@ -285,6 +285,6 @@
 
     if (present(scat_od)) then
-      do jcol = 1,ncol
-        do jlev = 1,nlev
+      DO jcol = 1,ncol
+        DO jlev = 1,nlev
           if (cloud_fraction(jcol, jlev) > 0.0_jprb) then
             re_index = max(1.0_jprb, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) &
@@ -293,5 +293,5 @@
             weight2 = re_index - ire
             weight1 = 1.0_jprb - weight2
-            do jg = 1, ng
+            DO jg = 1, ng
               od_local = water_path(jcol, jlev) * (weight1*this%mass_ext(jg,ire) &
                  &                                +weight2*this%mass_ext(jg,ire+1))
@@ -310,6 +310,6 @@
     else
       ! No scattering: return the absorption optical depth
-      do jcol = 1,ncol
-        do jlev = 1,nlev
+      DO jcol = 1,ncol
+        DO jlev = 1,nlev
           if (water_path(jcol, jlev) > 0.0_jprb) then
             re_index = max(1.0_jprb, min(1.0_jprb + (effective_radius(jcol,jlev)-this%effective_radius_0) &
@@ -404,5 +404,5 @@
 
     ! Define effective radius
-    do ire = 1,this%n_effective_radius
+    DO ire = 1,this%n_effective_radius
       effective_radius(ire) = this%effective_radius_0 + this%d_effective_radius*(ire-1)
     end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_lw.F90	(revision 5158)
@@ -119,9 +119,9 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       ! Is there any cloud in the profile?
       is_cloudy_profile = .false.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
           is_cloudy_profile = .true.
@@ -135,5 +135,5 @@
       ! the clear-sky layers since these will be needed when we come
       ! to do the total-sky fluxes.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_clear .or. cloud%fraction(jcol,jlev) &
              &                 < config%cloud_fraction_threshold) then
@@ -201,5 +201,5 @@
       ! now.
       if (is_cloudy_profile .or. .not. config%do_clear) then
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           ! Compute combined gas+aerosol+cloud optical properties;
           ! note that for clear layers, the reflectance and
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_sw.F90	(revision 5158)
@@ -123,5 +123,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ! Only perform calculation if sun above the horizon
       if (single_level%cos_sza(jcol) > 0.0_jprb) then
@@ -131,5 +131,5 @@
         ! Is there any cloud in the profile?
         is_cloudy_profile = .false.
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
             is_cloudy_profile = .true.
@@ -146,5 +146,5 @@
           ! Delta-Eddington scaling has already been performed to the
           ! aerosol part of od, ssa and g
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             if (config%do_clear .or. cloud%fraction(jcol,jlev) &
                  &                 < config%cloud_fraction_threshold) then
@@ -164,5 +164,5 @@
         else
           ! Apply delta-Eddington scaling to the aerosol-gas mixture
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             if (config%do_clear .or. cloud%fraction(jcol,jlev) &
                  &                 < config%cloud_fraction_threshold) then
@@ -229,5 +229,5 @@
         ! fluxes now.
         if (is_cloudy_profile .or. .not. config%do_clear) then
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             ! Compute combined gas+aerosol+cloud optical properties;
             ! note that for clear layers, the reflectance and
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ice_optics_fu.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ice_optics_fu.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ice_optics_fu.F90	(revision 5158)
@@ -73,5 +73,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jb = 1, nb
+    DO jb = 1, nb
       od(jb) = iwp_gm_2 * (coeff(jb,1) + coeff(jb,2) * inv_de_um)
       scat_od(jb) = od(jb) * (1.0_jprb - (coeff(jb,3) + de_um*(coeff(jb,4) &
@@ -124,5 +124,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jb = 1, nb
+    DO jb = 1, nb
       od(jb) = iwp_gm_2 * (coeff(jb,1) + inv_de_um*(coeff(jb,2) &
          &  + inv_de_um*coeff(jb,3)))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ifs_rrtm.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ifs_rrtm.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ifs_rrtm.F90	(revision 5158)
@@ -386,6 +386,6 @@
     ZONEMINUS_ARRAY = ZONEMINUS
 
-    do jlev=1,nlev
-      do jcol= istartcol,iendcol
+    DO jlev=1,nlev
+      DO jcol= istartcol,iendcol
         pressure_fl(jcol,jlev) &
             &  = 0.5_jprb * (thermodynamics%pressure_hl(jcol,jlev+istartlev-1) &
@@ -486,11 +486,11 @@
         ! arrays have dimensions in a different order to the inputs,
         ! so there is some inefficiency here.
-        do jgreorder = 1,config%n_g_lw
+        DO jgreorder = 1,config%n_g_lw
           iband = config%i_band_from_reordered_g_lw(jgreorder)
           ig = config%i_g_from_reordered_g_lw(jgreorder)
           
           ! Top-of-atmosphere half level
-          do jlev = 1,nlev
-            do jcol = istartcol,iendcol
+          DO jlev = 1,nlev
+            DO jcol = istartcol,iendcol
               ! Some g points can return negative optical depths;
               ! specifically original g points 54-56 which causes
@@ -504,6 +504,6 @@
       else
         ! G points have not been reordered 
-        do jcol = istartcol,iendcol
-          do jlev = 1,nlev
+        DO jcol = istartcol,iendcol
+          DO jlev = 1,nlev
             ! Check for negative optical depth
             od_lw(:,jlev,jcol) = max(config%min_gas_od_lw, ZOD_LW(:,nlev+1-jlev,jcol))
@@ -544,6 +544,6 @@
       ! Scale the incoming solar per band, if requested
       if (config%use_spectral_solar_scaling) then
-        do jg = 1,JPGPT_SW
-          do jcol = istartcol,iendcol 
+        DO jg = 1,JPGPT_SW
+          DO jcol = istartcol,iendcol
             ZINCSOL(jcol,jg) = ZINCSOL(jcol,jg) * &
                  &   single_level%spectral_solar_scaling(config%i_band_from_reordered_g_sw(jg))
@@ -556,5 +556,5 @@
       ! ZINCSOL will be zero.
       if (present(incoming_sw)) then
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           if (single_level%cos_sza(jcol) > 0.0_jprb) then
 ! Added for DWD (2020)
@@ -570,8 +570,8 @@
 !      if (.true.) then
         ! Account for reordered g points
-        do jgreorder = 1,config%n_g_sw
+        DO jgreorder = 1,config%n_g_sw
           ig = config%i_g_from_reordered_g_sw(jgreorder)
-          do jlev = 1,nlev
-            do jcol = istartcol,iendcol
+          DO jlev = 1,nlev
+            DO jcol = istartcol,iendcol
               ! Check for negative optical depth
               od_sw (jgreorder,nlev+1-jlev,jcol) &
@@ -587,7 +587,7 @@
       else
         ! G points have not been reordered
-        do jcol = istartcol,iendcol
-          do jlev = 1,nlev
-            do jg = 1,config%n_g_sw
+        DO jcol = istartcol,iendcol
+          DO jlev = 1,nlev
+            DO jg = 1,config%n_g_sw
               ! Check for negative optical depth
               od_sw (jg,nlev+1-jlev,jcol) = max(config%min_gas_od_sw, ZOD_SW(jcol,jlev,jg))
@@ -596,5 +596,5 @@
           end do
           if (present(incoming_sw)) then
-            do jg = 1,config%n_g_sw
+            DO jg = 1,config%n_g_sw
               incoming_sw(jg,jcol) = incoming_sw_scale(jcol) * ZINCSOL(jcol,jg)
             end do
@@ -667,6 +667,6 @@
     ! lowest interpolation bound, and the fraction into interpolation
     ! interval
-    do jlev = 1,nlev+1
-      do jcol = istartcol,iendcol
+    DO jlev = 1,nlev+1
+      DO jcol = istartcol,iendcol
         temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset)
         if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then
@@ -687,7 +687,7 @@
 
       ! Calculate Planck functions per band
-      do jband = 1,config%n_bands_lw
+      DO jband = 1,config%n_bands_lw
         factor = zfluxfac * delwave(jband)
-        do jcol = istartcol,iendcol
+        DO jcol = istartcol,iendcol
           planck_store(jcol,jband) = factor &
                &  * (totplnk(ind(jcol),jband) &
@@ -706,5 +706,5 @@
           ! Top-of-atmosphere half level - note that PFRAC is on model
           ! levels not half levels
-          do jgreorder = 1,config%n_g_lw
+          DO jgreorder = 1,config%n_g_lw
             iband = config%i_band_from_reordered_g_lw(jgreorder)
             ig = config%i_g_from_reordered_g_lw(jgreorder)
@@ -713,5 +713,5 @@
           end do
         else
-          do jgreorder = 1,config%n_g_lw
+          DO jgreorder = 1,config%n_g_lw
             iband = config%i_band_from_reordered_g_lw(jgreorder)
             ig = config%i_g_from_reordered_g_lw(jgreorder)
@@ -726,14 +726,14 @@
           ! Top-of-atmosphere half level - note that PFRAC is on model
           ! levels not half levels
-          do jg = 1,config%n_g_lw
+          DO jg = 1,config%n_g_lw
             iband = config%i_band_from_g_lw(jg)
             planck_hl(jg,1,:) = planck_store(:,iband) * PFRAC(:,jg,nlev)
           end do
         else
-          do jg = 1,config%n_g_lw
+          DO jg = 1,config%n_g_lw
             iband = config%i_band_from_g_lw(jg)
             planck_tmp(:,jg) = planck_store(:,iband) * PFRAC(:,jg,nlev+2-jlev)
           end do
-          do jcol = istartcol,iendcol
+          DO jcol = istartcol,iendcol
             planck_hl(:,jlev,jcol) = planck_tmp(jcol,:)
           end do
@@ -794,5 +794,5 @@
 
     ! Work out surface interpolations
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       Tsurf = temperature(jcol)
       if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then
@@ -813,7 +813,7 @@
 
     ! Calculate Planck functions per band
-    do jband = 1,config%n_bands_lw
+    DO jband = 1,config%n_bands_lw
       factor = zfluxfac * delwave(jband)
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         planck_store(jcol,jband) = factor &
              &  * (totplnk(ind(jcol),jband) &
@@ -829,5 +829,5 @@
       ! in pressure since the the functions above treat pressure
       ! decreasing with increasing index.
-      do jgreorder = 1,config%n_g_lw
+      DO jgreorder = 1,config%n_g_lw
         iband = config%i_band_from_reordered_g_lw(jgreorder)
         ig = config%i_g_from_reordered_g_lw(jgreorder)
@@ -836,5 +836,5 @@
     else
       ! G points have not been reordered 
-      do jg = 1,config%n_g_lw
+      DO jg = 1,config%n_g_lw
         iband = config%i_band_from_g_lw(jg)
         planck_surf(jg,:) = planck_store(:,iband) * PFRAC(:,jg)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_liquid_optics_socrates.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_liquid_optics_socrates.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_liquid_optics_socrates.F90	(revision 5158)
@@ -65,5 +65,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jb = 1, nb
+    DO jb = 1, nb
       od(jb) = lwp * (coeff(jb,1) + re*(coeff(jb,2) + re*coeff(jb,3))) &
          &  / (1.0_jprb + re*(coeff(jb,4) + re*(coeff(jb,5) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_lw_derivatives.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_lw_derivatives.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_lw_derivatives.F90	(revision 5158)
@@ -74,5 +74,5 @@
     ! Move up through the atmosphere computing the derivatives at each
     ! half-level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       lw_derivatives_g = lw_derivatives_g * transmittance(:,jlev)
       lw_derivatives(icol,jlev) = sum(lw_derivatives_g)
@@ -122,5 +122,5 @@
     ! Move up through the atmosphere computing the derivatives at each
     ! half-level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       lw_derivatives_g = lw_derivatives_g * transmittance(:,jlev)
       lw_derivatives(icol,jlev) = (1.0_jprb - weight) * lw_derivatives(icol,jlev) &
@@ -177,5 +177,5 @@
     ! Move up through the atmosphere computing the derivatives at each
     ! half-level
-    do jlev = nlev,1,-1
+    DO jlev = nlev,1,-1
       ! Compute effect of overlap at half-level jlev+1, yielding
       ! derivatives just above that half-level
@@ -243,5 +243,5 @@
       ! multiplication inline
       
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
         ! Compute effect of overlap at half-level jlev+1, yielding
         ! derivatives just above that half-level
@@ -249,5 +249,5 @@
         
         associate(A=>u_matrix(:,:,jlev+1), b=>lw_deriv_below)
-          do jg = 1,ng   
+          DO jg = 1,ng
             ! Both inner and outer loop of the matrix loops j1 and j2 unrolled
             ! inner loop:        j2=1             j2=2             j2=3 
@@ -273,5 +273,5 @@
       ! Move up through the atmosphere computing the derivatives at each
       ! half-level
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
         ! Compute effect of overlap at half-level jlev+1, yielding
         ! derivatives just above that half-level
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_matrix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_matrix.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_matrix.F90	(revision 5158)
@@ -91,6 +91,6 @@
       mat_x_vec(1:iend,1) = A(1:iend,1,1)*b(1:iend,1)
     else
-      do j1 = 1,m
-        do j2 = 1,m
+      DO j1 = 1,m
+        DO j2 = 1,m
           mat_x_vec(1:iend,j1) = mat_x_vec(1:iend,j1) &
                &               + A(1:iend,j1,j2)*b(1:iend,j2)
@@ -125,6 +125,6 @@
     singlemat_x_vec = 0.0_jprb
 
-    do j1 = 1,m
-      do j2 = 1,m
+    DO j1 = 1,m
+      DO j2 = 1,m
         singlemat_x_vec(1:iend,j1) = singlemat_x_vec(1:iend,j1) &
              &                    + A(j1,j2)*b(1:iend,j2)
@@ -176,7 +176,7 @@
       m2block = 2*mblock 
       ! Do the top-left (C, D, F, G)
-      do j2 = 1,m2block
-        do j1 = 1,m2block
-          do j3 = 1,m2block
+      DO j2 = 1,m2block
+        DO j1 = 1,m2block
+          DO j3 = 1,m2block
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -184,8 +184,8 @@
         end do
       end do
-      do j2 = m2block+1,m
+      DO j2 = m2block+1,m
         ! Do the top-right (E & H)
-        do j1 = 1,m2block
-          do j3 = 1,m
+        DO j1 = 1,m2block
+          DO j3 = 1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -193,6 +193,6 @@
         end do
         ! Do the bottom-right (I)
-        do j1 = m2block+1,m
-          do j3 = m2block+1,m
+        DO j1 = m2block+1,m
+          DO j3 = m2block+1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -202,7 +202,7 @@
     else
       ! Ordinary dense matrix
-      do j2 = 1,m
-        do j1 = 1,m
-          do j3 = 1,m
+      DO j2 = 1,m
+        DO j1 = 1,m
+          DO j3 = 1,m
             mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) &
                  &                  + A(1:iend,j1,j3)*B(1:iend,j3,j2)
@@ -238,7 +238,7 @@
     singlemat_x_mat = 0.0_jprb
 
-    do j2 = 1,m
-      do j1 = 1,m
-        do j3 = 1,m
+    DO j2 = 1,m
+      DO j1 = 1,m
+        DO j3 = 1,m
           singlemat_x_mat(1:iend,j1,j2) = singlemat_x_mat(1:iend,j1,j2) &
                &                        + A(j1,j3)*B(1:iend,j3,j2)
@@ -273,7 +273,7 @@
     mat_x_singlemat = 0.0_jprb
 
-    do j2 = 1,m
-      do j1 = 1,m
-        do j3 = 1,m
+    DO j2 = 1,m
+      DO j1 = 1,m
+        DO j3 = 1,m
           mat_x_singlemat(1:iend,j1,j2) = mat_x_singlemat(1:iend,j1,j2) &
                &                        + A(1:iend,j1,j3)*B(j3,j2)
@@ -311,5 +311,5 @@
 
     identity_minus_mat_x_mat = - identity_minus_mat_x_mat
-    do j = 1,m
+    DO j = 1,m
       identity_minus_mat_x_mat(1:iend,j,j) &
            &     = 1.0_jprb + identity_minus_mat_x_mat(1:iend,j,j)
@@ -337,6 +337,6 @@
     
     sparse_x_dense = 0.0_jprb
-    do j2 = 1,n2
-      do j1 = 1,n1
+    DO j2 = 1,n2
+      DO j1 = 1,n1
         if (sparse(j1,j2) /= 0.0_jprb) then
           sparse_x_dense(j1,:) = sparse_x_dense(j1,:) + sparse(j1,j2)*dense(j2,:)
@@ -376,10 +376,10 @@
       mblock = m/3
       m2block = 2*mblock
-      do j4 = 1,nrepeat
+      DO j4 = 1,nrepeat
         repeated_square = 0.0_jprb
         ! Do the top-left (C, D, F & G)
-        do j2 = 1,m2block
-          do j1 = 1,m2block
-            do j3 = 1,m2block
+        DO j2 = 1,m2block
+          DO j1 = 1,m2block
+            DO j3 = 1,m2block
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -387,8 +387,8 @@
           end do
         end do
-        do j2 = m2block+1, m
+        DO j2 = m2block+1, m
           ! Do the top-right (E & H)
-          do j1 = 1,m2block
-            do j3 = 1,m
+          DO j1 = 1,m2block
+            DO j3 = 1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -396,6 +396,6 @@
           end do
           ! Do the bottom-right (I)
-          do j1 = m2block+1, m
-            do j3 = m2block+1,m
+          DO j1 = m2block+1, m
+            DO j3 = m2block+1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -409,9 +409,9 @@
     else
       ! Ordinary dense matrix
-      do j4 = 1,nrepeat
+      DO j4 = 1,nrepeat
         repeated_square = 0.0_jprb
-        do j2 = 1,m
-          do j1 = 1,m
-            do j3 = 1,m
+        DO j2 = 1,m
+          DO j1 = 1,m
+            DO j3 = 1,m
               repeated_square(j1,j2) = repeated_square(j1,j2) &
                    &                 + A(j1,j3)*A(j3,j2)
@@ -549,5 +549,5 @@
     U33 = A(1:iend,3,3) - L31*A(1:iend,1,3) - L32*U23
 
-    do j = 1,3
+    DO j = 1,3
       ! Solve Ly = B(:,:,j) by forward substitution
       ! y1 = B(:,1,j)
@@ -649,15 +649,15 @@
     LU(1:iend,1:m,1:m) = A(1:iend,1:m,1:m)
 
-    do j2 = 1, m
-      do j1 = 1, j2-1
+    DO j2 = 1, m
+      DO j1 = 1, j2-1
         s = LU(1:iend,j1,j2)
-        do j3 = 1, j1-1
+        DO j3 = 1, j1-1
           s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
         end do
         LU(1:iend,j1,j2) = s
       end do
-      do j1 = j2, m
+      DO j1 = j2, m
         s = LU(1:iend,j1,j2)
-        do j3 = 1, j2-1
+        DO j3 = 1, j2-1
           s = s - LU(1:iend,j1,j3) * LU(1:iend,j3,j2)
         end do
@@ -666,5 +666,5 @@
       if (j2 /= m) then
         s = 1.0_jprb / LU(1:iend,j2,j2)
-        do j1 = j2+1, m
+        DO j1 = j2+1, m
           LU(1:iend,j1,j2) = LU(1:iend,j1,j2) * s
         end do
@@ -691,12 +691,12 @@
 
     ! First solve Ly=b
-    do j2 = 2, m
-      do j1 = 1, j2-1
+    DO j2 = 2, m
+      DO j1 = 1, j2-1
         x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
       end do
     end do
     ! Now solve Ux=y
-    do j2 = m, 1, -1
-      do j1 = j2+1, m
+    DO j2 = m, 1, -1
+      DO j1 = j2+1, m
         x(1:iend,j2) = x(1:iend,j2) - x(1:iend,j1)*LU(1:iend,j2,j1)
       end do
@@ -722,5 +722,5 @@
     call lu_factorization(n,iend,m,A,LU)
 
-    do j = 1, m
+    DO j = 1, m
       call lu_substitution(n,iend,m,LU,B(1:,1:m,j),X(1:iend,1:m,j))
 !      call lu_substitution(n,iend,m,LU,B(1:n,1:m,j),X(1:iend,1:m,j))
@@ -835,12 +835,12 @@
 
     ! Compute the 1-norms of A
-    do j3 = 1,m
+    DO j3 = 1,m
       sum_column(:) = 0.0_jprb
-      do j2 = 1,m
-        do j1 = 1,iend
+      DO j2 = 1,m
+        DO j1 = 1,iend
           sum_column(j1) = sum_column(j1) + abs(A(j1,j2,j3))
         end do
       end do
-      do j1 = 1,iend
+      DO j1 = 1,iend
         if (sum_column(j1) > normA(j1)) then
           normA(j1) = sum_column(j1)
@@ -861,6 +861,6 @@
     ! Scale the input matrices by a power of 2
     scaling = 2.0_jprb**(-expo)
-    do j3 = 1,m
-      do j2 = 1,m
+    DO j3 = 1,m
+      DO j2 = 1,m
         A(1:iend,j2,j3) = A(1:iend,j2,j3) * scaling
       end do
@@ -872,5 +872,5 @@
 
     V = c(8)*A6 + c(6)*A4 + c(4)*A2
-    do j3 = 1,m
+    DO j3 = 1,m
       V(:,j3,j3) = V(:,j3,j3) + c(2)
     end do
@@ -878,5 +878,5 @@
     V = c(7)*A6 + c(5)*A4 + c(3)*A2
     ! Add a multiple of the identity matrix
-    do j3 = 1,m
+    DO j3 = 1,m
       V(:,j3,j3) = V(:,j3,j3) + c(1)
     end do
@@ -887,10 +887,10 @@
 
     ! Add the identity matrix
-    do j3 = 1,m
+    DO j3 = 1,m
       A(1:iend,j3,j3) = A(1:iend,j3,j3) + 1.0_jprb
     end do
 
     ! Loop through the matrices
-    do j1 = 1,iend
+    DO j1 = 1,iend
       if (expo(j1) > 0) then
         ! Square matrix j1 expo(j1) times          
@@ -1016,6 +1016,6 @@
 
     ! Compute V * diag_rdivide_V
-    do j1 = 1,3
-      do j2 = 1,3
+    DO j1 = 1,3
+      DO j2 = 1,3
         R(1:iend,j2,j1) = V(1:iend,j2,1)*diag_rdivide_V(1:iend,1,j1) &
              &          + V(1:iend,j2,2)*diag_rdivide_V(1:iend,2,j1) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_mcica_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_mcica_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_mcica_lw.F90	(revision 5158)
@@ -146,5 +146,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
 
       ! Clear-sky calculation
@@ -203,5 +203,5 @@
         is_clear_sky_layer = .true.
         i_cloud_top = nlev+1
-        do jlev = 1,nlev
+        DO jlev = 1,nlev
           ! Compute combined gas+aerosol+cloud optical properties
           if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
@@ -212,5 +212,5 @@
             end if
 
-            do jg = 1,ng
+            DO jg = 1,ng
               od_cloud_new(jg) = od_scaling(jg,jlev) &
                  &  * od_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol)
@@ -228,5 +228,5 @@
                 ! case that od_total > 0.0 and ssa_total > 0.0 but
                 ! od_total*ssa_total == 0 due to underflow
-                do jg = 1,ng
+                DO jg = 1,ng
                   if (od_total(jg) > 0.0_jprb) then
                     scat_od_total(jg) = ssa(jg,jlev,jcol)*od(jg,jlev,jcol) &
@@ -247,5 +247,5 @@
               else
 
-                do jg = 1,ng
+                DO jg = 1,ng
                   if (od_total(jg) > 0.0_jprb) then
                     scat_od = ssa_cloud(config%i_band_from_reordered_g_lw(jg),jlev,jcol) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_mcica_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_mcica_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_mcica_sw.F90	(revision 5158)
@@ -138,5 +138,5 @@
 
     ! Loop through columns
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       ! Only perform calculation if sun above the horizon
       if (single_level%cos_sza(jcol) > 0.0_jprb) then
@@ -155,5 +155,5 @@
         else
           ! Apply delta-Eddington scaling to the aerosol-gas mixture
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             od_total  =  od(:,jlev,jcol)
             ssa_total = ssa(:,jlev,jcol)
@@ -205,8 +205,8 @@
         if (total_cloud_cover >= config%cloud_fraction_threshold) then
           ! Total-sky calculation
-          do jlev = 1,nlev
+          DO jlev = 1,nlev
             ! Compute combined gas+aerosol+cloud optical properties
             if (cloud%fraction(jcol,jlev) >= config%cloud_fraction_threshold) then
-              do jg = 1,ng
+              DO jg = 1,ng
                 od_cloud_new(jg) = od_scaling(jg,jlev) &
                    &  * od_cloud(config%i_band_from_reordered_g_sw(jg),jlev,jcol)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_monochromatic.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_monochromatic.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_monochromatic.F90	(revision 5158)
@@ -164,5 +164,5 @@
     integer :: jlev
 
-    do jlev = 1,nlev
+    DO jlev = 1,nlev
       ! The fraction of the total optical depth in the current layer
       ! is proportional to the fraction of the mass of the atmosphere
@@ -192,5 +192,5 @@
              &  = StefanBoltzmann * single_level%skin_temperature(istartcol:iendcol)**4 &
              &  * single_level%lw_emissivity(istartcol:iendcol,1)
-        do jlev = 1,nlev+1
+        DO jlev = 1,nlev+1
           planck_hl(1,jlev,istartcol:iendcol) = StefanBoltzmann * thermodynamics%temperature_hl(istartcol:iendcol,jlev)**4
         end do
@@ -200,5 +200,5 @@
              &             single_level%skin_temperature(istartcol:iendcol)) &
              &  * single_level%lw_emissivity(istartcol:iendcol,1)
-        do jlev = 1,nlev+1
+        DO jlev = 1,nlev+1
           planck_hl(1,jlev,istartcol:iendcol) = Pi*planck_function(config%mono_lw_wavelength, &
                &             thermodynamics%temperature_hl(istartcol:iendcol,jlev))
@@ -261,6 +261,6 @@
     ! Convert cloud mixing ratio into liquid and ice water path
     ! in each layer
-    do jlev = 1, nlev
-      do jcol = istartcol, iendcol
+    DO jlev = 1, nlev
+      DO jcol = istartcol, iendcol
         ! Factor to convert from gridbox-mean mass mixing ratio to
         ! in-cloud water path involves the pressure difference in
@@ -288,5 +288,5 @@
 
     if (config%iverbose >= 4) then
-      do jcol = istartcol,iendcol
+      DO jcol = istartcol,iendcol
         write(*,'(a,i0,a,f7.3,a,f7.3)') 'Profile ', jcol, ': shortwave optical depth = ', &
              &  sum(od_sw_cloud(1,:,jcol)*cloud%fraction(jcol,:)), &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_overlap.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_overlap.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_overlap.F90	(revision 5158)
@@ -94,5 +94,5 @@
     ! multiply by "factor"
     denominator = 1.0_jprb
-    do jreg = 1,nreg
+    DO jreg = 1,nreg
       op_x_frac_min(jreg) = op(jreg) &
            &  * min(frac_upper(jreg), frac_lower(jreg))
@@ -103,6 +103,6 @@
       factor = 1.0_jprb / denominator
       ! Create the random part of the overlap matrix
-      do jupper = 1,nreg
-        do jlower = 1,nreg
+      DO jupper = 1,nreg
+        DO jlower = 1,nreg
           overlap_matrix(jupper,jlower) = factor &
                &  * (frac_lower(jlower)-op_x_frac_min(jlower)) &
@@ -115,5 +115,5 @@
     
     ! Add on the maximum part of the overlap matrix
-    do jreg = 1,nreg
+    DO jreg = 1,nreg
       overlap_matrix(jreg,jreg) = overlap_matrix(jreg,jreg) &
            &  + op_x_frac_min(jreg)
@@ -368,5 +368,5 @@
 
     ! Loop through each atmospheric column
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! For this column, outer space is treated as one clear-sky
       ! region, so the fractions are assigned as such
@@ -381,5 +381,5 @@
       ! half-level starting at 1 for the top-of-atmosphere, as well
       ! as indexing each level starting at 1 for the top-most level.
-      do jlev = 1,nlev+1
+      DO jlev = 1,nlev+1
         ! Fraction of each region just below the interface
         if (jlev > nlev) then
@@ -426,6 +426,6 @@
 
         ! Convert to directional overlap matrices
-        do jupper = 1,nreg
-          do jlower = 1,nreg
+        DO jupper = 1,nreg
+          DO jlower = 1,nreg
             if (frac_lower(jlower) >= frac_threshold) then
               u_matrix(jupper,jlower,jlev,jcol) = overlap_matrix(jupper,jlower) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_pdf_sampler.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_pdf_sampler.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_pdf_sampler.F90	(revision 5158)
@@ -189,5 +189,5 @@
     real(jprb) :: wfsd, wcdf
 
-    do jsamp = 1,nsamp
+    DO jsamp = 1,nsamp
       if (mask(jsamp)) then
         ! Bilinear interpolation with bounds
@@ -237,6 +237,6 @@
     real(jprb) :: wfsd, wcdf
 
-    do jz = 1,nz
-      do jg = 1,ng
+    DO jz = 1,nz
+      DO jg = 1,ng
         if (cdf(jg, jz) > 0.0_jprb) then
           ! Bilinear interpolation with bounds
@@ -291,9 +291,9 @@
     real(jprb) :: wfsd, wcdf
 
-    do jz = 1,nz
+    DO jz = 1,nz
 
       if (mask(jz)) then
         
-        do jg = 1,ng
+        DO jg = 1,ng
           if (cdf(jg, jz) > 0.0_jprb) then
             ! Bilinear interpolation with bounds
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_random_numbers.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_random_numbers.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_random_numbers.F90	(revision 5158)
@@ -165,5 +165,5 @@
       ! populate the state
       rseed = real(abs(this%iseed),jprd)
-      do jstr = 1,this%nmaxstreams
+      DO jstr = 1,this%nmaxstreams
         ! Note that nint returns an integer of type jpib (8-byte)
         ! which may be converted to double if that is the type of
@@ -174,5 +174,5 @@
 
       ! One warmup of the C++ minstd_rand algorithm
-      do jstr = 1,this%nmaxstreams
+      DO jstr = 1,this%nmaxstreams
         this%istate(jstr) = mod(IMinstdA * this%istate(jstr), IMinstdM)
       end do
@@ -182,5 +182,5 @@
       call random_seed(size=nseed)
       allocate(iseednative(nseed))
-      do jseed = 1,nseed
+      DO jseed = 1,nseed
         iseednative(jseed) = this%iseed + jseed - 1
       end do
@@ -208,5 +208,5 @@
 
       ! C++ minstd_rand algorithm
-      do i = 1, imax
+      DO i = 1, imax
         ! The following calculation is computed entirely with 8-byte
         ! numbers (whether real or integer)
@@ -243,7 +243,7 @@
 
       ! C++ minstd_ran algorithm
-      do jblock = 1,size(randnum,2)
+      DO jblock = 1,size(randnum,2)
         ! These lines should be vectorizable
-        do i = 1, imax
+        DO i = 1, imax
           this%istate(i) = mod(IMinstdA * this%istate(i), IMinstdM)
           randnum(i,jblock) = IMinstdScale * this%istate(i)
@@ -278,8 +278,8 @@
 
       ! C++ minstd_ran algorithm
-      do jblock = 1,size(randnum,2)
+      DO jblock = 1,size(randnum,2)
         if (mask(jblock)) then
           ! These lines should be vectorizable
-          do i = 1, imax
+          DO i = 1, imax
             this%istate(i) = mod(IMinstdA * this%istate(i), IMinstdM)
             randnum(i,jblock) = IMinstdScale * this%istate(i)
@@ -290,5 +290,5 @@
     else
 
-      do jblock = 1,size(randnum,2)
+      DO jblock = 1,size(randnum,2)
         if (mask(jblock)) then
           call random_number(randnum(:,jblock))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_regions.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_regions.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_regions.F90	(revision 5158)
@@ -122,6 +122,6 @@
         ! sigma, then the 16th percentile of the lognormal is very
         ! close to exp(mu-sigma).
-        do jcol = istartcol,iendcol
-          do jlev = 1,nlev
+        DO jcol = istartcol,iendcol
+          DO jlev = 1,nlev
             if (cloud_fraction(jcol,jlev) < frac_threshold) then
               reg_fracs(1,jlev,jcol)       = 1.0_jprb
@@ -145,6 +145,6 @@
         ! cover of the denser region - see region_fractions routine
         ! below
-        do jcol = istartcol,iendcol
-          do jlev = 1,nlev
+        DO jcol = istartcol,iendcol
+          DO jlev = 1,nlev
             if (cloud_fraction(jcol,jlev) < frac_threshold) then
               reg_fracs(1,jlev,jcol)    = 1.0_jprb
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_save.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_save.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_save.F90	(revision 5158)
@@ -1168,5 +1168,5 @@
          &   dim2_name="column", dim1_name="level", &
          &   units_str="1", long_name="Ozone mass mixing ratio")
-    do jgas = 1,NMaxGases
+    DO jgas = 1,NMaxGases
       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
         write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
@@ -1259,5 +1259,5 @@
     call gas%get(IO3, IMassMixingRatio, mixing_ratio)
     call out_file%put("o3_mmr", mixing_ratio)
-    do jgas = 1,NMaxGases
+    DO jgas = 1,NMaxGases
       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
         write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_single_level.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_single_level.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_single_level.F90	(revision 5158)
@@ -206,5 +206,5 @@
     end if
 
-    do jcol = istartcol,iendcol
+    DO jcol = istartcol,iendcol
       this%iseed(jcol) = jcol
     end do
@@ -275,8 +275,8 @@
 
         sw_albedo_band = 0.0_jprb
-        do jband = 1,config%n_bands_sw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_sw
+          DO jalbedoband = 1,nalbedoband
             if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
-              do jcol = istartcol,iendcol
+              DO jcol = istartcol,iendcol
                 sw_albedo_band(jcol,jband) &
                     &  = sw_albedo_band(jcol,jband) & 
@@ -292,6 +292,6 @@
         if (allocated(this%sw_albedo_direct)) then
           sw_albedo_band = 0.0_jprb
-          do jband = 1,config%n_bands_sw
-            do jalbedoband = 1,nalbedoband
+          DO jband = 1,config%n_bands_sw
+            DO jalbedoband = 1,nalbedoband
               if (config%sw_albedo_weights(jalbedoband,jband) /= 0.0_jprb) then
                 sw_albedo_band(istartcol:iendcol,jband) &
@@ -342,8 +342,8 @@
         end if
         lw_albedo_band = 0.0_jprb
-        do jband = 1,config%n_bands_lw
-          do jalbedoband = 1,nalbedoband
+        DO jband = 1,config%n_bands_lw
+          DO jalbedoband = 1,nalbedoband
             if (config%lw_emiss_weights(jalbedoband,jband) /= 0.0_jprb) then
-              do jcol = istartcol,iendcol
+              DO jcol = istartcol,iendcol
                 lw_albedo_band(jcol,jband) &
                     &  = lw_albedo_band(jcol,jband) & 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_lw.F90	(revision 5158)
@@ -313,5 +313,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -325,5 +325,5 @@
       ! cloud%crop_cloud_fraction has already been called
       is_clear_sky_layer = .true.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -336,5 +336,5 @@
       ! In this section the reflectance, transmittance and sources
       ! are computed for each layer
-      do jlev = 1,nlev ! Start at top-of-atmosphere
+      DO jlev = 1,nlev ! Start at top-of-atmosphere
         ! --------------------------------------------------------
         ! Section 3.1: Layer-specific initialization
@@ -395,5 +395,5 @@
             ! approximate order of gas optical depth.
             ng3D = ng
-            do jg = 1, ng
+            DO jg = 1, ng
               if (od_region(jg,1) > config%max_gas_od_3D) then
                 ng3D = jg-1
@@ -488,5 +488,5 @@
               end if
 
-              do jreg = 1, nreg-1
+              DO jreg = 1, nreg-1
                 ! Compute lateral transfer rate from region jreg to
                 ! jreg+1 following Hogan & Shonk (2013) Eq. 47, but
@@ -536,5 +536,5 @@
           ! g-point, mapping from the cloud properties
           ! defined in each band.
-          do jg = 1,ng
+          DO jg = 1,ng
             ! Mapping from g-point to band
             iband = config%i_band_from_reordered_g_lw(jg)
@@ -544,5 +544,5 @@
 
             ! Loop over cloudy regions
-            do jreg = 2,nreg
+            DO jreg = 2,nreg
               ! Add scaled cloud optical depth to clear-sky value
               od_region(jg,jreg) = od_region(jg,1) &
@@ -603,5 +603,5 @@
           ! exponential, then computing the various
           ! transmission/reflectance matrices from that.
-          do jreg = 1,nregActive
+          DO jreg = 1,nregActive
             ! Write the diagonal elements of -Gamma1*z1
             Gamma_z1(1:ng3D,jreg,jreg) &
@@ -628,5 +628,5 @@
             ! non-zeros in the cloudy-sky regions even if the cloud
             ! fraction is zero
-            do jreg = nregActive+1,nreg
+            DO jreg = nregActive+1,nreg
               Gamma_z1(1:ng3D,jreg,jreg) = Gamma_z1(1:ng3D,1,1)
               Gamma_z1(1:ng3D,nreg+jreg,jreg) = Gamma_z1(1:ng3D,nreg+1,1)
@@ -656,5 +656,5 @@
           end if
 
-          do jreg = 1,nregActive-1
+          DO jreg = 1,nregActive-1
             ! Add the terms assocated with 3D transport to Gamma1*z1.
             ! First the rate from region jreg to jreg+1
@@ -775,5 +775,5 @@
           ! formulas for reflectance and transmittance, and equivalent
           ! solutions to the coupled ODEs for the sources.
-          do jreg = 2, nregActive
+          DO jreg = 2, nregActive
             call calc_reflectance_transmittance_lw(ng-ng3D, &
                  &  od_region(ng3D+1:ng,jreg), &
@@ -806,6 +806,6 @@
       ! Calculate the upwelling radiation emitted by the surface, and
       ! copy the surface albedo into total_albedo 
-      do jreg = 1,nreg
-        do jg = 1,ng
+      DO jreg = 1,nreg
+        DO jg = 1,ng
           ! region_fracs(jreg,nlev,jcol) is the fraction of each
           ! region in the lowest model level
@@ -816,5 +816,5 @@
       ! Equivalent surface values for computing clear-sky fluxes 
       if (config%do_clear) then
-        do jg = 1,ng
+        DO jg = 1,ng
           total_source_clear(jg,nlev+1) = emission(jg,jcol)
         end do
@@ -826,5 +826,5 @@
       ! Loop back up through the atmosphere computing the total albedo
       ! and the total upwelling due to emission below each level
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
         if (config%do_clear) then
           ! Use adding method for clear-sky arrays; note that there
@@ -876,5 +876,5 @@
           total_albedo_below = 0.0_jprb
           total_source_below = 0.0_jprb
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             inv_denom_scalar(:) = 1.0_jprb / (1.0_jprb &
                  &  - total_albedo(:,jreg,jreg,jlev+1)*reflectance(:,jreg,jreg,jlev))
@@ -918,6 +918,6 @@
             ! essentially diag(total_albedo) = matmul(transpose(v_matrix),
             ! diag(total_albedo_below)).
-            do jreg = 1,nreg
-              do jreg2 = 1,nreg
+            DO jreg = 1,nreg
+              DO jreg2 = 1,nreg
                 total_albedo(:,jreg,jreg,jlev) &
                      &  = total_albedo(:,jreg,jreg,jlev) &
@@ -966,5 +966,5 @@
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_clear) then
           ! Scalar operations for clear-sky fluxes
@@ -999,5 +999,5 @@
                &  flux_dn_above) + total_source(:,:,jlev+1)
         else
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             ! Scalar operations for all regions, requiring that
             ! reflectance, transmittance and total_albedo are diagonal
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_sw.F90	(revision 5158)
@@ -328,5 +328,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -404,5 +404,5 @@
       is_clear_sky_layer = .true.
       i_cloud_top = nlev+1
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -416,5 +416,5 @@
       ! In this section the reflectance, transmittance and sources
       ! are computed for each layer
-      do jlev = 1,nlev ! Start at top-of-atmosphere
+      DO jlev = 1,nlev ! Start at top-of-atmosphere
         ! --------------------------------------------------------
         ! Section 3.1: Layer-specific initialization
@@ -469,5 +469,5 @@
             ! approximate order of gas optical depth.
             ng3D = ng
-            do jg = 1, ng
+            DO jg = 1, ng
               if (od_region(jg,1) > config%max_gas_od_3D) then
                 ng3D = jg-1
@@ -553,5 +553,5 @@
               end if
 
-              do jreg = 1, nreg-1
+              DO jreg = 1, nreg-1
                 ! Compute lateral transfer rates from region jreg to
                 ! jreg+1 following Hogan & Shonk (2013) Eq. 47, but
@@ -615,5 +615,5 @@
           ! g-point, mapping from the cloud properties
           ! defined in each band.
-          do jg = 1,ng
+          DO jg = 1,ng
             ! Mapping from g-point to band
             iband = config%i_band_from_reordered_g_sw(jg)
@@ -629,5 +629,5 @@
 
             ! Loop over cloudy regions
-            do jreg = 2,nreg
+            DO jreg = 2,nreg
               scat_od_cloud = od_cloud(iband,jlev,jcol) &
                    &  * ssa_cloud(iband,jlev,jcol)*od_scaling(jreg,jlev,jcol)
@@ -679,5 +679,5 @@
           ! exponential, then computing the various
           ! transmission/reflectance matrices from that.
-          do jreg = 1,nregactive
+          DO jreg = 1,nregactive
             ! Write the diagonal elements of -Gamma1*z1
             Gamma_z1(1:ng3D,jreg,jreg) &
@@ -701,5 +701,5 @@
           end do
 
-          do jreg = 1,nregactive-1
+          DO jreg = 1,nregactive-1
             ! Write the elements of -Gamma1*z1 concerned with 3D
             ! transport
@@ -820,5 +820,5 @@
           ! Compute reflectance, transmittance and associated terms
           ! for each cloudy region, using the Meador-Weaver formulas
-          do jreg = 2, nregactive
+          DO jreg = 2, nregactive
             call calc_reflectance_transmittance_sw(ng-ng3D, &
                  &  mu0, &
@@ -853,6 +853,6 @@
       ! beam incident on the surface, and copy the surface albedo
       ! into total_albedo
-      do jreg = 1,nreg
-        do jg = 1,ng
+      DO jreg = 1,nreg
+        DO jg = 1,ng
           total_albedo(jg,jreg,jreg,nlev+1) = albedo_diffuse(jg,jcol)
           total_albedo_direct(jg,jreg,jreg,nlev+1) &
@@ -875,5 +875,5 @@
       ! Work back up through the atmosphere computing the total albedo
       ! of the atmosphere below that point using the adding method
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
 
         ! --------------------------------------------------------
@@ -995,6 +995,6 @@
           ! radiation:
           total_albedo(:,:,:,jlev) = 0.0_jprb
-          do jreg = 1,nreg    ! Target layer (jlev-1)
-            do jreg2 = 1,nreg ! Current layer (jlev)
+          DO jreg = 1,nreg    ! Target layer (jlev-1)
+            DO jreg2 = 1,nreg ! Current layer (jlev)
               total_albedo(:,jreg,jreg,jlev) = total_albedo(:,jreg,jreg,jlev) &
                    &  + sum(total_albedo_below(:,:,jreg2),2) &
@@ -1004,6 +1004,6 @@
           ! ...then direct radiation:
           total_albedo_direct(:,:,:,jlev) = 0.0_jprb
-          do jreg = 1,nreg    ! Target layer (jlev-1)
-            do jreg2 = 1,nreg ! Current layer (jlev)
+          DO jreg = 1,nreg    ! Target layer (jlev-1)
+            DO jreg2 = 1,nreg ! Current layer (jlev)
               total_albedo_direct(:,jreg,jreg,jlev) = total_albedo_direct(:,jreg,jreg,jlev) &
                    &  + sum(total_albedo_below_direct(:,:,jreg2),2) &
@@ -1031,5 +1031,5 @@
           ! First diffuse radiation:
           albedo_part = total_albedo_below
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             albedo_part(:,jreg,jreg) = 0.0_jprb
           end do
@@ -1040,5 +1040,5 @@
           ! ...then direct radiation:
           albedo_part = total_albedo_below_direct
-          do jreg = 1,nreg
+          DO jreg = 1,nreg
             albedo_part(:,jreg,jreg) = 0.0_jprb
           end do
@@ -1059,6 +1059,6 @@
             ! essentially diag(total_albedo) += matmul(transpose(v_matrix),
             ! diag(total_albedo_below)).
-            do jreg = 1,nreg
-              do jreg2 = 1,nreg
+            DO jreg = 1,nreg
+              DO jreg2 = 1,nreg
                 total_albedo(:,jreg,jreg,jlev) &
                      &  = total_albedo(:,jreg,jreg,jlev) &
@@ -1075,5 +1075,5 @@
             ! "Explicit entrapment"
 
-            do jreg2 = 1,nreg
+            DO jreg2 = 1,nreg
               ! Loop through each region in the lower layer. For one
               ! of the regions in the lower layer, we are imagining it
@@ -1110,5 +1110,5 @@
                      &  / max(config%cloud_fraction_threshold, region_fracs(jreg2,jlev,jcol))
 
-                do jreg = 1, nreg-1
+                DO jreg = 1, nreg-1
                   ! Compute lateral transfer rates from region jreg to
                   ! jreg+1 as before, but without length scale which
@@ -1139,5 +1139,5 @@
               inv_effective_size = min(cloud%inv_cloud_effective_size(jcol,jlev-1), &
                    &                   1.0_jprb/config%min_cloud_effective_size)
-              do jreg = 1,nreg-1
+              DO jreg = 1,nreg-1
                 ! Diffuse transport down and up with one random
                 ! scattering event
@@ -1167,5 +1167,5 @@
               ! trival limit, so we cap the maximum input to expm by
               ! scaling down if necessary
-              do jg = 1,ng
+              DO jg = 1,ng
                 max_entr = -min(entrapment(jg,1,1),entrapment(jg,2,2))
                 if (max_entr > config%max_cloud_od) then
@@ -1197,6 +1197,6 @@
 #ifndef EXPLICIT_EDGE_ENTRAPMENT
               ! Scale to get the contribution to the diffuse albedo
-              do jreg3 = 1,nreg
-                do jreg = 1,nreg
+              DO jreg3 = 1,nreg
+                DO jreg = 1,nreg
                   albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
                        &  * v_matrix(jreg2,jreg,jlev,jcol) * total_albedo_below(:,jreg2,jreg2)
@@ -1210,11 +1210,11 @@
               albedo_part = 0.0_jprb
               ! Scale to get the contribution to the diffuse albedo
-              do jreg3 = 1,nreg     ! TO upper region
-                do jreg = 1,nreg    ! FROM upper region
+              DO jreg3 = 1,nreg     ! TO upper region
+                DO jreg = 1,nreg    ! FROM upper region
                   transfer_scaling = 1.0_jprb - (1.0_jprb - config%overhang_factor) & 
                        &  * cloud%overlap_param(jcol,jlev-1) &
                        &  * min(region_fracs(jreg,jlev,jcol), region_fracs(jreg,jlev,jcol)) &
                        &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
-                  do jreg4 = 1,nreg ! VIA first lower region (jreg2 is second lower region)
+                  DO jreg4 = 1,nreg ! VIA first lower region (jreg2 is second lower region)
                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
                       albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
@@ -1236,5 +1236,5 @@
               ! Now do the same for the direct albedo
               entrapment = 0.0_jprb
-              do jreg = 1,nreg-1
+              DO jreg = 1,nreg-1
                 ! Direct transport down and diffuse up with one random
                 ! scattering event
@@ -1264,5 +1264,5 @@
               ! trival limit, so we cap the maximum input to expm by
               ! scaling down if necessary
-              do jg = 1,ng
+              DO jg = 1,ng
                 max_entr = -min(entrapment(jg,1,1),entrapment(jg,2,2))
                 if (max_entr > config%max_cloud_od) then
@@ -1289,6 +1289,6 @@
 
 #ifndef EXPLICIT_EDGE_ENTRAPMENT
-              do jreg3 = 1,nreg
-                do jreg = 1,nreg
+              DO jreg3 = 1,nreg
+                DO jreg = 1,nreg
                   albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) &
                        &  * v_matrix(jreg2,jreg,jlev,jcol) * total_albedo_below_direct(:,jreg2,jreg2)
@@ -1298,11 +1298,11 @@
               entrapment = albedo_part
               albedo_part = 0.0_jprb
-              do jreg3 = 1,nreg
-                do jreg = 1,nreg
+              DO jreg3 = 1,nreg
+                DO jreg = 1,nreg
                   transfer_scaling = 1.0_jprb - (1.0_jprb - config%overhang_factor) & 
                        &  * cloud%overlap_param(jcol,jlev-1) &
                        &  * min(region_fracs(jreg,jlev,jcol), region_fracs(jreg,jlev-1,jcol)) &
                        &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
-                  do jreg4 = 1,nreg
+                  DO jreg4 = 1,nreg
                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
                      albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
@@ -1343,6 +1343,6 @@
           end if
 
-          do jreg = 1,nreg          ! Target layer (jlev-1)
-            do jreg2 = 1,nregactive ! Current layer (jlev)
+          DO jreg = 1,nreg          ! Target layer (jlev-1)
+            DO jreg2 = 1,nregactive ! Current layer (jlev)
               x_direct_above(:,jreg) = x_direct_above(:,jreg) &
                    &  + x_direct(:,jreg2) * v_matrix(jreg2,jreg,jlev,jcol)
@@ -1368,5 +1368,5 @@
       ! Direct downwelling flux (into a plane perpendicular to the
       ! sun) entering the top of each region in the top-most layer
-      do jreg = 1,nreg
+      DO jreg = 1,nreg
         direct_dn_below(:,jreg) = incoming_sw(:,jcol)*region_fracs(jreg,1,jcol)
       end do
@@ -1421,5 +1421,5 @@
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
 
 #ifdef PRINT_ENTRAPMENT_DATA
@@ -1675,5 +1675,5 @@
          &                             + tan_diffuse_angle_3d*tan_diffuse_angle_3d) * 0.5_jprb
 
-    do jreg = istartreg,iendreg
+    DO jreg = istartreg,iendreg
       ! Geometric series enhancement due to multiple scattering: the
       ! amplitude enhancement is equal to the limit of
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spectral_definition.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spectral_definition.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spectral_definition.F90	(revision 5158)
@@ -201,5 +201,5 @@
     else
       find_wavenumber = 1
-      do while (wavenumber > this%wavenumber2(find_wavenumber) &
+      DO while (wavenumber > this%wavenumber2(find_wavenumber) &
            &    .and. find_wavenumber < this%nwav)
         find_wavenumber = find_wavenumber + 1
@@ -284,7 +284,7 @@
       end if
 
-      do jband = 1,this%nband
+      DO jband = 1,this%nband
         weight = 0.0_jprb
-        do jwav = 1,nwav
+        DO jwav = 1,nwav
           ! Work out wavenumber range for which this cloud wavenumber
           ! will be applicable
@@ -321,5 +321,5 @@
             ! Find interpolating points
             iwav = 2
-            do while (wavenumber(iwav) < this%wavenumber2_band(jband))
+            DO while (wavenumber(iwav) < this%wavenumber2_band(jband))
               iwav = iwav+1
             end do
@@ -358,5 +358,5 @@
       mapping = 0.0_jprb
       ! Loop over wavenumbers representing cloud
-      do jwav = 1,nwav
+      DO jwav = 1,nwav
         ! Clear the weights. The weight says for one wavenumber in the
         ! cloud file, what is its fractional contribution to each of
@@ -400,5 +400,5 @@
                  &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
             if (isd1-isd0 > 1) then
-              do isd = isd0+1,isd1-1
+              DO isd = isd0+1,isd1-1
                 ! Intermediate trapezia
                 weight(isd) = 0.5_jprb * (this%wavenumber1(isd)+this%wavenumber2(isd) &
@@ -447,5 +447,5 @@
                  &  / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
             if (isd2-isd1 > 1) then
-              do isd = isd1+1,isd2-1
+              DO isd = isd1+1,isd2-1
                 ! Intermediate trapezia
                 weight(isd) = weight(isd) + 0.5_jprb * (2.0_jprb*wavenum2 &
@@ -468,5 +468,5 @@
         weight = weight * planck_weight
 
-        do jg = 1,this%ng
+        DO jg = 1,this%ng
           mapping(jg, jwav) = sum(weight * this%gpoint_fraction(:,jg))
         end do
@@ -478,5 +478,5 @@
 
       ! Normalize mapping matrix
-      do jg = 1,this%ng
+      DO jg = 1,this%ng
         mapping(jg,:) = mapping(jg,:) * (1.0_jprb/sum(mapping(jg,:)))
       end do
@@ -589,5 +589,5 @@
     ! Check wavelength is monotonically increasing
     if (ninterval > 2) then
-      do jint = 2,ninterval-1
+      DO jint = 2,ninterval-1
         if (wavelength_bound(jint) <= wavelength_bound(jint-1)) then
           write(nulerr, '(a)') '*** Error: wavelength bounds must be monotonically increasing'
@@ -609,6 +609,6 @@
       end if
 
-      do jband = 1,this%nband
-        do jint = 1,ninterval
+      DO jband = 1,this%nband
+        DO jint = 1,ninterval
           if (jint == 1) then
             ! First input interval in wavelength space: lower
@@ -692,5 +692,5 @@
       
       ! All bounded intervals
-      do jint = 2,ninterval-1
+      DO jint = 2,ninterval-1
         wavenumber1_bound = 0.01_jprb / wavelength_bound(jint)
         wavenumber2_bound = 0.01_jprb / wavelength_bound(jint-1)
@@ -710,6 +710,6 @@
       end if
 
-      do jg = 1,this%ng
-        do jin = 1,ninput
+      DO jg = 1,this%ng
+        DO jin = 1,ninput
           mapping(jin,jg) = sum(this%gpoint_fraction(:,jg) * planck, &
                &                 mask=(i_input==jin))
@@ -723,7 +723,7 @@
 
       ! Loop through all intervals
-      do jint = 1,ninterval
+      DO jint = 1,ninterval
         ! Loop through the wavenumbers for gpoint_fraction
-        do jwav = 1,this%nwav
+        DO jwav = 1,this%nwav
           if (jint == 1) then
             ! First input interval in wavelength space: lower
@@ -758,5 +758,5 @@
       end do
       if (use_fluxes_local) then
-        do jg = 1,this%ng
+        DO jg = 1,this%ng
           mapping(:,jg) = mapping(:,jg) / sum(this%gpoint_fraction(:,jg) * planck)
         end do
@@ -769,5 +769,5 @@
     if (.not. use_fluxes_local) then
       ! Normalize mapping matrix
-      do jg = 1,size(mapping,dim=2)
+      DO jg = 1,size(mapping,dim=2)
         mapping(:,jg) = mapping(:,jg) * (1.0_jprb/sum(mapping(:,jg)))
       end do
@@ -828,5 +828,5 @@
     is_band_unassigned = .true.
 
-    do jint = 1,ninterval
+    DO jint = 1,ninterval
       inext = minloc(wavelength1, dim=1, mask=is_band_unassigned)
       if (jint > 1) then
@@ -873,8 +873,8 @@
       write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' bands (wavenumber ranges in cm-1)'
       if (nout <= 40) then
-        do jout = 1,nout
+        DO jout = 1,nout
           write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
                &                        nint(this%wavenumber2_band(jout)), ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -882,8 +882,8 @@
         end do
       else
-        do jout = 1,30
+        DO jout = 1,30
           write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(jout)), ' to', &
                &                        nint(this%wavenumber2_band(jout)), ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -893,5 +893,5 @@
         write(nulout,'(i6,a,i6,a)',advance='no') nint(this%wavenumber1_band(nout)), ' to', &
              &                        nint(this%wavenumber2_band(nout)), ':'
-        do jin = 1,nin
+        DO jin = 1,nin
           write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
         end do
@@ -901,7 +901,7 @@
       write(nulout, '(a,i0,a,i0,a)') '  Mapping from ', nin, ' values to ', nout, ' g-points'
       if (nout <= 40) then
-        do jout = 1,nout
+        DO jout = 1,nout
           write(nulout,'(i3,a)',advance='no') jout, ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -909,7 +909,7 @@
         end do
       else
-        do jout = 1,30
+        DO jout = 1,30
           write(nulout,'(i3,a)',advance='no') jout, ':'
-          do jin = 1,nin
+          DO jin = 1,nin
             write(nulout,'(f5.2)',advance='no') mapping(jin,jout)
           end do
@@ -918,5 +918,5 @@
         write(nulout,'(a)') '  ...'
         write(nulout,'(i3,a)',advance='no') nout, ':'
-        do jin = 1,nin
+        DO jin = 1,nin
           write(nulout,'(f5.2)',advance='no') mapping(jin,nout)
         end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_thermodynamics.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_thermodynamics.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_thermodynamics.F90	(revision 5158)
@@ -143,6 +143,6 @@
     end if
 
-    do jlev = 1,nlev
-       do jcol = istartcol,iendcol
+    DO jlev = 1,nlev
+       DO jcol = istartcol,iendcol
           pressure = 0.5 * (this%pressure_hl(jcol,jlev)+this%pressure_hl(jcol,jlev+1))
           temperature = 0.5 * (this%temperature_hl(jcol,jlev)+this%temperature_hl(jcol,jlev+1))
@@ -265,5 +265,5 @@
       ! be half the separation between the half-levels at the edge of
       ! the two adjacent layers
-      do jlev = 2,nlev-1
+      DO jlev = 2,nlev-1
         layer_separation(i1:i2,jlev) = (0.5_jprb * R_over_g) * temperature_hl(i1:i2,jlev+1) &
              &                    * log(pressure_hl(i1:i2,jlev+2)/pressure_hl(i1:i2,jlev))
@@ -276,5 +276,5 @@
       ! don't take the logarithm of the last pressure in each column.
 
-      do jlev = 1,nlev-2
+      DO jlev = 1,nlev-2
         layer_separation(i1:i2,jlev) = (0.5_jprb * R_over_g) * temperature_hl(i1:i2,jlev+1) &
              &                    * log(pressure_hl(i1:i2,jlev)/pressure_hl(i1:i2,jlev+2))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90	(revision 5158)
@@ -202,5 +202,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -211,5 +211,5 @@
       is_clear_sky_layer = .true.
       i_cloud_top = nlev+1
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -268,5 +268,5 @@
         ! Save the spectral fluxes if required
         if (config%do_save_spectral_flux) then
-          do jlev = 1,nlev+1
+          DO jlev = 1,nlev+1
             call indexed_sum(flux_up_clear(:,jlev), &
                  &           config%i_spec_from_reordered_g_lw, &
@@ -294,5 +294,5 @@
       end if
 
-      do jlev = i_cloud_top,nlev ! Start at cloud top and work down
+      DO jlev = i_cloud_top,nlev ! Start at cloud top and work down
 
         ! Copy over clear-sky properties
@@ -308,5 +308,5 @@
           source_dn(:,2:,jlev)     = 0.0_jprb
         else
-          do jreg = 2,nreg
+          DO jreg = 2,nreg
             ! Cloudy sky
             ! Add scaled cloud optical depth to clear-sky value
@@ -358,5 +358,5 @@
           end do
           ! Emission is scaled by the size of each region
-          do jreg = 1,nregions
+          DO jreg = 1,nregions
             source_up(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * source_up(:,jreg,jlev)
             source_dn(:,jreg,jlev) = region_fracs(jreg,jlev,jcol) * source_dn(:,jreg,jlev)
@@ -375,6 +375,6 @@
       ! Calculate the upwelling radiation emitted by the surface, and
       ! copy the surface albedo into total_albedo 
-      do jreg = 1,nregions
-        do jg = 1,ng
+      DO jreg = 1,nregions
+        DO jg = 1,ng
           ! region_fracs(jreg,nlev,jcol) is the fraction of each region in the
           ! lowest model level
@@ -387,5 +387,5 @@
       ! atmosphere and the total upwelling due to emission below each
       ! level below using the adding method
-      do jlev = nlev,i_cloud_top,-1
+      DO jlev = nlev,i_cloud_top,-1
 
         total_albedo_below        = 0.0_jprb
@@ -394,5 +394,5 @@
           total_albedo_below = 0.0_jprb
           total_source_below = 0.0_jprb
-          do jg = 1,ng
+          DO jg = 1,ng
             inv_denom(jg,1) = 1.0_jprb &
                  &  / (1.0_jprb - total_albedo(jg,1,jlev+1)*reflectance(jg,1,jlev))
@@ -428,6 +428,6 @@
           ! the operation we perform is essentially diag(total_albedo)
           ! = matmul(transpose(v_matrix), diag(total_albedo_below)).
-          do jreg = 1,nregions
-            do jreg2 = 1,nregions
+          DO jreg = 1,nregions
+            DO jreg2 = 1,nregions
               total_albedo(:,jreg,jlev) &
                    &  = total_albedo(:,jreg,jlev) &
@@ -445,5 +445,5 @@
       ! Section 6: Copy over downwelling fluxes above cloud top
       ! --------------------------------------------------------
-      do jlev = 1,i_cloud_top
+      DO jlev = 1,i_cloud_top
         if (config%do_clear) then
           ! Clear-sky fluxes have already been averaged: use these
@@ -476,5 +476,5 @@
              &           flux%lw_up_band(:,jcol,i_cloud_top))
       end if
-      do jlev = i_cloud_top-1,1,-1
+      DO jlev = i_cloud_top-1,1,-1
         flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev)
         flux%lw_up(jcol,jlev) = sum(flux_up(:,1))
@@ -494,13 +494,13 @@
       ! scattering layer, using overlap matrix to translate to the
       ! regions of the first layer of cloud
-      do jreg = 1,nregions
+      DO jreg = 1,nregions
         flux_dn(:,jreg)  = v_matrix(jreg,1,i_cloud_top,jcol)*flux_dn_clear(:,i_cloud_top)
       end do
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = i_cloud_top,nlev
+      DO jlev = i_cloud_top,nlev
 
         if (is_clear_sky_layer(jlev)) then
-          do jg = 1,ng
+          DO jg = 1,ng
             flux_dn(jg,1) = (transmittance(jg,1,jlev)*flux_dn(jg,1) &
                  &  + reflectance(jg,1,jlev)*total_source(jg,1,jlev+1) + source_dn(jg,1,jlev) ) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90	(revision 5158)
@@ -127,5 +127,5 @@
     ! entire clear-sky atmosphere at once
     real(jprb), dimension(config%n_g_sw, nlev) &
-    	 &  :: reflectance_clear, transmittance_clear, &
+         &  :: reflectance_clear, transmittance_clear, &
          &     ref_dir_clear, trans_dir_diff_clear, trans_dir_dir_clear
 
@@ -198,5 +198,5 @@
 
     ! Main loop over columns
-    do jcol = istartcol, iendcol
+    DO jcol = istartcol, iendcol
       ! --------------------------------------------------------
       ! Section 2: Prepare column-specific variables and arrays
@@ -251,5 +251,5 @@
       ! cloud%crop_cloud_fraction has already been called
       is_clear_sky_layer = .true.
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
           is_clear_sky_layer(jlev) = .false.
@@ -271,8 +271,8 @@
 
       ! Cloudy layers
-      do jlev = 1,nlev ! Start at top-of-atmosphere
+      DO jlev = 1,nlev ! Start at top-of-atmosphere
         if (.not. is_clear_sky_layer(jlev)) then
-          do jreg = 2,nregions
-            do jg = 1,ng
+          DO jreg = 2,nregions
+            DO jg = 1,ng
               ! Mapping from g-point to band
               iband = config%i_band_from_reordered_g_sw(jg)
@@ -315,5 +315,5 @@
 
       ! Copy surface albedos in clear-sky region
-      do jg = 1,ng
+      DO jg = 1,ng
         total_albedo(jg,1,nlev+1) = albedo_diffuse(jg,jcol)
         total_albedo_direct(jg,1,nlev+1) &
@@ -324,5 +324,5 @@
       ! underneath
       if (.not. is_clear_sky_layer(nlev)) then
-        do jreg = 2,nregions
+        DO jreg = 2,nregions
           total_albedo(:,jreg,nlev+1)        = total_albedo(:,1,nlev+1)
           total_albedo_direct(:,jreg,nlev+1) = total_albedo_direct(:,1,nlev+1)
@@ -337,5 +337,5 @@
       ! Work up from the surface computing the total albedo of the
       ! atmosphere below that point using the adding method
-      do jlev = nlev,1,-1
+      DO jlev = nlev,1,-1
 
         total_albedo_below        = 0.0_jprb
@@ -346,5 +346,5 @@
           ! "below" quantities since with no cloud overlap to worry
           ! about, these are the same
-          do jg = 1,ng
+          DO jg = 1,ng
             inv_denom(jg,1) = 1.0_jprb &
                  &  / (1.0_jprb - total_albedo_clear(jg,jlev+1)*reflectance_clear(jg,jlev))
@@ -361,5 +361,5 @@
 
         ! All-sky fluxes: first the clear region
-        do jg = 1,ng
+        DO jg = 1,ng
           inv_denom(jg,1) = 1.0_jprb &
                &  / (1.0_jprb - total_albedo(jg,1,jlev+1)*reflectance_clear(jg,jlev))
@@ -375,6 +375,6 @@
         ! Then the cloudy regions if any cloud is present in this layer
         if (.not. is_clear_sky_layer(jlev)) then
-          do jreg = 2,nregions
-            do jg = 1,ng
+          DO jreg = 2,nregions
+            DO jg = 1,ng
               inv_denom(jg,jreg) = 1.0_jprb / (1.0_jprb &
                    &  - total_albedo(jg,jreg,jlev+1)*reflectance(jg,jreg,jlev))
@@ -400,6 +400,6 @@
           ! the operation we perform is essentially diag(total_albedo)
           ! = matmul(transpose(v_matrix)), diag(total_albedo_below)).
-          do jreg = 1,nregions
-            do jreg2 = 1,nregions
+          DO jreg = 1,nregions
+            DO jreg2 = 1,nregions
               total_albedo(:,jreg,jlev) &
                    &  = total_albedo(:,jreg,jlev) &
@@ -426,5 +426,5 @@
       ! Direct downwelling flux (into a plane perpendicular to the
       ! sun) entering the top of each region in the top-most layer
-      do jreg = 1,nregions
+      DO jreg = 1,nregions
         direct_dn(:,jreg) = incoming_sw(:,jcol)*region_fracs(jreg,1,jcol)
       end do
@@ -495,7 +495,7 @@
 
       ! Final loop back down through the atmosphere to compute fluxes
-      do jlev = 1,nlev
+      DO jlev = 1,nlev
         if (config%do_clear) then
-          do jg = 1,ng
+          DO jg = 1,ng
             flux_dn_clear(jg) = (transmittance_clear(jg,jlev)*flux_dn_clear(jg) + direct_dn_clear(jg) &
                &  * (trans_dir_dir_clear(jg,jlev)*total_albedo_clear_direct(jg,jlev+1)*reflectance_clear(jg,jlev) &
@@ -509,5 +509,5 @@
 
         ! All-sky fluxes: first the clear region...
-        do jg = 1,ng
+        DO jg = 1,ng
           flux_dn(jg,1) = (transmittance_clear(jg,jlev)*flux_dn(jg,1) + direct_dn(jg,1) &
                &  * (trans_dir_dir_clear(jg,jlev)*total_albedo_direct(jg,1,jlev+1)*reflectance_clear(jg,jlev) &
@@ -525,6 +525,6 @@
           direct_dn(:,2:nregions)= 0.0_jprb
         else
-          do jreg = 2,nregions
-            do jg = 1,ng
+          DO jreg = 2,nregions
+            DO jg = 1,ng
               flux_dn(jg,jreg) = (transmittance(jg,jreg,jlev)*flux_dn(jg,jreg) + direct_dn(jg,jreg) &
                    &  * (trans_dir_dir(jg,jreg,jlev)*total_albedo_direct(jg,jreg,jlev+1)*reflectance(jg,jreg,jlev) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_two_stream.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_two_stream.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_two_stream.F90	(revision 5158)
@@ -72,5 +72,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       ! Fu et al. (1997), Eq 2.9 and 2.10:
       !      gamma1(jg) = LwDiffusivity * (1.0_jprb - 0.5_jprb*ssa(jg) &
@@ -122,5 +122,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       !      gamma1(jg) = 2.0_jprb  - ssa(jg) * (1.25_jprb + 0.75_jprb*g(jg))
       !      gamma2(jg) = 0.75_jprb *(ssa(jg) * (1.0_jprb - g(jg)))
@@ -195,5 +195,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       if (od(jg) > 1.0e-3_jprd) then
         k_exponent = sqrt(max((gamma1(jg) - gamma2(jg)) * (gamma1(jg) + gamma2(jg)), &
@@ -291,5 +291,5 @@
 #endif
 
-    do jg = 1, ng
+    DO jg = 1, ng
       factor = (LwDiffusivityWP * 0.5_jprb) * ssa(jg)
       gamma1 = LwDiffusivityWP - factor*(1.0_jprb + asymmetry(jg))
@@ -379,5 +379,5 @@
 #endif
 
-    do jg = 1, ng
+    DO jg = 1, ng
       ! Compute upward and downward emission assuming the Planck
       ! function to vary linearly with optical depth within the layer
@@ -474,5 +474,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
 
         gamma4 = 1.0_jprd - gamma3(jg)
@@ -624,5 +624,5 @@
     trans_dir_dir = exp(trans_dir_dir)
 
-    do jg = 1, ng
+    DO jg = 1, ng
 
       ! Zdunkowski "PIFM" (Zdunkowski et al., 1980; Contributions to
@@ -652,5 +652,5 @@
     exponential = exp(-k_exponent*od)
 
-    do jg = 1, ng
+    DO jg = 1, ng
       k_mu0 = k_exponent(jg)*mu0
       one_minus_kmu0_sqr = 1.0_jprb - k_mu0*k_mu0
@@ -698,5 +698,5 @@
 #else
     ! GPU-capable and vector-optimized version for ICON
-    do jg = 1, ng
+    DO jg = 1, ng
 
       trans_dir_dir(jg) = max(-max(od(jg) * (1.0_jprb/mu0),0.0_jprb),-1000.0_jprb)
@@ -810,5 +810,5 @@
 ! Added for DWD (2020)
 !NEC$ shortloop
-    do jg = 1, ng
+    DO jg = 1, ng
       ! Note that if the minimum value is reduced (e.g. to 1.0e-24)
       ! then noise starts to appear as a function of solar zenith
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/easy_netcdf.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/easy_netcdf.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/easy_netcdf.F90	(revision 5158)
@@ -392,5 +392,5 @@
 
     ndimlens(:) = 0
-    do j = 1,ndims
+    DO j = 1,ndims
       istatus = nf90_inquire_dimension(this%ncid, idimids(j), len=ndimlens(j))
       if (istatus /= NF90_NOERR) then
@@ -404,5 +404,5 @@
     if (present(ntotal)) then
       ntotal = 1
-      do j = 1, ndims
+      DO j = 1, ndims
         ntotal = ntotal * ndimlens(j)
       end do
@@ -613,5 +613,5 @@
     ! Compute number of elements of the variable in the file
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
     end do
@@ -658,5 +658,5 @@
     ! Compute number of elements of the variable in the file
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
     end do
@@ -707,5 +707,5 @@
     ! i.e. excluding the slowest varying dimension, indexed by "index"
     ntotal = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       ntotal = ntotal * ndimlens(j)
     end do
@@ -761,5 +761,5 @@
     ! Ensure variable has only one dimension in the file
     n = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -819,5 +819,5 @@
     ! Ensure variable has only one dimension in the file
     n = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -878,5 +878,5 @@
     ! Ensure variable has only one dimension in the file
     n = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -938,5 +938,5 @@
     ! Ensure variable has only one dimension aside from the last one
     n = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       n = n * ndimlens(j)
       if (j > 1 .and. ndimlens(j) > 1) then
@@ -1021,5 +1021,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 2 .and. ndimlens(j) > 1) then
@@ -1133,5 +1133,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 2 .and. ndimlens(j) > 1) then
@@ -1202,5 +1202,5 @@
       vcount(1:2) = [ndimlen1,1]
       
-      do j = 1,ndimlen2
+      DO j = 1,ndimlen2
         vstart(2) = j
         istatus = nf90_get_var(this%ncid, ivarid, matrix(:,j), start=vstart, count=vcount)
@@ -1252,5 +1252,5 @@
     ! dimensions aside from the last one
     ntotal = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       ntotal = ntotal * ndimlens(j)
       if (j > 2 .and. ndimlens(j) > 1) then
@@ -1376,5 +1376,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 3 .and. ndimlens(j) > 1) then
@@ -1512,5 +1512,5 @@
     ! dimensions aside from the last one
     ntotal = 1
-    do j = 1, ndims-1
+    DO j = 1, ndims-1
       ntotal = ntotal * ndimlens(j)
       if (j > 3 .and. ndimlens(j) > 1) then
@@ -1654,5 +1654,5 @@
     ! dimensions
     ntotal = 1
-    do j = 1, ndims
+    DO j = 1, ndims
       ntotal = ntotal * ndimlens(j)
       if (j > 4 .and. ndimlens(j) > 1) then
@@ -1804,5 +1804,5 @@
 
     ! Pad with blanks since nf90_get_att does not do this
-    do j = i_attr_len+1,len(attr_str)
+    DO j = i_attr_len+1,len(attr_str)
       attr_str(j:j) = ' '
     end do
@@ -1878,5 +1878,5 @@
 
     ! Pad with blanks since nf90_get_att does not do this
-    do j = i_attr_len+1,len(attr_str)
+    DO j = i_attr_len+1,len(attr_str)
       attr_str(j:j) = ' '
     end do
@@ -2705,5 +2705,5 @@
     end if
 
-    do jdim = 1,ndims
+    DO jdim = 1,ndims
       istatus = nf90_inquire_dimension(infile%ncid, idimids(jdim), &
            &  name=dimname, len=dimlen)
@@ -2771,5 +2771,5 @@
 
     ! Map dimension IDs
-    do jdim = 1,ndims
+    DO jdim = 1,ndims
       istatus = nf90_inquire_dimension(infile%ncid, idimids_in(jdim), name=dim_name)
       if (istatus /= NF90_NOERR) then
@@ -2801,5 +2801,5 @@
 
     ! Copy attributes
-    do jattr = 1,nattr
+    DO jattr = 1,nattr
       istatus = nf90_inq_attname(infile%ncid, ivarid_in, jattr, attr_name)
       if (istatus /= NF90_NOERR) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/print_matrix.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/print_matrix.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/print_matrix.F90	(revision 5158)
@@ -16,5 +16,5 @@
       write(unit_local,'(a,a,$)') name, '=['
     end if
-    do i = 1,size(vec,1)
+    DO i = 1,size(vec,1)
        write(unit_local,'(f16.8,$)') vec(i)
     end do
@@ -43,6 +43,6 @@
       write(unit_local,'(a,a,$)') name, '=['
     end if
-    do i = 1,size(mat,1)
-       do j = 1,size(mat,2)
+    DO i = 1,size(mat,1)
+       DO j = 1,size(mat,2)
           write(unit_local,'(f16.8,$)') mat(i,j)
        end do
@@ -61,7 +61,7 @@
     integer    :: i, j, k
     write(6,'(a,a)') name, '='
-    do k = 1,size(mat,3)
-      do i = 1,size(mat,1)
-        do j = 1,size(mat,2)
+    DO k = 1,size(mat,3)
+      DO i = 1,size(mat,1)
+        DO j = 1,size(mat,2)
              write(6,'(f16.8,$)') mat(i,j,k)
           end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90	(revision 5158)
@@ -179,5 +179,5 @@
     fluxt(:, klev + 1) = 0.
 
-    do k = klev, 1, -1
+    DO k = klev, 1, -1
       fluxu(:, k) = fluxu(:, k + 1) + masse(:, k) * d_u(:, k)
       fluxv(:, k) = fluxv(:, k + 1) + masse(:, k) * d_v(:, k)
@@ -189,5 +189,5 @@
     dddt(:, 1) = (exner(:, 1) - 1.) * fluxt(:, 1)
 
-    do k = 2, klev
+    DO k = 2, klev
       dddu(:, k) = (zu(:, k) - zu(:, k - 1)) * fluxu(:, k)
       dddv(:, k) = (zv(:, k) - zv(:, k - 1)) * fluxv(:, k)
@@ -198,5 +198,5 @@
     dddt(:, klev + 1) = 0.
 
-    do k = 1, klev
+    DO k = 1, klev
       d_t_ech(:, k) = -(rcpd * (dddt(:, k) + dddt(:, k + 1))) / (2. * rcpd * masse(:, k))
       d_t_ec(:, k) = -(dddu(:, k) + dddu(:, k + 1) + dddv(:, k) + dddv(:, k + 1)) / (2. * rcpd * masse(:, k)) + d_t_ech(:, k)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/freinage.F90	(revision 5158)
@@ -83,9 +83,9 @@
   !!       PRINT*, " calcul de drag_pro FC "
 
-  do k = 1, klev
+  DO k = 1, klev
 
-    do jv = 2, nvm_lmdz   !   (on peut faire 9 ?)
+    DO jv = 2, nvm_lmdz   !   (on peut faire 9 ?)
 
-      do i = 1, knon
+      DO i = 1, knon
 
         sumveg(i, k) = sumveg(i, k) + veget(i, jv)
@@ -113,5 +113,5 @@
     enddo
   enddo
-  do k = 1, klev
+  DO k = 1, klev
     where (sumveg(1:knon, k) > 0.05)
       !        drag_pro(1:knon,k)=Cd_frein*drag_pro(1:knon,k)/sumveg(1:knon,k)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/hines_gwd.F90	(revision 5158)
@@ -479,5 +479,5 @@
   ! * RMSWIND   = root mean square gravity wave wind at lowest level (m/s).
   ! * K_ALPHA    = horizontal wavenumber of each azimuth (1/m).
-  ! * IORDER	   = 1 means vertical levels are indexed from top down
+  ! * IORDER       = 1 means vertical levels are indexed from top down
   ! *              (i.e., highest level indexed 1 and lowest level NLEVS);
   ! *           .NE. 1 highest level is index NLEVS.
@@ -1860,5 +1860,5 @@
   ! * ALT     = altitudes.
   ! * ALT_EXP = altitude above which exponential decay applied.
-  ! * IORDER	= 1 means vertical levels are indexed from top down
+  ! * IORDER    = 1 means vertical levels are indexed from top down
   ! *           (i.e., highest level indexed 1 and lowest level NLEVS);
   ! *           .NE. 1 highest level is index NLEVS.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ice_sursat_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ice_sursat_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ice_sursat_mod.F90	(revision 5158)
@@ -110,5 +110,5 @@
 
     !--------------------------------------------------------
-    !	... Local variables
+    !    ... Local variables
     !--------------------------------------------------------
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ini_COSP.h
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ini_COSP.h	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ini_COSP.h	(revision 5158)
@@ -14,5 +14,5 @@
 !   COMMON/iniCOSP/                                                 &
 !            zx_rhcosp0(klon,klev),ref_liq_cosp0(klon,klev), ref_ice_cosp0(klon,klev), &
-!	    zx_rh_cosp0(klon,klev), cldfra_cosp0(klon,klev), rnebcon_cosp0(klon,klev), &
+!        zx_rh_cosp0(klon,klev), cldfra_cosp0(klon,klev), rnebcon_cosp0(klon,klev), &
 !            fiwc_cosp0(klon,klev), flwc_cosp0(klon,klev), prfl_cosp0(klon,klev), &
 !            psfl_cosp0(klon,klev), pmflxr_cosp0(klon,klev), pmflxs_cosp0(klon,klev), &
@@ -20,5 +20,5 @@
 !            pctsrf_cosp0(klon),zu10m_cosp0(klon),zv10m_cosp0(klon), &
 !            zxtsol_cosp0(klon),JrNt_cosp0(klon)
-!	save /iniCOSP/
+!    save /iniCOSP/
 !!$OMP THREADPRIVATE(/iniCOSP/)
-	
+
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/initphysto.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/initphysto.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/initphysto.F90	(revision 5158)
@@ -73,5 +73,5 @@
        nhoriid, fileid)
 
-!$OMP MASTER	
+!$OMP MASTER
 !  Appel a histvert pour la grille verticale
 
@@ -201,4 +201,4 @@
   IF (ok_sync) CALL histsync
 !$OMP END MASTER
-	
+
 END SUBROUTINE initphysto
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/lmdz_sisvat_weq.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/lmdz_sisvat_weq.f90	(revision 5158)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/lmdz_sisvat_weq.f90	(revision 5158)
@@ -0,0 +1,77 @@
+MODULE lmdz_sisvat_weq
+  IMPLICIT NONE; PRIVATE
+  PUBLIC sisvat_weq
+
+  LOGICAL :: logWEq
+
+CONTAINS
+
+  SUBROUTINE SISVAT_wEq(labWEq, istart)
+
+    ! +------------------------------------------------------------------------+
+    ! | MAR          SISVAT_wEq                                22-09-2001  MAR |
+    ! |   SubRoutine SISVAT_wEq computes the Snow/Ice  Water  Equivalent       |
+    ! |                                                                        |
+    ! |                                                                        |
+    ! |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
+    ! |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
+    ! |   FILE                 |      CONTENT                                  |
+    ! |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
+    ! | # SISVAT_wEq.ve        | #ve: OUTPUT/Verification: Snow/Ice Water Eqv. |
+    ! |                        |      unit 45, SubRoutine  SISVAT_wEq **ONLY** |
+    ! +------------------------------------------------------------------------+
+
+    ! +--Global Variables
+    ! +  ================
+    USE VARphy
+    USE VAR_SV
+    USE VARxSV
+
+    IMPLICIT NONE
+
+    CHARACTER(LEN = 6) :: labWEq
+    INTEGER :: istart
+
+    ! +--Local  Variables
+    ! +  ================
+
+    INTEGER :: ikl, isn
+    REAL :: SnoWEQ, IceWEQ
+
+
+    ! +--Switch Initialization
+    ! +  =====================
+
+    IF (.NOT.logWEq)                                              THEN
+      logWEq = .TRUE.
+      open(unit = 45, status = 'unknown', file = 'SISVAT_wEq.ve')
+      rewind    45
+    END IF
+
+
+    ! +--Snow Water Equivalent
+    ! +  =====================
+
+    ikl = 1
+    IF          (isnoSV(ikl)>iiceSV(ikl))                      THEN
+      SnoWEQ = 0.
+      DO isn = iiceSV(ikl) + 1, isnoSV(ikl)
+        SnoWEQ = SnoWEQ + ro__SV(ikl, isn) * dzsnSV(ikl, isn)
+      END DO
+
+    END IF
+
+
+    ! +--Ice  Water Equivalent
+    ! +  =====================
+    IF        (iiceSV(1)>0)                                    THEN
+      IceWEQ = 0.
+      DO isn = 1, iiceSV(ikl)
+        IceWEQ = IceWEQ + ro__SV(ikl, isn) * dzsnSV(ikl, isn)
+      END DO
+
+    END IF
+
+  END SUBROUTINE sisvat_weq
+
+END MODULE lmdz_sisvat_weq
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/sisvat_weq.f90	(revision 5157)
+++ 	(revision )
@@ -1,104 +1,0 @@
-
-
-SUBROUTINE SISVAT_wEq( labWEq ,istart)
-
-  ! +------------------------------------------------------------------------+
-  ! | MAR          SISVAT_wEq                                22-09-2001  MAR |
-  ! |   SubRoutine SISVAT_wEq computes the Snow/Ice  Water  Equivalent       |
-  ! |                                                                        |
-  ! |                                                                        |
-  ! |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
-  ! |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
-  ! |   FILE                 |      CONTENT                                  |
-  ! |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
-  ! | # SISVAT_wEq.ve        | #ve: OUTPUT/Verification: Snow/Ice Water Eqv. |
-  ! |                        |      unit 45, SubRoutine  SISVAT_wEq **ONLY** |
-  ! +------------------------------------------------------------------------+
-
-
-
-
-  ! +--Global Variables
-  ! +  ================
-
-  USE VARphy
-  USE VAR_SV
-  USE VARxSV
-
-  IMPLICIT NONE
-
-
-
-  CHARACTER(LEN=6) :: labWEq
-  INTEGER :: istart
-
-  LOGICAL :: logWEq
-  common/SISVAT_wEq_L/logWEq
-
-
-  ! +--Local  Variables
-  ! +  ================
-
-  INTEGER :: ikl   ,isn
-  REAL :: SnoWEQ,IceWEQ
-
-
-  ! +--Switch Initialization
-  ! +  =====================
-
-  IF (.NOT.logWEq)                                              THEN
-           logWEq = .TRUE.
-           open(unit=45,status='unknown',file='SISVAT_wEq.ve')
-           rewind    45
-  END IF
-
-
-  ! +--Snow Water Equivalent
-  ! +  =====================
-
-       ikl   = 1
-  IF          (isnoSV(ikl)>iiceSV(ikl))                      THEN
-
-      SnoWEQ = 0.
-    DO isn   = iiceSV(ikl)+1 ,isnoSV(ikl)
-      SnoWEQ = SnoWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
-    END DO
-
-  END IF
-
-
-  ! +--Ice  Water Equivalent
-  ! +  =====================
-
-  IF        (iiceSV(1)>0)                                    THEN
-
-      IceWEQ = 0.
-    DO isn   =             1 ,iiceSV(ikl)
-      IceWEQ = IceWEQ       + ro__SV(ikl,isn) * dzsnSV(ikl,isn)
-    END DO
-
-  END IF
-
-
-  ! +--OUTPUT
-  ! +  ======
-
-  !!      IF (istart.EQ.1)                                              THEN
-  !!        WRITE(45,45)dahost,i___SV(lwriSV(1)),j___SV(lwriSV(1)),
-  !!     .              n___SV(lwriSV(1))
-  !! 45     format(a18,10('-'),'Pt.',3i4,60('-'))
-  !!      END IF
-
-  !!      WRITE(45,450) labWEq,IceWEQ,iiceSV(ikl),SnoWEQ
-  !!     .                    ,IceWEQ+SnoWEQ,isnoSV(ikl)
-  !!     .                                  ,drr_SV(ikl)*dt__SV
-  !!     .                                  ,dsn_SV(ikl)*dt__SV
-  !!     .                                  ,BufsSV(ikl)
-  !! 450  format(a6,3x,'  I+S =',f11.4,'(',i2,') +',f11.4,' =',
-  !!     .                       f11.4,'(',i2,')',
-  !!     .             '  drr =', f7.4,
-  !!     .             '  dsn =', f7.4,
-  !!     .             '  Buf =', f7.4)
-
-
-END SUBROUTINE sisvat_weq
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90	(revision 5158)
@@ -362,5 +362,5 @@
             ! loop on grid cells
             DO ikl = 1, knon
-            	lati=rlat(ikl2i(ikl))
+                lati=rlat(ikl2i(ikl))
                 ! approximations for mean_temp and mean_dens
                 ! from Feulner et al., 2013 (DOI: 10.1175/JCLI-D-12-00636.1)
@@ -433,5 +433,5 @@
                 ! depth : depth of each layer
                 depth = snow_depth
-                do isl = 1, nb_snow_layer
+                DO isl = 1, nb_snow_layer
                     ! dzsnSV : snow layer thickness
                     dzsnSV(ikl, isl) = max(0.01, snow_depth * dz_profil_15(nb_snow_layer - isl + 1))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90	(revision 5158)
@@ -231,13 +231,13 @@
 
   ijl = 0
-  do l = 1, lllm
+  DO l = 1, lllm
     ! Pole nord
     ijl = ijl + 1
-    do i = 1, imax
+    DO i = 1, imax
       zx(i, 1, l) = px(ijl)
     enddo
     ! Grille normale
-    do j = 2, jmax - 1
-      do i = 1, imax
+    DO j = 2, jmax - 1
+      DO i = 1, imax
         ijl = ijl + 1
         zx(i, j, l) = px(ijl)
@@ -247,5 +247,5 @@
     IF (jmax > 1) THEN
       ijl = ijl + 1
-      do i = 1, imax
+      DO i = 1, imax
         zx(i, jmax, l) = px(ijl)
       enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_alpale.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_alpale.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_alpale.f90	(revision 5158)
@@ -91,5 +91,5 @@
     ! le modele convectif
 
-    do i = 1, klon
+    DO i = 1, klon
       ALE(i) = 0.
       ALP(i) = 0.
@@ -99,10 +99,10 @@
     IF (iflag_wake>=1) THEN
       IF (itap <= it_wape_prescr) THEN
-        do i = 1, klon
+        DO i = 1, klon
           ale_wake(i) = wape_prescr
           alp_wake(i) = fip_prescr
         enddo
       else
-        do i = 1, klon
+        DO i = 1, klon
           !jyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
           !cc           ale_wake(i) = 0.5*wake_cstar(i)**2
@@ -112,5 +112,5 @@
       endif
     else
-      do i = 1, klon
+      DO i = 1, klon
         ale_wake(i) = 0.
         alp_wake(i) = 0.
@@ -122,5 +122,5 @@
       IF (debut.AND.prt_level>9) &
               WRITE(lunout, *)'ALE et ALP imposes'
-      do i = 1, klon
+      DO i = 1, klon
         !on ne couple que ale
         !           ALE(i) = max(ale_wake(i),Ale_bl(i))
@@ -148,6 +148,6 @@
       IF (1==0) THEN
         www(1:klon) = 0.
-        do k = 2, klev - 1
-          do i = 1, klon
+        DO k = 2, klev - 1
+          DO i = 1, klon
             www(i) = max(www(i), -omega(i, k) * RD * t_seri(i, k) &
                     / (RG * paprs(i, k)) * zw2(i, k) * zw2(i, k))
@@ -159,10 +159,10 @@
           enddo
         enddo
-        do i = 1, klon
+        DO i = 1, klon
           IF (www(i)>0. .AND. ale_bl(i)>0.) www(i) = www(i) / ale_bl(i)
         enddo
       ENDIF
 
-      do i = 1, klon
+      DO i = 1, klon
         ALE(i) = max(ale_wake(i), Ale_bl(i))
         !cc nrlmd le 10/04/2012----------Stochastic triggering------------
@@ -196,5 +196,5 @@
 
     endif
-    do i = 1, klon
+    DO i = 1, klon
       IF (alp(i)>alp_max) THEN
         IF(prt_level>9)WRITE(lunout, *)                             &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_blowing_snow_sublim_sedim.F90	(revision 5158)
@@ -51,9 +51,9 @@
 
 INTEGER                                  :: k,i,n
-real                                     :: cpd, cpw, dqbsub, maxdqbsub, dqbmelt, zmair
-real                                     :: dqsedim,precbs, dqvmelt, zmelt, taumeltbs
-real                                     :: maxdqvmelt, rhoair, dz, dqbsedim
-real                                     :: delta_p, b_p, a_p, c_p, c_sub, qvsub
-real                                     :: p0, T0, Dv, Aprime, Bprime, Ka
+REAL                                     :: cpd, cpw, dqbsub, maxdqbsub, dqbmelt, zmair
+REAL                                     :: dqsedim,precbs, dqvmelt, zmelt, taumeltbs
+REAL                                     :: maxdqvmelt, rhoair, dz, dqbsedim
+REAL                                     :: delta_p, b_p, a_p, c_p, c_sub, qvsub
+REAL                                     :: p0, T0, Dv, Aprime, Bprime, Ka
 REAL, DIMENSION(ngrid)                   :: ztemp,zqv,zqb,zpres,qsi,dqsi,qsl,dqsl,qzero,sedim
 REAL, DIMENSION(ngrid)                   :: zpaprsup, zpaprsdn, ztemp_up, zqb_up, zvelo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_call_atke.F90	(revision 5158)
@@ -71,5 +71,5 @@
    !! has to be adapted when solving the TKE with a prognostic equation
 
-   do i=1,ngrid
+   DO i=1,ngrid
       wind1(i)=sqrt(wind_u(i,1)**2+wind_v(i,1)**2)
    enddo
@@ -130,5 +130,5 @@
 ! "big K" calculation
 DO  k=2,nlay-1
-   do i=1,ngrid
+   DO i=1,ngrid
       rho=pinterf(i,k)/rd/(0.5*(temp(i,k-1)+temp(i,k)))
       K_big(i,k)=rg*K_in(i,k)/(play(i,k)-play(i,k+1))*(rho**2)
@@ -145,5 +145,5 @@
 ! x_predict calculation for 2<=k<=nlay-1
 DO  k=2,nlay-1
-   do i=1,ngrid
+   DO i=1,ngrid
       ml=(pinterf(i,k)-pinterf(i,k+1))/rg
       x_predict(i,k)=x_in(i,k)-dtime/ml*(-K_big(i,k+1)*x_in(i,k+1) &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cloudth.F90	(revision 5158)
@@ -111,5 +111,5 @@
     ! Calcul de la fraction du thermique et des ?cart-types des distributions
     !-------------------------------------------------------------------------------
-    do ind1 = 1, ngrid
+    DO ind1 = 1, ngrid
 
       IF ((ztv(ind1, 1)>ztv(ind1, 2)).AND.(fraca(ind1, ind2)>1.e-10)) THEN
@@ -324,5 +324,5 @@
     ! Calcul de la fraction du thermique et des ?cart-types des distributions
     !-------------------------------------------------------------------------------
-    do ind1 = 1, ngrid
+    DO ind1 = 1, ngrid
 
       IF ((ztv(ind1, 1)>ztv(ind1, 2)).AND.(fraca(ind1, ind2)>1.e-10)) THEN
@@ -648,5 +648,5 @@
     ! Cloud fraction in the thermals and standard deviation of the PDFs
     !-------------------------------------------------------------------------------
-    do ind1 = 1, ngrid
+    DO ind1 = 1, ngrid
 
       IF ((ztv(ind1, 1)>ztv(ind1, 2)).AND.(fraca(ind1, ind2)>1.e-10)) THEN
@@ -873,5 +873,5 @@
     ! Calcul de la fraction du thermique et des ecart-types des distributions
     !-------------------------------------------------------------------------------
-    do ind1 = 1, ngrid
+    DO ind1 = 1, ngrid
 
       IF ((ztv(ind1, 1)>ztv(ind1, 2)).AND.(fraca(ind1, ind2)>1.e-10)) then !Thermal and environnement
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_concvl.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_concvl.F90	(revision 5158)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_concvl.F90	(revision 5158)
@@ -0,0 +1,583 @@
+SUBROUTINE concvl(iflag_clos, &
+        dtime, paprs, pplay, k_upper_cv, &
+        t, q, t_wake, q_wake, s_wake, u, v, tra, ntra, &
+        Ale, Alp, sig1, w01, &
+        d_t, d_q, d_qcomp, d_u, d_v, d_tra, &
+        rain, snow, kbas, ktop, sigd, &
+        cbmf, plcl, plfc, wbeff, convoccur, &
+        upwd, dnwd, dnwdbis, &
+        Ma, mip, Vprecip, &
+        cape, cin, tvp, Tconv, iflag, &
+        pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, &
+        qcondc, wd, pmflxr, pmflxs, &
+        !RomP >>>
+        !!     .             da,phi,mp,dd_t,dd_q,lalim_conv,wght_th)
+        da, phi, mp, phii, d1a, dam, sij, qta, clw, elij, &! RomP
+        dd_t, dd_q, lalim_conv, wght_th, &                 ! RomP
+        evap, ep, epmlmMm, eplaMm, &                       ! RomP
+        wdtrainA, wdtrainS, wdtrainM, wght, qtc, sigt, detrain, &
+        tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
+        !RomP <<<
+        epmax_diag) ! epmax_cape
+  ! **************************************************************
+  ! *
+  ! CONCVL                                                      *
+  ! *
+  ! *
+  ! written by   : Sandrine Bony-Lena, 17/05/2003, 11.16.04    *
+  ! modified by :                                               *
+  ! **************************************************************
+
+  USE dimphy
+  USE infotrac_phy, ONLY: nbtr
+  USE phys_local_var_mod, ONLY: omega
+  USE lmdz_print_control, ONLY: prt_level, lunout
+  USE lmdz_clesphys
+  USE lmdz_conema3
+  USE lmdz_yoethf
+  USE lmdz_yomcst
+  USE lmdz_yomcst2
+  USE lmdz_cv3_inip, ONLY: cv3_inip
+
+  IMPLICIT NONE
+ INCLUDE "FCTTRE.h"
+  ! ======================================================================
+  ! Auteur(s): S. Bony-Lena (LMD/CNRS) date: ???
+  ! Objet: schema de convection de Emanuel (1991) interface
+  ! ======================================================================
+  ! Arguments:
+  ! dtime--input-R-pas d'integration (s)
+  ! s-------input-R-la vAleur "s" pour chaque couche
+  ! sigs----input-R-la vAleur "sigma" de chaque couche
+  ! sig-----input-R-la vAleur de "sigma" pour chaque niveau
+  ! psolpa--input-R-la pression au sol (en Pa)
+  ! pskapa--input-R-exponentiel kappa de psolpa
+  ! h-------input-R-enthAlpie potentielle (Cp*T/P**kappa)
+  ! q-------input-R-vapeur d'eau (en kg/kg)
+
+  ! work*: input et output: deux variables de travail,
+  ! on peut les mettre a 0 au debut
+  ! ALE--------input-R-energie disponible pour soulevement
+  ! ALP--------input-R-puissance disponible pour soulevement
+
+  ! d_h--------output-R-increment de l'enthAlpie potentielle (h)
+  ! d_q--------output-R-increment de la vapeur d'eau
+  ! rain-------output-R-la pluie (mm/s)
+  ! snow-------output-R-la neige (mm/s)
+  ! upwd-------output-R-saturated updraft mass flux (kg/m**2/s)
+  ! dnwd-------output-R-saturated downdraft mass flux (kg/m**2/s)
+  ! dnwd0------output-R-unsaturated downdraft mass flux (kg/m**2/s)
+  ! Ma---------output-R-adiabatic ascent mass flux (kg/m2/s)
+  ! mip--------output-R-mass flux shed by adiabatic ascent (kg/m2/s)
+  ! Vprecip----output-R-vertical profile of total precipitation (kg/m2/s)
+  ! Tconv------output-R-environment temperature seen by convective scheme (K)
+  ! Cape-------output-R-CAPE (J/kg)
+  ! Cin -------output-R-CIN  (J/kg)
+  ! Tvp--------output-R-Temperature virtuelle d'une parcelle soulevee
+  ! adiabatiquement a partir du niveau 1 (K)
+  ! deltapb----output-R-distance entre LCL et base de la colonne (<0 ; Pa)
+  ! Ice_flag---input-L-TRUE->prise en compte de la thermodynamique de la glace
+  ! dd_t-------output-R-increment de la temperature du aux descentes precipitantes
+  ! dd_q-------output-R-increment de la vapeur d'eau du aux desc precip
+  ! lalim_conv-
+  ! wght_th----
+  ! evap-------output-R
+  ! ep---------output-R
+  ! epmlmMm----output-R
+  ! eplaMm-----output-R
+  ! wdtrainA---output-R
+  ! wdtrainS---output-R
+  ! wdtrainM---output-R
+  ! wght-------output-R
+  ! ======================================================================
+
+  INTEGER, INTENT(IN) :: iflag_clos
+  REAL, INTENT(IN) :: dtime
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay
+  REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
+  INTEGER, INTENT(IN) :: k_upper_cv
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: t, q, u, v
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: t_wake, q_wake
+  REAL, DIMENSION(klon), INTENT(IN) :: s_wake
+  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tra
+  INTEGER, INTENT(IN) :: ntra
+  REAL, DIMENSION(klon), INTENT(IN) :: Ale, Alp
+  !CR:test: on passe lentr et alim_star des thermiques
+  INTEGER, DIMENSION(klon), INTENT(IN) :: lalim_conv
+  REAL, DIMENSION(klon, klev), INTENT(IN) :: wght_th
+
+  REAL, DIMENSION(klon, klev), INTENT(INOUT) :: sig1, w01
+
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t, d_q, d_qcomp, d_u, d_v
+  REAL, DIMENSION(klon, klev, nbtr), INTENT(OUT) :: d_tra
+  REAL, DIMENSION(klon), INTENT(OUT) :: rain, snow
+
+  INTEGER, DIMENSION(klon), INTENT(OUT) :: kbas, ktop
+  REAL, DIMENSION(klon), INTENT(OUT) :: sigd
+  REAL, DIMENSION(klon), INTENT(OUT) :: cbmf, plcl, plfc, wbeff
+  REAL, DIMENSION(klon), INTENT(OUT) :: convoccur
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: upwd, dnwd, dnwdbis
+
+  !!       REAL Ma(klon,klev), mip(klon,klev),Vprecip(klon,klev)                    !jyg
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: Ma, mip
+  REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: Vprecip                        !jyg
+  REAL, DIMENSION(klon), INTENT(OUT) :: cape, cin
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: tvp
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: Tconv
+  INTEGER, DIMENSION(klon), INTENT(OUT) :: iflag
+  REAL, DIMENSION(klon), INTENT(OUT) :: pbase, bbase
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: dtvpdt1, dtvpdq1
+  REAL, DIMENSION(klon), INTENT(OUT) :: dplcldt, dplcldr
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qcondc
+  REAL, DIMENSION(klon), INTENT(OUT) :: wd
+  REAL, DIMENSION(klon, klev + 1), INTENT(OUT) :: pmflxr, pmflxs
+
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: da, mp
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phi
+  ! RomP >>>
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: phii
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d1a, dam
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: sij, elij
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qta
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: clw
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: dd_t, dd_q
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: evap, ep
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: eplaMm
+  REAL, DIMENSION(klon, klev, klev), INTENT(OUT) :: epmlmMm
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: wdtrainA, wdtrainS, wdtrainM
+  ! RomP <<<
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: wght                       !RL
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: qtc
+  REAL, DIMENSION(klon, klev), INTENT(OUT) :: sigt, detrain
+  REAL, INTENT(OUT) :: tau_cld_cv, coefw_cld_cv
+  REAL, DIMENSION(klon), INTENT(OUT) :: epmax_diag                ! epmax_cape
+
+  !  Local
+  !  ----
+  REAL, DIMENSION(klon, klev) :: em_p
+  REAL, DIMENSION(klon, klev + 1) :: em_ph
+  REAL :: em_sig1feed ! sigma at lower bound of feeding layer
+  REAL :: em_sig2feed ! sigma at upper bound of feeding layer
+  REAL, DIMENSION(klev) :: em_wght ! weight density determining the feeding mixture
+  REAL, DIMENSION(klon, klev + 1) :: Vprecipi                       !jyg
+  !on enleve le save
+  ! SAVE em_sig1feed,em_sig2feed,em_wght
+
+  REAL, DIMENSION(klon) :: rflag
+  REAL, DIMENSION(klon) :: plim1, plim2
+  REAL, DIMENSION(klon) :: ptop2
+  REAL, DIMENSION(klon, klev) :: asupmax
+  REAL, DIMENSION(klon) :: supmax0, asupmaxmin
+  REAL :: zx_t, zdelta, zx_qs, zcor
+
+  !   INTEGER iflag_mix
+  !   SAVE iflag_mix
+  INTEGER :: noff, minorig
+  INTEGER :: i, j, k, itra
+  REAL, DIMENSION(klon, klev) :: qs, qs_wake
+  !LF          SAVE cbmf
+  !IM/JYG      REAL, SAVE, ALLOCATABLE :: cbmf(:)
+  !!!$OMP THREADPRIVATE(cbmf)!
+  REAL, DIMENSION(klon) :: cbmflast
+
+
+  ! Variables supplementaires liees au bilan d'energie
+  ! Real paire(klon)
+  !LF      Real ql(klon,klev)
+  ! Save paire
+  !LF      Save ql
+  !LF      Real t1(klon,klev),q1(klon,klev)
+  !LF      Save t1,q1
+  ! Data paire /1./
+  REAL, SAVE, ALLOCATABLE :: ql(:, :), q1(:, :), t1(:, :)
+  !$OMP THREADPRIVATE(ql, q1, t1)
+
+  ! Variables liees au bilan d'energie et d'enthAlpi
+  REAL ztsol(klon)
+  REAL        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
+          h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
+  SAVE        h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, &
+          h_qs_tot, qw_tot, ql_tot, qs_tot, ec_tot
+  !$OMP THREADPRIVATE(h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot)
+  !$OMP THREADPRIVATE(h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot)
+  REAL        d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
+  REAL        d_h_vcol_phy
+  REAL        fs_bound, fq_bound
+  SAVE        d_h_vcol_phy
+  !$OMP THREADPRIVATE(d_h_vcol_phy)
+  REAL        zero_v(klon)
+  CHARACTER *15 ztit
+  INTEGER     ip_ebil ! PRINT level for energy conserv. diag.
+  SAVE        ip_ebil
+  DATA        ip_ebil/2/
+  !$OMP THREADPRIVATE(ip_ebil)
+  INTEGER     if_ebil ! level for energy conserv. dignostics
+  SAVE        if_ebil
+  DATA        if_ebil/2/
+  !$OMP THREADPRIVATE(if_ebil)
+  !+jld ec_conser
+  REAL d_t_ec(klon, klev) ! tendance du a la conersion Ec -> E thermique
+  REAL zrcpd
+  !-jld ec_conser
+  !LF
+  INTEGER nloc
+  LOGICAL, SAVE :: first = .TRUE.
+  !$OMP THREADPRIVATE(first)
+  INTEGER, SAVE :: itap, igout
+  !$OMP THREADPRIVATE(itap, igout)
+
+  IF (first) THEN
+    ! Allocate some variables LF 04/2008
+
+    !IM/JYG allocate(cbmf(klon))
+    ALLOCATE (ql(klon, klev))
+    ALLOCATE (t1(klon, klev))
+    ALLOCATE (q1(klon, klev))
+
+    convoccur(:) = 0.
+
+    itap = 0
+    igout = klon / 2 + 1 / klon
+  END IF
+  ! Incrementer le compteur de la physique
+  itap = itap + 1
+
+  ! Copy T into Tconv
+  DO k = 1, klev
+    DO i = 1, klon
+      Tconv(i, k) = t(i, k)
+    END DO
+  END DO
+
+  IF (if_ebil>=1) THEN
+    DO i = 1, klon
+      ztsol(i) = t(i, 1)
+      zero_v(i) = 0.
+      DO k = 1, klev
+        ql(i, k) = 0.
+      END DO
+    END DO
+  END IF
+
+  ! ym
+  snow(:) = 0
+
+  IF (first) THEN
+    first = .FALSE.
+
+    ! ===========================================================================
+    ! READ IN PARAMETERS FOR THE CLOSURE AND THE MIXING DISTRIBUTION
+    ! ===========================================================================
+
+    IF (iflag_con==3) THEN
+      !      CALL cv3_inicp()
+      CALL cv3_inip
+    END IF
+
+    ! ===========================================================================
+    ! READ IN PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
+    ! ===========================================================================
+
+    ! c$$$         open (56,file='supcrit.data')
+    ! c$$$         read (56,*) Supcrit1, Supcrit2
+    ! c$$$         close (56)
+
+    IF (prt_level>=10) WRITE (lunout, *) 'supcrit1, supcrit2', supcrit1, supcrit2
+
+    ! ===========================================================================
+    ! Initialisation pour les bilans d'eau et d'energie
+    ! ===========================================================================
+    IF (if_ebil>=1) d_h_vcol_phy = 0.
+
+    DO i = 1, klon
+      cbmf(i) = 0.
+      !!          plcl(i) = 0.
+      sigd(i) = 0.
+    END DO
+  END IF !(first)
+
+  ! Initialisation a chaque pas de temps
+  plfc(:) = 0.
+  wbeff(:) = 100.
+  plcl(:) = 0.
+
+  DO k = 1, klev + 1
+    DO i = 1, klon
+      em_ph(i, k) = paprs(i, k) / 100.0
+      pmflxr(i, k) = 0.
+      pmflxs(i, k) = 0.
+    END DO
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      em_p(i, k) = pplay(i, k) / 100.0
+    END DO
+  END DO
+
+
+  ! Feeding layer
+
+  em_sig1feed = 1.
+  !jyg<
+  !  em_sig2feed = 0.97
+  em_sig2feed = cvl_sig2feed
+  !>jyg
+  ! em_sig2feed = 0.8
+  ! Relative Weight densities
+  DO k = 1, klev
+    em_wght(k) = 1.
+  END DO
+  !CRtest: couche alim des tehrmiques ponderee par a*
+  ! DO i = 1, klon
+  ! do k=1,lalim_conv(i)
+  ! em_wght(k)=wght_th(i,k)
+  ! PRINT*,'em_wght=',em_wght(k),wght_th(i,k)
+  ! END DO
+  ! END DO
+
+  IF (iflag_con==4) THEN
+    DO k = 1, klev
+      DO i = 1, klon
+        zx_t = t(i, k)
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0)
+        zcor = 1. / (1. - retv * zx_qs)
+        qs(i, k) = zx_qs * zcor
+      END DO
+      DO i = 1, klon
+        zx_t = t_wake(i, k)
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = min(0.5, r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0)
+        zcor = 1. / (1. - retv * zx_qs)
+        qs_wake(i, k) = zx_qs * zcor
+      END DO
+    END DO
+  ELSE ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
+    DO k = 1, klev
+      DO i = 1, klon
+        zx_t = t(i, k)
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0
+        zx_qs = min(0.5, zx_qs)
+        zcor = 1. / (1. - retv * zx_qs)
+        zx_qs = zx_qs * zcor
+        qs(i, k) = zx_qs
+      END DO
+      DO i = 1, klon
+        zx_t = t_wake(i, k)
+        zdelta = max(0., sign(1., rtt - zx_t))
+        zx_qs = r2es * foeew(zx_t, zdelta) / em_p(i, k) / 100.0
+        zx_qs = min(0.5, zx_qs)
+        zcor = 1. / (1. - retv * zx_qs)
+        zx_qs = zx_qs * zcor
+        qs_wake(i, k) = zx_qs
+      END DO
+    END DO
+  END IF ! iflag_con
+
+  ! ------------------------------------------------------------------
+
+  ! Main driver for convection:
+  !                   iflag_con=3 -> nvlle version de KE (JYG)
+  !                   iflag_con = 30  -> equivAlent to convect3
+  !                   iflag_con = 4  -> equivAlent to convect1/2
+
+  IF (iflag_con==30) THEN
+
+    ! print *, '-> cv_driver'      !jyg
+    CALL cv_driver(klon, klev, klevp1, ntra, iflag_con, &
+            t, q, qs, u, v, tra, &
+            em_p, em_ph, iflag, &
+            d_t, d_q, d_u, d_v, d_tra, rain, &
+            Vprecip, cbmf, sig1, w01, & !jyg
+            kbas, ktop, &
+            dtime, Ma, upwd, dnwd, dnwdbis, qcondc, wd, cape, &
+            da, phi, mp, phii, d1a, dam, sij, clw, elij, &       !RomP
+            evap, ep, epmlmMm, eplaMm, &                         !RomP
+            wdtrainA, wdtrainM, &                                !RomP
+            epmax_diag) ! epmax_cape
+    !           print *, 'cv_driver ->'      !jyg
+
+    DO i = 1, klon
+      cbmf(i) = Ma(i, kbas(i))
+    END DO
+
+    !RL
+    wght(:, :) = 0.
+    DO i = 1, klon
+      wght(i, 1) = 1.
+    END DO
+    !RL
+
+  ELSE
+
+    !LF   necessary for gathered fields
+    nloc = klon
+    CALL cva_driver(klon, klev, klev + 1, ntra, nloc, k_upper_cv, &
+            iflag_con, iflag_mix, iflag_ice_thermo, &
+            iflag_clos, ok_conserv_q, dtime, cvl_comp_threshold, &
+            t, q, qs, t_wake, q_wake, qs_wake, s_wake, u, v, tra, &
+            em_p, em_ph, &
+            Ale, Alp, omega, &
+            em_sig1feed, em_sig2feed, em_wght, &
+            iflag, d_t, d_q, d_qcomp, d_u, d_v, d_tra, rain, kbas, ktop, &
+            cbmf, plcl, plfc, wbeff, sig1, w01, ptop2, sigd, &
+            Ma, mip, Vprecip, Vprecipi, upwd, dnwd, dnwdbis, qcondc, wd, &
+            cape, cin, tvp, &
+            dd_t, dd_q, plim1, plim2, asupmax, supmax0, &
+            asupmaxmin, lalim_conv, &
+            !AC!+!RomP+jyg
+            !!                   da,phi,mp,phii,d1a,dam,sij,clw,elij, &               ! RomP
+            !!                   evap,ep,epmlmMm,eplaMm,                              ! RomP
+            da, phi, mp, phii, d1a, dam, sij, wght, &           ! RomP+RL
+            qta, clw, elij, evap, ep, epmlmMm, eplaMm, &        ! RomP+RL
+            wdtrainA, wdtrainS, wdtrainM, qtc, sigt, detrain, &
+            tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
+            !AC!+!RomP+jyg
+            epmax_diag) ! epmax_cape
+  END IF
+  ! ------------------------------------------------------------------
+  IF (prt_level>=10) WRITE (lunout, *) ' cva_driver -> cbmf,plcl,plfc,wbeff, d_t, d_q ', &
+          cbmf(1), plcl(1), plfc(1), wbeff(1), d_t(1, 1), d_q(1, 1)
+
+  DO i = 1, klon
+    rain(i) = rain(i) / 86400.
+    rflag(i) = iflag(i)
+  END DO
+
+  DO k = 1, klev
+    DO i = 1, klon
+      d_t(i, k) = dtime * d_t(i, k)
+      d_q(i, k) = dtime * d_q(i, k)
+      d_u(i, k) = dtime * d_u(i, k)
+      d_v(i, k) = dtime * d_v(i, k)
+    END DO
+  END DO
+
+  IF (iflag_con==3) THEN
+    DO i = 1, klon
+      IF (wbeff(i) > 100. .OR. wbeff(i) == 0 .OR. iflag(i) > 3) THEN
+        wbeff(i) = 0.
+        convoccur(i) = 0.
+      ELSE
+        convoccur(i) = 1.
+      ENDIF
+    ENDDO
+  ENDIF
+
+  IF (iflag_con==30) THEN
+    DO itra = 1, ntra
+      DO k = 1, klev
+        DO i = 1, klon
+          !RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
+          d_tra(i, k, itra) = 0.
+        END DO
+      END DO
+    END DO
+  END IF
+
+  !!AC!
+  IF (iflag_con==3) THEN
+    DO itra = 1, ntra
+      DO k = 1, klev
+        DO i = 1, klon
+          !RL!            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
+          d_tra(i, k, itra) = 0.
+        END DO
+      END DO
+    END DO
+  END IF
+  !!AC!
+
+  DO k = 1, klev
+    DO i = 1, klon
+      t1(i, k) = t(i, k) + d_t(i, k)
+      q1(i, k) = q(i, k) + d_q(i, k)
+    END DO
+  END DO
+  !                                                     !jyg
+  IF (iflag_con == 30 .OR. iflag_ice_thermo ==0) THEN
+    ! --Separation neige/pluie (pour diagnostics)         !jyg
+    DO k = 1, klev                                    !jyg
+      DO i = 1, klon                                  !jyg
+        IF (t1(i, k)<rtt) THEN                         !jyg
+          pmflxs(i, k) = Vprecip(i, k)                !jyg
+        ELSE                                          !jyg
+          pmflxr(i, k) = Vprecip(i, k)                !jyg
+        END IF                                        !jyg
+      END DO                                          !jyg
+    END DO                                            !jyg
+  ELSE
+    DO k = 1, klev                                    !jyg
+      DO i = 1, klon                                  !jyg
+        pmflxs(i, k) = Vprecipi(i, k)                 !jyg
+        pmflxr(i, k) = Vprecip(i, k) - Vprecipi(i, k)   !jyg
+      END DO                                          !jyg
+    END DO                                            !jyg
+  ENDIF
+
+  ! c      IF (if_ebil.ge.2) THEN
+  ! c        ztit='after convect'
+  ! c        CALL diagetpq(paire,ztit,ip_ebil,2,2,dtime
+  ! c     e      , t1,q1,ql,qs,u,v,paprs,pplay
+  ! c     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+  ! c         CALL diagphy(paire,ztit,ip_ebil
+  ! c     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+  ! c     e      , zero_v, rain, zero_v, ztsol
+  ! c     e      , d_h_vcol, d_qt, d_ec
+  ! c     s      , fs_bound, fq_bound )
+  ! c      END IF
+
+
+  ! les traceurs ne sont pas mis dans cette version de convect4:
+  IF (iflag_con==4) THEN
+    DO itra = 1, ntra
+      DO k = 1, klev
+        DO i = 1, klon
+          d_tra(i, k, itra) = 0.
+        END DO
+      END DO
+    END DO
+  END IF
+  ! PRINT*, 'concvl->: dd_t,dd_q ',dd_t(1,1),dd_q(1,1)
+
+  DO k = 1, klev
+    DO i = 1, klon
+      dtvpdt1(i, k) = 0.
+      dtvpdq1(i, k) = 0.
+    END DO
+  END DO
+  DO i = 1, klon
+    dplcldt(i) = 0.
+    dplcldr(i) = 0.
+  END DO
+
+  IF (prt_level>=20) THEN
+    DO k = 1, klev
+      ! PRINT*,'physiq apres_add_con i k it d_u d_v d_t d_q qdl0',igout, &
+      !         k,itap,d_u_con(igout,k) ,d_v_con(igout,k), d_t_con(igout,k), &
+      !         d_q_con(igout,k),dql0(igout,k)
+      ! PRINT*,'phys apres_add_con itap Ma cin ALE ALP wak t q undi t q', &
+      !         itap,Ma(igout,k),cin(igout),ALE(igout), ALP(igout), &
+      !         t_wake(igout,k),q_wake(igout,k),t_undi(igout,k),q_undi(igout,k)
+      ! PRINT*,'phy apres_add_con itap CON rain snow EMA wk1 wk2 Vpp mip', &
+      !         itap,rain_con(igout),snow_con(igout),ema_work1(igout,k), &
+      !         ema_work2(igout,k),Vprecip(igout,k), mip(igout,k)
+      ! PRINT*,'phy apres_add_con itap upwd dnwd dnwd0 cape tvp Tconv ', &
+      !         itap,upwd(igout,k),dnwd(igout,k),dnwd0(igout,k),cape(igout), &
+      !         tvp(igout,k),Tconv(igout,k)
+      ! PRINT*,'phy apres_add_con itap dtvpdt dtvdq dplcl dplcldr qcondc', &
+      !         itap,dtvpdt1(igout,k),dtvpdq1(igout,k),dplcldt(igout), &
+      !         dplcldr(igout),qcondc(igout,k)
+      ! PRINT*,'phy apres_add_con itap wd pmflxr Kpmflxr Kp1 Kpmflxs Kp1', &
+      !         itap,wd(igout),pmflxr(igout,k),pmflxr(igout,k+1),pmflxs(igout,k), &
+      !         pmflxs(igout,k+1)
+      ! PRINT*,'phy apres_add_con itap da phi mp ftd fqd lalim wgth', &
+      !         itap,da(igout,k),phi(igout,k,k),mp(igout,k),ftd(igout,k), &
+      !         fqd(igout,k),lalim_conv(igout),wght_th(igout,k)
+    END DO
+  END IF !(prt_level.EQ.20) THEN
+
+END SUBROUTINE concvl
+
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv.f90	(revision 5158)
@@ -5,7 +5,7 @@
   ! Parameters for convectL:
   ! (includes - microphysical parameters,
-  !			- parameters that control the rate of approach
+  !            - parameters that control the rate of approach
   !               to quasi-equilibrium)
-  !			- noff & minorig (previously in input of convect1)
+  !            - noff & minorig (previously in input of convect1)
   !------------------------------------------------------------
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv30.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv30.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv30.f90	(revision 5158)
@@ -5,7 +5,7 @@
   ! Parameters for convectL, iflag_con=30:
   ! (includes - microphysical parameters,
-  !			- parameters that control the rate of approach
+  !            - parameters that control the rate of approach
   !               to quasi-equilibrium)
-  !			- noff & minorig (previously in input of convect1)
+  !            - noff & minorig (previously in input of convect1)
   !------------------------------------------------------------
 
@@ -933,52 +933,52 @@
     DO k = minorig + 1, nl
       DO i = 1, ncum
-        ! ori	    IF(k.ge.(icb(i)+1))THEN
+        ! ori        IF(k.ge.(icb(i)+1))THEN
         IF (k>=(icbs(i) + 1)) THEN ! convect3
           tg = t(i, k)
           qg = qs(i, k)
-          ! debug	      alv=lv0-clmcpv*(t(i,k)-t0)
+          ! debug          alv=lv0-clmcpv*(t(i,k)-t0)
           alv = lv0 - clmcpv * (t(i, k) - 273.15)
 
           ! First iteration.
 
-          ! ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+          ! ori           s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
           s = cpd * (1. - qnk(i)) + cl * qnk(i) & ! convect3
                   + alv * alv * qg / (rrv * t(i, k) * t(i, k)) ! convect3
           s = 1. / s
-          ! ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+          ! ori           ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
           ahg = cpd * tg + (cl - cpd) * qnk(i) * tg + alv * qg + gz(i, k) ! convect3
           tg = tg + s * (ah0(i) - ahg)
-          ! ori	       tg=max(tg,35.0)
-          ! debug	       tc=tg-t0
+          ! ori           tg=max(tg,35.0)
+          ! debug           tc=tg-t0
           tc = tg - 273.15
           denom = 243.5 + tc
           denom = max(denom, 1.0) ! convect3
-          ! ori	       IF(tc.ge.0.0)THEN
+          ! ori           IF(tc.ge.0.0)THEN
           es = 6.112 * exp(17.67 * tc / denom)
-          ! ori	       else
-          ! ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          ! ori	       endif
+          ! ori           else
+          ! ori            es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori           endif
           qg = eps * es / (p(i, k) - es * (1. - eps))
 
           ! Second iteration.
 
-          ! ori	       s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
-          ! ori	       s=1./s
-          ! ori	       ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
+          ! ori           s=cpd+alv*alv*qg/(rrv*t(i,k)*t(i,k))
+          ! ori           s=1./s
+          ! ori           ahg=cpd*tg+(cl-cpd)*qnk(i)*t(i,k)+alv*qg+gz(i,k)
           ahg = cpd * tg + (cl - cpd) * qnk(i) * tg + alv * qg + gz(i, k) ! convect3
           tg = tg + s * (ah0(i) - ahg)
-          ! ori	       tg=max(tg,35.0)
-          ! debug	       tc=tg-t0
+          ! ori           tg=max(tg,35.0)
+          ! debug           tc=tg-t0
           tc = tg - 273.15
           denom = 243.5 + tc
           denom = max(denom, 1.0) ! convect3
-          ! ori	       IF(tc.ge.0.0)THEN
+          ! ori           IF(tc.ge.0.0)THEN
           es = 6.112 * exp(17.67 * tc / denom)
-          ! ori	       else
-          ! ori			es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
-          ! ori	       endif
+          ! ori           else
+          ! ori            es=exp(23.33086-6111.72784/tg+0.15215*log(tg))
+          ! ori           endif
           qg = eps * es / (p(i, k) - es * (1. - eps))
 
-          ! debug	       alv=lv0-clmcpv*(t(i,k)-t0)
+          ! debug           alv=lv0-clmcpv*(t(i,k)-t0)
           alv = lv0 - clmcpv * (t(i, k) - 273.15)
           ! PRINT*,'cpd dans convect2 ',cpd
@@ -3306,7 +3306,7 @@
 
     IF (coef_epmax_cape>1e-12) THEN
-      do i = 1, ncum
+      DO i = 1, ncum
         epmax_diag(i) = epmax - coef_epmax_cape * sqrt(cape(i))
-        do k = 1, nl
+        DO k = 1, nl
           ep(i, k) = ep(i, k) / epmax * epmax_diag(i)
           ep(i, k) = amax1(ep(i, k), 0.0)
@@ -3316,16 +3316,16 @@
 
       ! On recalcule hp:
-      do k = 1, nl
-        do i = 1, ncum
+      DO k = 1, nl
+        DO i = 1, ncum
           hp_bak(i, k) = hp(i, k)
         enddo
       enddo
-      do k = 1, nlp
-        do i = 1, ncum
+      DO k = 1, nlp
+        DO i = 1, ncum
           hp(i, k) = h(i, k)
         enddo
       enddo
-      do k = minorig + 1, nl
-        do i = 1, ncum
+      DO k = minorig + 1, nl
+        DO i = 1, ncum
           IF((k>=icb(i)).AND.(k<=inb(i)))THEN
             hp(i, k) = h(i, nk(i)) + (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k)
@@ -3334,6 +3334,6 @@
       enddo !do k=minorig+1,n
       !     WRITE(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
-      do i = 1, ncum
-        do k = 1, nl
+      DO i = 1, ncum
+        DO k = 1, nl
           IF (abs(hp_bak(i, k) - hp(i, k))>0.01) THEN
             WRITE(*, *) 'i,k=', i, k
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv3_inip.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv3_inip.f90	(revision 5158)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv3_inip.f90	(revision 5158)
@@ -0,0 +1,92 @@
+MODULE lmdz_cv3_inip
+  IMPLICIT NONE; PRIVATE
+  PUBLIC cv3_inip
+CONTAINS
+  SUBROUTINE cv3_inip
+    ! *******************************************************************
+    ! *                                                                  *
+    ! CV3_INIP Input = choice of mixing probability laws                 *
+    !          Output = normalized coefficients of the probability laws. *
+    ! *                                                                  *
+    ! written by   : Jean-Yves Grandpeix, 06/06/2006, 19.39.27           *
+    ! modified by :                                                      *
+    ! *******************************************************************
+
+    USE lmdz_print_control, ONLY: prt_level, lunout
+    USE lmdz_abort_physic, ONLY: abort_physic
+    ! IN: iflag_mix, gammas , alphas, betas, Fmax, scut, INOUT: qqa1 qqa2, OUT: Qcoef1max, Qcoef1max
+    USE lmdz_yomcst2, ONLY: iflag_mix, gammas, alphas, betas, Fmax, scut, qqa1, qqa2, Qcoef1max, Qcoef2max
+
+    IMPLICIT NONE
+
+    !----------------------------------------------
+    ! Local variables :
+    CHARACTER (LEN = 20) :: modname = 'cv3_inip'
+    CHARACTER (LEN = 80) :: abort_message
+
+    REAL :: sumcoef
+    REAL :: sigma, aire, pdf, mu, df
+    REAL :: ff
+
+    ! --   Mixing probability distribution functions
+
+    REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
+
+    qcoef1(f) = tanh(f / gammas)
+    qcoef2(f) = (tanh(f / gammas) + gammas * log(cosh((1. - f) / gammas) / cosh(f / gammas)))
+    qff(f) = max(min(f, 1.), 0.)
+    qfff(f) = min(qff(f), scut)
+    qmix1(f) = (tanh((qff(f) - fmax) / gammas) + qcoef1max) / qcoef2max
+    rmix1(f) = (gammas * log(cosh((qff(f) - fmax) / gammas)) + qff(f) * qcoef1max) / &
+            qcoef2max
+    qmix2(f) = -log(1. - qfff(f)) / scut
+    rmix2(f) = (qfff(f) + (1. - qff(f)) * log(1. - qfff(f))) / scut
+    qmix(f) = qqa1 * qmix1(f) + qqa2 * qmix2(f)
+    rmix(f) = qqa1 * rmix1(f) + qqa2 * rmix2(f)
+
+    IF (iflag_mix>0) THEN
+
+      ! --      Normalize Pdf weights
+      sumcoef = qqa1 + qqa2
+      qqa1 = qqa1 / sumcoef
+      qqa2 = qqa2 / sumcoef
+
+      qcoef1max = qcoef1(fmax)
+      qcoef2max = qcoef2(fmax)
+
+      sigma = 0.
+      aire = 0.0
+      pdf = 0.0
+      mu = 0.0
+      df = 0.0001
+
+      ! do ff = 0.0 + df, 1.0 - 2.*df, df
+      ff = df
+      DO WHILE (ff<=1.0 - 2. * df)
+        pdf = (qmix(ff + df) - qmix(ff)) * (1. - ff) / df
+        aire = aire + (qmix(ff + df) - qmix(ff)) * (1. - ff)
+        mu = mu + pdf * ff * df
+        IF (prt_level>9) WRITE (lunout, *) pdf, qmix(ff), aire, ff
+        ff = ff + df
+      END DO
+
+      ! do ff=0.0+df,1.0 - 2.*df,df
+      ff = df
+      DO WHILE (ff<=1.0 - 2. * df)
+        pdf = (qmix(ff + df) - qmix(ff)) * (1. - ff) / df
+        sigma = sigma + pdf * (ff - mu) * (ff - mu) * df
+        ff = ff + df
+      END DO
+      sigma = sqrt(sigma)
+
+      IF (abs(aire - 1.0)>0.02) THEN
+        WRITE (lunout, *) 'WARNING:: AREA OF MIXING PDF IS::', aire
+        abort_message = ''
+        CALL abort_physic(modname, abort_message, 1)
+      ELSE
+        PRINT *, 'Area, mean & std deviation are ::', aire, mu, sigma
+      END IF
+    END IF !  (iflag_mix .gt. 0)
+
+  END SUBROUTINE cv3_inip
+END MODULE lmdz_cv3_inip
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv3param.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv3param.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_cv3param.f90	(revision 5158)
@@ -5,7 +5,7 @@
   ! Parameters for convectL, iflag_con=3:
   ! (includes - microphysical parameters,
-  !			- parameters that control the rate of approach
+  !            - parameters that control the rate of approach
   !               to quasi-equilibrium)
-  !			- noff & minorig (previously in input of convect1)
+  !            - noff & minorig (previously in input of convect1)
   !------------------------------------------------------------
   IMPLICIT NONE; PRIVATE
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_flux_arp.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_flux_arp.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_flux_arp.f90	(revision 5158)
@@ -4,5 +4,5 @@
 
 MODULE lmdz_flux_arp
-  PRIVATE NONE; PRIVATE
+  IMPLICIT NONE; PRIVATE
   PUBLIC fsens, flat, betaevap, ust, tg, ok_flux_surf, ok_prescr_ust, ok_prescr_beta, ok_forc_tsurf
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_iotd.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_iotd.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_iotd.f90	(revision 5158)
@@ -249,5 +249,5 @@
     IF (ierr==0) THEN
       ierr = 0
-      do while (ierr==0)
+      DO while (ierr==0)
         read(99, *, iostat = ierr) un_nom
         IF (ierr==0) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_lscp_old.F90	(revision 5158)
@@ -757,5 +757,5 @@
         IF (iflag_pdf==0) THEN
            ! version creneau de (Li, 1998)
-           do i=1,klon
+           DO i=1,klon
               zdelq = min(ratqs(i,k),0.99) * zq(i)
               rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
@@ -768,5 +768,5 @@
            ! les valeurs de T et Q initiales
            ! ----------------------------------------------------------------
-           do i=1,klon
+           DO i=1,klon
               IF(zq(i)<1.e-15) THEN
                  ncoreczq=ncoreczq+1
@@ -800,5 +800,5 @@
 
               endif
-              do i=1,klon
+              DO i=1,klon
                  rneb(i,k)=ctot(i,k)
                  rneblsvol(i,k)=ctot_vol(i,k)
@@ -821,5 +821,5 @@
 !CR: variation de qsat avec T en presence de glace ou non
 !initialisations
-           do i=1,klon
+           DO i=1,klon
               DT(i) = 0.
               n_i(i)=0
@@ -846,7 +846,7 @@
              ! Iteration pour condensation avec variation de qsat(T) 
              ! -----------------------------------------------------
-             do iter=1,iflag_fisrtilp_qsat+1
+             DO iter=1,iflag_fisrtilp_qsat+1
                 
-               do i=1,klon
+               DO i=1,klon
 !                 do while ((abs(DT(i)).gt.DDT0).OR.(n_i(i).EQ.0))
                  ! !! convergence = .TRUE. tant que l'on n'a pas converge !!
@@ -929,5 +929,5 @@
                  IF (.NOT. ice_thermo) THEN
                  ! --------------------------
-                 do i=1,klon
+                 DO i=1,klon
                  IF ((convergence(i).OR.(n_i(i)==0)).AND.lognormale(i)) THEN
                  qlbef(i)=max(0.,zqn(i)-zqs(i))
@@ -949,5 +949,5 @@
                  endif
 
-                 do i=1,klon
+                 DO i=1,klon
                  IF ((convergence(i).OR.(n_i(i)==0)).AND.lognormale(i)) THEN
                  IF (iflag_t_glace==0) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90	(revision 5158)
@@ -77,6 +77,6 @@
 
 IF (klon==1) THEN
-    do k=1,klev
-      do i=1,klon 
+    DO k=1,klev
+      DO i=1,klon
           povariance(i,k) = 0.00000000001
           var_conv(i,k) = 0.00000000001
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_main.F90	(revision 5158)
@@ -72,6 +72,6 @@
 !   on ecrase le tableau ratqsc calcule par clouds_gno
       IF (iflag_cld_th==1) THEN
-         do k=1,klev
-         do i=1,klon
+         DO k=1,klev
+         DO i=1,klon
             IF(ptconv(i,k)) THEN
               ratqsc(i,k)=ratqsbas &
@@ -101,6 +101,6 @@
       IF (iflag_ratqs==0) THEN
 ! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
-         do k=1,klev
-            do i=1, klon
+         DO k=1,klev
+            DO i=1, klon
                ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* &
                min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) 
@@ -116,6 +116,6 @@
 
       ELSE IF (iflag_ratqs==1) THEN
-         do k=1,klev
-            do i=1, klon
+         DO k=1,klev
+            DO i=1, klon
                IF (pplay(i,k)>=60000.) THEN
                   ratqss(i,k)=ratqsbas
@@ -129,6 +129,6 @@
 
       ELSE IF (iflag_ratqs==2) THEN
-         do k=1,klev
-            do i=1, klon
+         DO k=1,klev
+            DO i=1, klon
                IF (pplay(i,k)>=60000.) THEN
                   ratqss(i,k)=ratqsbas*(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
@@ -142,5 +142,5 @@
 
       ELSE IF (iflag_ratqs==3) THEN
-         do k=1,klev
+         DO k=1,klev
            ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) &
            *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. )
@@ -148,5 +148,5 @@
 
       ELSE IF (iflag_ratqs==4) THEN
-         do k=1,klev
+         DO k=1,klev
            ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
 !          *( tanh( (50000.-pplay(:,k))/20000.) + 1.)
@@ -160,6 +160,6 @@
 ! April 2023 
         resolmax=sqrt(maxval(cell_area))
-         do k=1,klev
-            do i=1,klon
+         DO k=1,klev
+            DO i=1,klon
               resol=sqrt(cell_area(i))
               fact=sqrt(resol/resolmax)
@@ -177,6 +177,6 @@
        
        ! background ratqs and initialisations
-          do k=1,klev
-             do i=1,klon
+          DO k=1,klev
+             DO i=1,klon
               ratqss(i,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
               *( tanh( (ratqsp0-pplay(i,k))/ratqsdp) + 1.)
@@ -195,6 +195,6 @@
                        fm_therm,entr_therm,detr_therm,detrain_cv,fm_cv,fqd,fqcomp,sigd, &
                        ratqs_inter_)
-             do k=1,klev
-                do i=1,klon
+             DO k=1,klev
+                DO i=1,klon
                     ratqs_inter_(i,k)=ratqs_inter_(i,k)-0.5*ratqs_inter_(i,k)*(tanh((ratqsp0-pplay(i,k))/ratqsdp)+1.)
                 enddo
@@ -234,6 +234,6 @@
 ! fluctuations turbulentes de petite echelle
 
-         do k=1,klev
-            do i=1,klon
+         DO k=1,klev
+            DO i=1,klon
                IF ((fm_therm(i,k)>1.e-10)) THEN
                   ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
@@ -264,6 +264,6 @@
           zfratqs1=exp(-pdtphys/10800.)
           zfratqs2=exp(-pdtphys/10800.)
-          do k=1,klev
-             do i=1,klon
+          DO k=1,klev
+             DO i=1,klon
                 IF (ratqsc(i,k)>1.e-10) THEN
                    ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cld_th/100.)*ratqsc(i,k)*(1.-zfratqs2)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_multi.F90	(revision 5158)
@@ -75,5 +75,5 @@
 !-----------------------------------------------------------------------
 
-      do k=1,klev
+      DO k=1,klev
          zmasse(:,k)=(paprs(:,k)-paprs(:,k+1))/RG
       enddo
@@ -85,6 +85,6 @@
 
 
-      do k=1,klev
-         do i=1,klon
+      DO k=1,klev
+         DO i=1,klon
             tau_diss(i,k)=tau_var +0.5*fac_tau*tau_var*(tanh((taup0-paprs(i,k))/taudp) + 1.)
          enddo
@@ -101,6 +101,6 @@
       CALL thermcell_dq(klon,klev,dqimpl,pdtphys,fm0,entr0,zmasse,  &
                      po,pdoadj,zoa,lev_out)
-      do k=1,klev
-         do i=1,klon
+      DO k=1,klev
+         DO i=1,klon
             pocarre(i,k)=po(i,k)*po(i,k) + povariance(i,k)
          enddo
@@ -111,6 +111,6 @@
 
 ! variance de l'humidit?? sp??cifique totale dans les thermiques     
-      do k=1,klev
-         do i=1,klon      
+      DO k=1,klev
+         DO i=1,klon
             varq_therm(i,k)=zocarrea(i,k)-zoa(i,k)*zoa(i,k)
          enddo
@@ -118,6 +118,6 @@
 
 ! calcul des termes sources de la variance avec thermiques et convection profonde (voir Klein 2005 par exemple)
-      do k=1,klev
-         do i=1,klon      
+      DO k=1,klev
+         DO i=1,klon
             var_moy(i,k) = detr0(i,k)*((zoa(i,k)-po(i,k))**2)/zmasse(i,k)
             var_var(i,k) = detr0(i,k)*(varq_therm(i,k)-povariance(i,k))/zmasse(i,k)
@@ -131,6 +131,6 @@
       enddo
 
-      do k=1,klev-1
-         do i=1,klon      
+      DO k=1,klev-1
+         DO i=1,klon
             var_desc_th(i,k) = fm0(i,k+1)*povariance(i,k+1)/zmasse(i,k) -  &
                fm0(i,k)*povariance(i,k)/zmasse(i,k)
@@ -142,6 +142,6 @@
       
       IF (klein) THEN
-         do k=1,klev-1
-            do i=1,klon
+         DO k=1,klev-1
+            DO i=1,klon
               qd0(:,:) = 0.0
               IF (sigd(i)/=0) THEN
@@ -150,6 +150,6 @@
             enddo
          enddo
-         do k=1,klev-1
-            do i=1,klon      
+         DO k=1,klev-1
+            DO i=1,klon
                povariance(i,k)= (var_moy(i,k) + var_var(i,k) + var_desc_th(i,k) +  &
                var_det_conv(i,k) +  var_desc_prec(i,k)  &   
@@ -163,6 +163,6 @@
          qd0(:,:) = 0.0
          q0(:,:) = 0.0
-         do k=1,klev-1
-            do i=1,klon
+         DO k=1,klev-1
+            DO i=1,klon
                IF (sigd(i)/=0) then    ! termes de variance par accumulation
                  qd0(i,k) = fqd(i,k)*tau_cumul/sigd(i) 
@@ -173,6 +173,6 @@
             enddo
          enddo
-         do k=1,klev-1
-            do i=1,klon      
+         DO k=1,klev-1
+            DO i=1,klon
                povariance(i,k)= (pdocarreadj(i,k)-2.*po(i,k)*pdoadj(i,k) +  &
                a_ratqs_cv*(sigt_cv(i,k)*(1-sigt_cv(i,k))*q0(i,k)**2/tau_cumul + var_desc_prec(i,k) +  &
@@ -189,6 +189,6 @@
 !-------------------------------------------------------------------------
 
-      do k=1,klev
-        do i=1,klon
+      DO k=1,klev
+        DO i=1,klon
            IF(q_seri(i,k)>=1E-7) THEN
                ratqs_inter_(i,k) = abs(povariance(i,k))**0.5/q_seri(i,k)    
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_screenp.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_screenp.f90	(revision 5158)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_screenp.f90	(revision 5158)
@@ -0,0 +1,175 @@
+MODULE lmdz_screenp
+
+  ! This module contains some procedures for calculation of the first
+  ! guess of temperature, specific humidity and wind at a reference level
+  ! coefficients for turbulent diffusion at surface
+
+  IMPLICIT NONE; PRIVATE
+  PUBLIC screenp, screenpn
+
+CONTAINS
+
+  !****************************************************************************************
+
+  !r original routine
+
+  SUBROUTINE screenp(klon, knon, &
+          speed, tair, qair, &
+          ts, qsurf, rugos, lmon, &
+          ustar, testar, qstar, zref, &
+          delu, delte, delq)
+    IMPLICIT NONE
+    !-------------------------------------------------------------------------
+
+    ! Objet : calcul "predicteur" des anomalies du vent, de la temperature
+    !         potentielle et de l'humidite relative au niveau de reference zref et
+    !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
+    !         a partir des relations de Dyer-Businger.
+
+    ! Reference : Hess, Colman et McAvaney (1995)
+
+    ! I. Musat, 01.07.2002
+    !-------------------------------------------------------------------------
+
+    ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+    ! knon----input-I- nombre de points pour un type de surface
+    ! speed---input-R- module du vent au 1er niveau du modele
+    ! tair----input-R- temperature de l'air au 1er niveau du modele
+    ! qair----input-R- humidite relative au 1er niveau du modele
+    ! ts------input-R- temperature de l'air a la surface
+    ! qsurf---input-R- humidite relative a la surface
+    ! rugos---input-R- rugosite
+    ! lmon----input-R- longueur de Monin-Obukov
+    ! ustar---input-R- facteur d'echelle pour le vent
+    ! testar--input-R- facteur d'echelle pour la temperature potentielle
+    ! qstar---input-R- facteur d'echelle pour l'humidite relative
+    ! zref----input-R- altitude de reference
+
+    ! delu----input-R- anomalie du vent par rapport au 1er niveau
+    ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+    ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+
+    INTEGER, INTENT(IN) :: klon, knon
+    REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
+    REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
+    DOUBLE PRECISION, DIMENSION(klon), INTENT(IN) :: lmon
+    REAL, DIMENSION(klon), INTENT(IN) :: ustar, testar, qstar
+    REAL, INTENT(IN) :: zref
+
+    REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
+
+    !-------------------------------------------------------------------------
+    ! Variables locales et constantes :
+    REAL, PARAMETER :: RKAR = 0.40
+    INTEGER :: i
+    REAL :: xtmp, xtmp0
+    !-------------------------------------------------------------------------
+    DO i = 1, knon
+
+      IF (lmon(i)>=0.) THEN
+
+        ! STABLE CASE
+
+        IF (speed(i)>1.5.AND.lmon(i)<=1.0                        &
+                .AND. rugos(i)<=1.0) THEN
+          delu(i) = (ustar(i) / RKAR) * &
+                  (log(zref / (rugos(i)) + 1.) + &
+                          min(5.d0, 5.0 * (zref - rugos(i)) / lmon(i)))
+          delte(i) = (testar(i) / RKAR) * &
+                  (log(zref / (rugos(i)) + 1.) + &
+                          min(5.d0, 5.0 * (zref - rugos(i)) / lmon(i)))
+          delq(i) = (qstar(i) / RKAR) * &
+                  (log(zref / (rugos(i)) + 1.) + &
+                          min(5.d0, 5.0 * (zref - rugos(i)) / lmon(i)))
+        ELSE
+          delu(i) = 0.1 * speed(i)
+          delte(i) = 0.1 * (tair(i) - ts(i))
+          delq(i) = 0.1 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
+        ENDIF
+      ELSE
+
+        ! UNSTABLE CASE
+
+        IF (speed(i)>5.0.AND.abs(lmon(i))<=50.0) THEN
+          xtmp = (1. - 16. * (zref / lmon(i)))**(1. / 4.)
+          xtmp0 = (1. - 16. * (rugos(i) / lmon(i)))**(1. / 4.)
+          delu(i) = (ustar(i) / RKAR) * &
+                  (log(zref / (rugos(i)) + 1.) &
+                          - 2. * log(0.5 * (1. + xtmp)) &
+                          + 2. * log(0.5 * (1. + xtmp0)) &
+                          - log(0.5 * (1. + xtmp * xtmp)) &
+                          + log(0.5 * (1. + xtmp0 * xtmp0)) &
+                          + 2. * atan(xtmp) - 2. * atan(xtmp0))
+          delte(i) = (testar(i) / RKAR) * &
+                  (log(zref / (rugos(i)) + 1.) &
+                          - 2.0 * log(0.5 * (1. + xtmp * xtmp)) &
+                          + 2.0 * log(0.5 * (1. + xtmp0 * xtmp0)))
+          delq(i) = (qstar(i) / RKAR) * &
+                  (log(zref / (rugos(i)) + 1.) &
+                          - 2.0 * log(0.5 * (1. + xtmp * xtmp)) &
+                          + 2.0 * log(0.5 * (1. + xtmp0 * xtmp0)))
+        ELSE
+          delu(i) = 0.5 * speed(i)
+          delte(i) = 0.5 * (tair(i) - ts(i))
+          delq(i) = 0.5 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
+        ENDIF
+      ENDIF
+
+    ENDDO
+
+  END SUBROUTINE screenp
+
+  SUBROUTINE screenpn(klon, knon, speed, tair, qair, ts, qsurf, zri1, delu, delte, delq)
+    IMPLICIT NONE
+    !-------------------------------------------------------------------------
+
+    ! Objet : calcul "predicteur" des anomalies du vent, de la temperature
+    !         potentielle et de l'humidite relative au niveau de reference zref et
+    !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
+    !         a partir des relations de Dyer-Businger.
+
+    ! Reference : Hess, Colman et McAvaney (1995)
+
+    ! I. Musat, 01.07.2002
+    !-------------------------------------------------------------------------
+
+    ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
+    ! knon----input-I- nombre de points pour un type de surface
+    ! speed---input-R- module du vent au 1er niveau du modele
+    ! tair----input-R- temperature de l'air au 1er niveau du modele
+    ! qair----input-R- humidite relative au 1er niveau du modele
+    ! ts------input-R- temperature de l'air a la surface
+    ! qsurf---input-R- humidite relative a la surface
+
+    ! delu----input-R- anomalie du vent par rapport au 1er niveau
+    ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
+    ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
+
+    INTEGER, INTENT(IN) :: klon, knon
+    REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
+    REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf
+    REAL, DIMENSION(klon), INTENT(IN) :: zri1
+
+    REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
+
+    !-------------------------------------------------------------------------
+    ! Variables locales et constantes :
+    REAL, PARAMETER :: RKAR = 0.40
+    INTEGER :: i
+    !-------------------------------------------------------------------------
+    DO i = 1, knon
+
+      IF (zri1(i)>=0.) THEN
+        delu(i) = 0.1 * speed(i)
+        delte(i) = 0.1 * (tair(i) - ts(i))
+        delq(i) = 0.1 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
+      ELSE
+        delu(i) = 0.5 * speed(i)
+        delte(i) = 0.5 * (tair(i) - ts(i))
+        delq(i) = 0.5 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
+      ENDIF
+
+    ENDDO
+
+  END SUBROUTINE screenpn
+END MODULE lmdz_screenp
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_simu_airs.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_simu_airs.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_simu_airs.f90	(revision 5158)
@@ -28,5 +28,5 @@
     PARAMETER(delta_alt_limit = 2000.0)    ! 2000 meters
 
-    do i = 1, N - 1
+    DO i = 1, N - 1
       slope(i) = -(T(i + 1) - T(i)) / (alt(i + 1) - alt(i))
     END DO
@@ -43,5 +43,5 @@
     first_point = 0
     exit_flag = 0
-    do while(exit_flag==0)
+    DO while(exit_flag==0)
       IF (P(i)>=P_min.AND.P(i)<=P_max) THEN
         IF (first_point>0) THEN
@@ -129,5 +129,5 @@
     nss = 1
 
-    do i = 2, size(rneb_cs)
+    DO i = 2, size(rneb_cs)
       IF (rneb_ord(i) > rneb_min) THEN
         nss = nss + 1
@@ -161,5 +161,5 @@
     rneb_max(1) = rneb_ord(1)
 
-    do i = 2, size(rneb_cs)
+    DO i = 2, size(rneb_cs)
       IF (rneb_ord(i) > rneb_min) THEN
         n = n + 1
@@ -178,5 +178,5 @@
     ! Appel de sous_section
 
-    do i = 1, nss
+    DO i = 1, nss
       CALL sous_section(len_cs, rneb_cs, temp_cs, &
               emis_cs, iwco_cs, &
@@ -222,5 +222,5 @@
     em_Anv_cs = 0.
 
-    do i = 1, nss
+    DO i = 1, nss
 
       cc_tot_cs = cc_tot_cs + s(i)
@@ -369,5 +369,5 @@
     ! Ponderation: 1 pour les nuages, 0 pour les trous
 
-    do i = 1, len_cs
+    DO i = 1, len_cs
       IF (rneb_cs(i) >= rnebmax) THEN
         w(i) = 1.
@@ -380,5 +380,5 @@
 
     som = 0.
-    do i = 1, len_cs
+    DO i = 1, len_cs
       IF (emis_cs(i) == 1.) THEN
         tau_cs(i) = 10.
@@ -395,5 +395,5 @@
 
     ! Boucle sur les nuages
-    do while (ideb /= 0 .AND. ideb <= len_cs)
+    DO while (ideb /= 0 .AND. ideb <= len_cs)
 
 
@@ -524,5 +524,5 @@
     IF (visible == 0) THEN
       IF (som_tau < tau_thresh) THEN
-        do i = ibeg, iend
+        DO i = ibeg, iend
           w(i) = 0.
         enddo
@@ -535,5 +535,5 @@
     else
 
-      do i = ibeg, iend
+      DO i = ibeg, iend
         w(i) = 0.
       enddo
@@ -568,5 +568,5 @@
     ibase = -100
 
-    do i = ibeg, iend
+    DO i = ibeg, iend
 
       som_tau = som_tau + tau_cs(i)
@@ -587,5 +587,5 @@
       WRITE(*, *) 'som_dez = 0 stop '
       WRITE(*, *) 'ibeg, iend =', ibeg, iend
-      do i = ibeg, iend
+      DO i = ibeg, iend
         WRITE(*, *) dz_cs(i), rhodz_cs(i)
       enddo
@@ -619,5 +619,5 @@
     iend = 0
 
-    do i = ideb, size(w)
+    DO i = ideb, size(w)
 
       IF (w(i) == 1. .AND. itest == 0) THEN
@@ -629,5 +629,5 @@
 
     i = ibeg
-    do while (w(i) == 1. .AND. i <= size(w))
+    DO while (w(i) == 1. .AND. i <= size(w))
       i = i + 1
     enddo
@@ -647,13 +647,13 @@
     REAL :: rneb_max
 
-    do i = 1, size(rneb_cs)
+    DO i = 1, size(rneb_cs)
       rneb(i) = rneb_cs(i)
     enddo
 
-    do j = 1, size(rneb_cs)
+    DO j = 1, size(rneb_cs)
 
       rneb_max = 100.
 
-      do i = 1, size(rneb_cs)
+      DO i = 1, size(rneb_cs)
         IF (rneb(i) < rneb_max) THEN
           rneb_max = rneb(i)
@@ -735,5 +735,5 @@
     CHARACTER (len = 160) :: abort_message
 
-    do j = 1, klev
+    DO j = 1, klev
       WRITE(lunout, *) 'simu_airs, j, rneb_1D =', rneb_1D(j)
     enddo
@@ -778,9 +778,9 @@
     tsom_hist = 0.
 
-    do while (ltop >= 1)   ! Boucle sur toute la colonne
+    DO while (ltop >= 1)   ! Boucle sur toute la colonne
 
       itop = 0
 
-      do l = ltop, 1, -1
+      DO l = ltop, 1, -1
 
         IF (itop == 0 .AND. rneb_1D(l) > 0.001) THEN
@@ -792,5 +792,5 @@
       ibot = itop
 
-      do while (rneb_1D(ibot) > 0.001 .AND. ibot >= 1)
+      DO while (rneb_1D(ibot) > 0.001 .AND. ibot >= 1)
         ibot = ibot - 1
       enddo
@@ -817,5 +817,5 @@
         ics = 0
 
-        do i = itop, ibot, -1
+        DO i = itop, ibot, -1
           ics = ics + 1
           rneb_cs(ics) = rneb_1D(i)
@@ -1163,6 +1163,6 @@
     ! Definition des variables 1D
 
-    do i = 1, klon
-      do j = 1, klev - 1
+    DO i = 1, klon
+      DO j = 1, klev - 1
         rhodz_airs(i, j) = &
                 (paprs_airs(i, j) - paprs_airs(i, j + 1)) / RG
@@ -1171,6 +1171,6 @@
     enddo
 
-    do i = 1, klon
-      do j = 1, klev
+    DO i = 1, klon
+      DO j = 1, klev
         rho_airs(i, j) = &
                 pplay_airs(i, j) / (temp_airs(i, j) * RD)
@@ -1187,9 +1187,9 @@
     !=============================================================================
 
-    do i = 1, klon  ! boucle sur les points de grille
+    DO i = 1, klon  ! boucle sur les points de grille
 
       !=============================================================================
 
-      do j = 1, klev
+      DO j = 1, klev
 
         rneb_1D(j) = rneb_airs(i, j)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alim.F90	(revision 5158)
@@ -41,6 +41,6 @@
 !-------------------------------------------------------------------------
    IF (flag==0) THEN ! CMIP5 version
-      do l=1,klev-1
-         do ig=1,ngrid
+      DO l=1,klev-1
+         DO ig=1,ngrid
             IF (ztv(ig,l)> ztv(ig,l+1) .AND. ztv(ig,1)>=ztv(ig,l) ) THEN
                alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
@@ -51,6 +51,6 @@
          enddo
       enddo
-      do l=1,klev
-         do ig=1,ngrid 
+      DO l=1,klev
+         DO ig=1,ngrid
             IF (alim_star_tot(ig) > 1.e-10 ) THEN
                alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
@@ -75,10 +75,10 @@
 ! Il faut recalculer zlay qui n'est pas dispo dans thermcell_plume
 ! A changer eventuellement.
-      do l=1,klev
+      DO l=1,klev
          zlay(:,l)=0.5*(zlev(:,l)+zlev(:,l+1))
       enddo
 
-      do l=klev-1,1,-1
-         do ig=1,ngrid
+      DO l=klev-1,1,-1
+         DO ig=1,ngrid
             ztv_parcel=ztv(ig,1)+d_temp(ig)
             IF (ztv_parcel<ztv(ig,l+1)) lalim(ig)=l
@@ -86,5 +86,5 @@
       enddo
 
-      do ig=1,ngrid
+      DO ig=1,ngrid
          l=lalim(ig)
          IF (l==1) THEN
@@ -100,6 +100,6 @@
       alim_star(:,:)=0.
       lalim(:)=0
-      do l=1,klev-1
-         do ig=1,ngrid
+      DO l=1,klev-1
+         DO ig=1,ngrid
             IF (zh(ig)==0.) THEN
                alim_star(ig,l)=0.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_alp.F90	(revision 5158)
@@ -133,5 +133,5 @@
 
     !------------Test sur le LCL des thermiques
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       ok_lcl(ig) = .FALSE.
       IF ((pcon(ig) > pplay(ig, nlay - 1)) .AND. (pcon(ig) < pplay(ig, 1))) ok_lcl(ig) = .TRUE.
@@ -139,6 +139,6 @@
 
     !------------Localisation des niveaux entourant le LCL et du coef d'interpolation
-    do l = 1, nlay - 1
-      do ig = 1, ngrid
+    DO l = 1, nlay - 1
+      DO ig = 1, ngrid
         IF (ok_lcl(ig)) THEN
           !ATTENTION,zw2 calcule en pplev
@@ -155,5 +155,5 @@
     enddo
 
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       !CR:REHABILITATION ZMAX CONTINU
       IF (ok_lcl(ig)) THEN
@@ -173,6 +173,6 @@
 
       !-----Initialisation de la TKE moyenne
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           pbl_tke_max(ig, l) = 0.
         enddo
@@ -180,7 +180,7 @@
 
       !-----Calcul de la TKE moyenne
-      do nsrf = 1, nbsrf
-        do l = 1, nlay
-          do ig = 1, ngrid
+      DO nsrf = 1, nbsrf
+        DO l = 1, nlay
+          DO ig = 1, ngrid
             pbl_tke_max(ig, l) = pctsrf(ig, nsrf) * pbl_tke(ig, l, nsrf) + pbl_tke_max(ig, l)
           enddo
@@ -189,6 +189,6 @@
 
       !-----Initialisations des TKE dans et hors des thermiques
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           therm_tke_max(ig, l) = pbl_tke_max(ig, l)
           env_tke_max(ig, l) = pbl_tke_max(ig, l)
@@ -202,6 +202,6 @@
 
       !-----Calcul des profils verticaux de TKE hors thermiques : env_tke_max, et de la vitesse verticale grande échelle : W_ls
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           pbl_tke_max(ig, l) = fraca(ig, l) * therm_tke_max(ig, l) + (1. - fraca(ig, l)) * env_tke_max(ig, l)         !  Recalcul de TKE moyenne après transport de TKE_TH
           env_tke_max(ig, l) = (pbl_tke_max(ig, l) - fraca(ig, l) * therm_tke_max(ig, l)) / (1. - fraca(ig, l))       !  Recalcul de TKE dans  l'environnement après transport de TKE_TH
@@ -211,5 +211,5 @@
       !    print *,' apres w_ls = '   !!jyg
 
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (ok_lcl(ig)) THEN
           fraca0(ig) = fraca(ig, klcl(ig)) + (fraca(ig, klcl(ig) + 1) &
@@ -252,5 +252,5 @@
 
       !-----Epaisseur du nuage (depth) et détermination de la queue du spectre de panaches (n2,s2) et du panache le plus gros (s_max)
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         zmax_moy(ig) = zlcl(ig) + zmax_moy_coef * (zmax(ig) - zlcl(ig))
         depth(ig) = zmax_moy(ig) - zlcl(ig)
@@ -276,5 +276,5 @@
         strig(:) = s_trig
       ELSE IF (iflag_strig==1) THEN
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           !         zcong_moy(ig)=zlcl(ig)+zmax_moy_coef*(zcong(ig)-zlcl(ig))
           !         strig(ig)=(hcoef*(zcong_moy(ig)-zlcl(ig))+hmin(ig))**2
@@ -282,5 +282,5 @@
         enddo
       ELSE IF (iflag_strig==2) THEN
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           IF (h_trig>zlcl(ig)) THEN
             strig(ig) = (h_trig - zlcl(ig))**2
@@ -293,5 +293,5 @@
       susqr2pi = su_cst * sqrt(2. * Rpi)
       reuler = exp(1.)
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF ((depth(ig)>=10.) .AND. (s_max(ig)>susqr2pi * reuler)) THEN
           w_max(ig) = w0(ig) * (1. + sqrt(2. * log(s_max(ig) / susqr2pi) - log(2. * log(s_max(ig) / susqr2pi))))
@@ -311,5 +311,5 @@
 
       !-----Calcul de ALP_BL_STAT
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         alp_bl_det(ig) = 0.5 * coef_m * rhobarz0(ig) * (w0(ig)**3) * fraca0(ig) * (1. - 2. * fraca0(ig)) / ((1. - fraca0(ig))**2)
         alp_bl_fluct_m(ig) = 1.5 * rhobarz0(ig) * fraca0(ig) * (w_conv(ig) + coef_m * w0(ig)) * &
@@ -327,5 +327,5 @@
 
       !-----Sécurité ALP infinie
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (fraca0(ig)>0.98) alp_bl_stat(ig) = 2.
       enddo
@@ -340,6 +340,6 @@
     ale_bl(:) = 0.
     !          PRINT*,'ALE,ALP ,l,zw2(ig,l),ale_bl(ig),alp_bl(ig)'
-    do l = 1, nlay
-      do ig = 1, ngrid
+    DO l = 1, nlay
+      DO ig = 1, ngrid
         alp_bl(ig) = max(alp_bl(ig), 0.5 * rhobarz(ig, l) * wth3(ig, l))
         ale_bl(ig) = max(ale_bl(ig), 0.5 * zw2(ig, l)**2)
@@ -359,6 +359,6 @@
     lalim_conv(:) = lalim(:)
 
-    do k = 1, nlay
-      do ig = 1, ngrid
+    DO k = 1, nlay
+      DO ig = 1, ngrid
         IF (k<=lalim_conv(ig)) fm_tot(ig) = fm_tot(ig) + fm(ig, k)
       enddo
@@ -367,6 +367,6 @@
     ! assez bizarre car, si on est dans la couche d'alim et que alim_star et
     ! plus petit que 1.e-10, on prend wght_th=1.
-    do k = 1, nlay
-      do ig = 1, ngrid
+    DO k = 1, nlay
+      DO ig = 1, ngrid
         IF (k<=lalim_conv(ig).AND.alim_star(ig, k)>1.e-10) THEN
           wght_th(ig, k) = alim_star(ig, k)
@@ -377,5 +377,5 @@
     !      PRINT*,'apres wght_th'
     !test pour prolonger la convection
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       !v1d  if ((alim_star(ig,1).lt.1.e-10).AND.(therm)) THEN
       IF ((alim_star(ig, 1)<1.e-10)) THEN
@@ -395,6 +395,6 @@
     alp_int(:) = 0.
     dp_int(:) = 0.
-    do l = 2, nlay
-      do ig = 1, ngrid
+    DO l = 2, nlay
+      DO ig = 1, ngrid
         IF(l<=lmax(ig)) THEN
           zdp = pplay(ig, l - 1) - pplay(ig, l)
@@ -406,5 +406,5 @@
 
     IF (iflag_coupl>=3 .AND. iflag_coupl<=5) THEN
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         !valeur integree de alp_bl * 0.5:
         IF (dp_int(ig)>0.) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_closure.F90	(revision 5158)
@@ -52,5 +52,5 @@
 !   alim_star^2/(rho dz)
 DO k=1,llmax-1
-   do ig=1,ngrid
+   DO ig=1,ngrid
       IF (k<lalim(ig)) THEN
          alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_down.F90	(revision 5158)
@@ -71,6 +71,6 @@
     ! Dans ce cas, pas besoin d'initialiser tracd(lmax) ( =trac(lmax) )
     ! Boucle pour le downdraft
-    do ilay = nlay, 1, -1
-      do ig = 1, ngrid
+    DO ilay = nlay, 1, -1
+      DO ig = 1, ngrid
         !if ( lmax(ig) > nlay - 2 ) stop "les thermiques montent trop haut"
         IF (ilay<=lmax(ig) .AND. lmax(ig)>1) THEN
@@ -88,6 +88,6 @@
 
     !Boucle pour l'updraft
-    do ilay = 1, nlay, 1
-      do ig = 1, ngrid
+    DO ilay = 1, nlay, 1
+      DO ig = 1, ngrid
         IF (ilay<lmax(ig) .AND. lmax(ig)>1) THEN
           fup(ig, ilay + 1) = fup(ig, ilay) + eup(ig, ilay) - dup(ig, ilay)
@@ -115,6 +115,6 @@
     fc(:, 1) = 0.
     fc(:, nlay + 1) = 0.
-    do ilay = 2, nlay, 1 !boucle sur les interfaces
-      do ig = 1, ngrid
+    DO ilay = 2, nlay, 1 !boucle sur les interfaces
+      DO ig = 1, ngrid
         fthu(ig, ilay) = fup(ig, ilay) * tracu(ig, ilay - 1)
         fthd(ig, ilay) = -fdn(ig, ilay) * tracd(ig, ilay)
@@ -127,6 +127,6 @@
     !Methode explicite :
     IF(iflag_impl==0) THEN
-      do ilay = 2, nlay, 1
-        do ig = 1, ngrid
+      DO ilay = 2, nlay, 1
+        DO ig = 1, ngrid
           !!!!ATTENTION HYPOTHESE de FLUX COMPENSATOIRE DESCENDANT ET DONC comme schema amont on va chercher trac au dessus!!!!!
           !!!! tentative de prise en compte d'un flux compensatoire montant  !!!!
@@ -144,6 +144,6 @@
       enddo
       !Boucle pour calculer trac
-      do ilay = 1, nlay
-        do ig = 1, ngrid
+      DO ilay = 1, nlay
+        DO ig = 1, ngrid
           dtrac(ig, ilay) = (fthtot(ig, ilay) - fthtot(ig, ilay + 1)) / masse(ig, ilay)
           !         trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay))
@@ -155,6 +155,6 @@
       WRITE(*, *) 'nouveau schéma explicite !!!'
       !!! Calcul de s1
-      do ilay = 1, nlay
-        do ig = 1, ngrid
+      DO ilay = 1, nlay
+        DO ig = 1, ngrid
           s1(ig, ilay) = fthu(ig, ilay) - fthu(ig, ilay + 1) + fthd(ig, ilay) - fthd(ig, ilay + 1)
           s2(ig, ilay) = s1(ig, ilay) + fthe(ig, ilay) - fthe(ig, ilay + 1)
@@ -162,6 +162,6 @@
       enddo
 
-      do ilay = 2, nlay, 1
-        do ig = 1, ngrid
+      DO ilay = 2, nlay, 1
+        DO ig = 1, ngrid
           IF (fup(ig, ilay) - fdn(ig, ilay) < 0.) THEN
             CALL abort_physic("thermcell_updown_dq", 'flux compensatoire ' &
@@ -174,6 +174,6 @@
       enddo
       !Boucle pour calculer trac
-      do ilay = 1, nlay
-        do ig = 1, ngrid
+      DO ilay = 1, nlay
+        DO ig = 1, ngrid
           ! dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))/masse(ig,ilay)
           dtrac(ig, ilay) = (s1(ig, ilay) + fthe(ig, ilay) - fthe(ig, ilay + 1)) / masse(ig, ilay)
@@ -184,6 +184,6 @@
 
     ELSE IF (iflag_impl==1) THEN
-      do ilay = 1, nlay
-        do ig = 1, ngrid
+      DO ilay = 1, nlay
+        DO ig = 1, ngrid
           s1(ig, ilay) = fthu(ig, ilay) - fthu(ig, ilay + 1) + fthd(ig, ilay) - fthd(ig, ilay + 1)
         enddo
@@ -191,6 +191,6 @@
 
       !Boucle pour calculer traci = trac((t+dt)
-      do ilay = nlay - 1, 1, -1
-        do ig = 1, ngrid
+      DO ilay = nlay - 1, 1, -1
+        DO ig = 1, ngrid
           IF((fup(ig, ilay) - fdn(ig, ilay)) < 0) THEN
             WRITE(*, *) 'flux compensatoire montant, cas non traite par thermcell_updown_dq dans le cas d une resolution implicite, ilay : ', ilay
@@ -202,6 +202,6 @@
         enddo
       enddo
-      do ilay = 1, nlay
-        do ig = 1, ngrid
+      DO ilay = 1, nlay
+        DO ig = 1, ngrid
           dtrac(ig, ilay) = (traci(ig, ilay) - tracold(ig, ilay)) / ptimestep
         enddo
@@ -269,6 +269,6 @@
     !   de la possible nulit?? du d??nominateur
 
-    do ilay = nlay, 1, -1
-      do ig = 1, ngrid
+    DO ilay = nlay, 1, -1
+      DO ig = 1, ngrid
         IF (ilay<=lmax(ig).AND.lmax(ig)>1) THEN
           edn(ig, ilay) = fact_thermals_down * dup(ig, ilay)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dq.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dq.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dq.F90	(revision 5158)
@@ -53,6 +53,6 @@
       ! Calcul du critere CFL pour l'advection dans la subsidence
       cfl = 0.
-      do k = 1, nlay
-        do ig = 1, ngrid
+      DO k = 1, nlay
+        DO ig = 1, ngrid
           zzm = masse(ig, k) / ptimestep
           cfl = max(cfl, fm(ig, k) / zzm)
@@ -70,6 +70,6 @@
 
       !   calcul du detrainement
-      do k = 1, nlay
-        do ig = 1, ngrid
+      DO k = 1, nlay
+        DO ig = 1, ngrid
           detr(ig, k) = fm(ig, k) - fm(ig, k + 1) + entr(ig, k)
           !           PRINT*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
@@ -91,10 +91,10 @@
 
       ! Computation of tracer concentrations in the ascending plume
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         qa(ig, 1) = q(ig, 1)
       enddo
 
-      do k = 2, nlay
-        do ig = 1, ngrid
+      DO k = 2, nlay
+        DO ig = 1, ngrid
           IF ((fm(ig, k + 1) + detr(ig, k)) * ptimestep>  &
                   1.e-5 * masse(ig, k)) THEN
@@ -114,5 +114,5 @@
 
       ! Plume vertical flux
-      do k = 2, nlay - 1
+      DO k = 2, nlay - 1
         fqa(:, k) = fm(:, k) * qa(:, k - 1)
       enddo
@@ -122,10 +122,10 @@
       ! Trace species evolution
       IF (impl==0) THEN
-        do k = 1, nlay - 1
+        DO k = 1, nlay - 1
           q(:, k) = q(:, k) + (fqa(:, k) - fqa(:, k + 1) - fm(:, k) * q(:, k) + fm(:, k + 1) * q(:, k + 1)) &
                   * ptimestep / masse(:, k)
         enddo
       else
-        do k = nlay - 1, 1, -1
+        DO k = nlay - 1, 1, -1
           ! FH debut de modif : le calcul ci dessous modifiait numériquement
           ! la concentration quand le flux de masse etait nul car on divisait
@@ -140,6 +140,6 @@
 
       ! Tendencies
-      do k = 1, nlay
-        do ig = 1, ngrid
+      DO k = 1, nlay
+        DO ig = 1, ngrid
           dq(ig, k) = (q(ig, k) - qold(ig, k)) / ptimestep
           q(ig, k) = qold(ig, k)
@@ -196,6 +196,6 @@
     ! Calcul du critere CFL pour l'advection dans la subsidence
     cfl = 0.
-    do k = 1, nlay
-      do ig = 1, ngrid
+    DO k = 1, nlay
+      DO ig = 1, ngrid
         zzm = masse(ig, k) / ptimestep
         cfl = max(cfl, fm(ig, k) / zzm)
@@ -225,6 +225,6 @@
 
       !   calcul du detrainement
-      do k = 1, nlay
-        do ig = 1, ngrid
+      DO k = 1, nlay
+        DO ig = 1, ngrid
           detr(ig, k) = fm(ig, k) - fm(ig, k + 1) + entr(ig, k)
           !           PRINT*,'Q2 DQ ',detr(ig,k),fm(ig,k),entr(ig,k)
@@ -246,10 +246,10 @@
 
       !   calcul de la valeur dans les ascendances
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         qa(ig, 1) = q(ig, 1)
       enddo
 
-      do k = 2, nlay
-        do ig = 1, ngrid
+      DO k = 2, nlay
+        DO ig = 1, ngrid
           IF ((fm(ig, k + 1) + detr(ig, k)) * ztimestep>  &
                   1.e-5 * masse(ig, k)) THEN
@@ -270,6 +270,6 @@
       ! Calcul du flux subsident
 
-      do k = 2, nlay
-        do ig = 1, ngrid
+      DO k = 2, nlay
+        DO ig = 1, ngrid
 #undef centre
 #ifdef centre
@@ -296,5 +296,5 @@
         enddo
       enddo
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         wqd(ig, 1) = 0.
         wqd(ig, nlay + 1) = 0.
@@ -303,6 +303,6 @@
 
       ! Calcul des tendances
-      do k = 1, nlay
-        do ig = 1, ngrid
+      DO k = 1, nlay
+        DO ig = 1, ngrid
           q(ig, k) = q(ig, k) + (detr(ig, k) * qa(ig, k) - entr(ig, k) * q(ig, k)  &
                   - wqd(ig, k) + wqd(ig, k + 1))  &
@@ -318,6 +318,6 @@
 
     ! Calcul des tendances
-    do k = 1, nlay
-      do ig = 1, ngrid
+    DO k = 1, nlay
+      DO ig = 1, ngrid
         dq(ig, k) = (q(ig, k) - qold(ig, k)) / ptimestep
         q(ig, k) = qold(ig, k)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dry.F90	(revision 5158)
@@ -38,16 +38,16 @@
 
 !initialisations
-       do ig=1,ngrid
-          do l=1,nlay+1
+       DO ig=1,ngrid
+          DO l=1,nlay+1
              zw2(ig,l)=0.
              wa_moy(ig,l)=0.
           enddo
        enddo
-       do ig=1,ngrid
-          do l=1,nlay
+       DO ig=1,ngrid
+          DO l=1,nlay
              ztva(ig,l)=ztv(ig,l)
           enddo
        enddo
-       do ig=1,ngrid
+       DO ig=1,ngrid
           wmax(ig)=0.
           wmaxa(ig)=0.
@@ -58,5 +58,5 @@
 ! Calcul des F^*, integrale verticale de E^*
        f_star(:,1)=0.
-       do l=1,nlay
+       DO l=1,nlay
           f_star(:,l+1)=f_star(:,l)+alim_star(:,l)
        enddo
@@ -71,6 +71,6 @@
 ! lmax
 
-       do l=1,nlay-2
-         do ig=1,ngrid
+       DO l=1,nlay-2
+         DO ig=1,ngrid
             IF (l==lmin(ig).AND.lalim(ig)>1) THEN
 !------------------------------------------------------------------------
@@ -136,10 +136,10 @@
 
 ! Determination de zw2 max
-      do ig=1,ngrid
+      DO ig=1,ngrid
          wmax(ig)=0.
       enddo
 
-      do l=1,nlay
-         do ig=1,ngrid
+      DO l=1,nlay
+         DO ig=1,ngrid
             IF (l<=lmax(ig)) THEN
                 zw2(ig,l)=sqrt(zw2(ig,l))
@@ -152,9 +152,9 @@
 
 !   Longueur caracteristique correspondant a la hauteur des thermiques.
-      do  ig=1,ngrid
+      DO  ig=1,ngrid
          zmax(ig)=0.
          zlevinter(ig)=zlev(ig,1)
       enddo
-      do  ig=1,ngrid
+      DO  ig=1,ngrid
 ! calcul de zlevinter
           zlevinter(ig)=zlev(ig,lmax(ig)) + &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90	(revision 5158)
@@ -40,5 +40,5 @@
 
 !   calcul du detrainement
-      do k=1,nlay
+      DO k=1,nlay
          detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
          masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
@@ -51,5 +51,5 @@
       detr(:,1)=0.5*detr0(:,1)
       fm(:,1)=0.
-      do k=1,nlay-1
+      DO k=1,nlay-1
          masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
          entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
@@ -65,5 +65,5 @@
    q(:,:)=tke(:,:,isrf)
 !   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
+      DO ig=1,ngrid
          qa(ig,1)=q(ig,1)
       enddo
@@ -71,6 +71,6 @@
 
     IF (1==1) THEN
-      do k=2,nlay
-         do ig=1,ngrid
+      DO k=2,nlay
+         DO ig=1,ngrid
             IF ((fm(ig,k+1)+detr(ig,k))*ptimestep>  &
            1.e-5*masse(ig,k)) THEN
@@ -91,6 +91,6 @@
 ! Calcul du flux subsident
 
-      do k=2,nlay
-         do ig=1,ngrid
+      DO k=2,nlay
+         DO ig=1,ngrid
             wqd(ig,k)=fm(ig,k)*q(ig,k)
             IF (wqd(ig,k)<0.) THEN
@@ -99,5 +99,5 @@
          enddo
       enddo
-      do ig=1,ngrid
+      DO ig=1,ngrid
          wqd(ig,1)=0.
          wqd(ig,nlay+1)=0.
@@ -106,6 +106,6 @@
 
 ! Calcul des tendances
-      do k=1,nlay
-         do ig=1,ngrid
+      DO k=1,nlay
+         DO ig=1,ngrid
             q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
                  -wqd(ig,k)+wqd(ig,k+1))  &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dv2.F90	(revision 5158)
@@ -53,6 +53,6 @@
       nlarga0=0.
 
-      do k=1,nlay
-         do ig=1,ngrid
+      DO k=1,nlay
+         DO ig=1,ngrid
             detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
          enddo
@@ -60,5 +60,5 @@
 
 !   calcul de la valeur dans les ascendances
-      do ig=1,ngrid
+      DO ig=1,ngrid
          ua(ig,1)=u(ig,1)
          va(ig,1)=v(ig,1)
@@ -70,6 +70,6 @@
         'WARNING on initialise gamma(1:ngrid,1)=0.'
       gamma(1:ngrid,1)=0.
-      do k=2,nlay
-         do ig=1,ngrid
+      DO k=2,nlay
+         DO ig=1,ngrid
             ltherm(ig,k)=(fm(ig,k+1)+detr(ig,k))*ptimestep > 1.e-5*masse(ig,k)
             IF(ltherm(ig,k).AND.larga(ig)>0.) THEN
@@ -87,7 +87,7 @@
       gamma(:,:)=0.
 
-      do k=2,nlay
+      DO k=2,nlay
 
-         do ig=1,ngrid
+         DO ig=1,ngrid
             IF (ltherm(ig,k)) THEN
                dua(ig,k)=ua(ig,k-1)-u(ig,k-1)
@@ -105,5 +105,5 @@
 !----------------------
 DO iter=1,5
-         do ig=1,ngrid
+         DO ig=1,ngrid
 ! Pour memoire : calcul prenant en compte la fraction reelle
 !              zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
@@ -145,11 +145,11 @@
 ! Calcul du flux vertical de moment dans l'environnement.
 !---------------------------------------------------------
-      do k=2,nlay
-         do ig=1,ngrid
+      DO k=2,nlay
+         DO ig=1,ngrid
             wud(ig,k)=fm(ig,k)*ue(ig,k)
             wvd(ig,k)=fm(ig,k)*ve(ig,k)
          enddo
       enddo
-      do ig=1,ngrid
+      DO ig=1,ngrid
          wud(ig,1)=0.
          wud(ig,nlay+1)=0.
@@ -160,6 +160,6 @@
 ! calcul des tendances.
 !-----------------------
-      do k=1,nlay
-         do ig=1,ngrid
+      DO k=1,nlay
+         DO ig=1,ngrid
             du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)  &
                  -(entr(ig,k)+gamma(ig,k))*ue(ig,k)  &
@@ -178,6 +178,6 @@
 
    IF(prt_level>=10) THEN
-      do k=1,nlay
-         do ig=1,ngrid
+      DO k=1,nlay
+         DO ig=1,ngrid
            PRINT*,'th_dv2 ig k gamma entr detr ua ue va ve wud wvd masse',ig,k,gamma(ig,k), &
      entr(ig,k),detr(ig,k),ua(ig,k),ue(ig,k),va(ig,k),ve(ig,k),wud(ig,k),wvd(ig,k),wud(ig,k+1),wvd(ig,k+1), &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90	(revision 5158)
@@ -51,6 +51,6 @@
 
    CALL thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
-   do ll=1,nlay
-      do ig=1,ngrid
+   DO ll=1,nlay
+      DO ig=1,ngrid
          zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
          zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
@@ -62,6 +62,6 @@
    IF (prt_level>=1) PRINT*,'0 OK convect8'
 
-   do ll=1,nlay
-      do ig=1,ngrid
+   DO ll=1,nlay
+      DO ig=1,ngrid
           zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
           zu(ig,ll)=pu(ig,ll)
@@ -79,10 +79,10 @@
    enddo
 !CR: Calcul du niveau de congelation
-   do ig=1,ngrid
+   DO ig=1,ngrid
       lcong(ig)=1
       lintercong(ig)=0.
    enddo
-   do ig=1,ngrid
-      do ll=1,nlay-1
+   DO ig=1,ngrid
+      DO ll=1,nlay-1
          IF ((zh(ig,ll)>273.15).AND.(zh(ig,ll+1)<=273.15)) THEN
             lcong(ig)=ll+1
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90	(revision 5158)
@@ -91,6 +91,6 @@
 
     IF (check_debug) THEN
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           IF (l<=lmax(ig)) THEN
             IF (entr_star(ig, l)>1.) THEN
@@ -119,5 +119,5 @@
     !-------------------------------------------------------------------------
 
-    do l = 1, nlay
+    DO l = 1, nlay
       entr(:, l) = f(:) * (entr_star(:, l) + alim_star(:, l))
       detr(:, l) = f(:) * detr_star(:, l)
@@ -136,6 +136,6 @@
 
     fm(:, 1) = 0.
-    do l = 1, nlay
-      do ig = 1, ngrid
+    DO l = 1, nlay
+      DO ig = 1, ngrid
         IF (l<lmax(ig)) THEN
           fm(ig, l + 1) = fm(ig, l) + entr(ig, l) - detr(ig, l)
@@ -155,6 +155,6 @@
     ! autres corrections.
 
-    do l = 1, nlay
-      do ig = 1, ngrid
+    DO l = 1, nlay
+      DO ig = 1, ngrid
         IF (detr(ig, l)>fm(ig, l)) THEN
           ncorecfm8 = ncorecfm8 + 1
@@ -179,7 +179,7 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-    do l = 1, nlay
-
-      do ig = 1, ngrid
+    DO l = 1, nlay
+
+      DO ig = 1, ngrid
         IF (l<lmax(ig)) THEN
           fm(ig, l + 1) = fm(ig, l) + entr(ig, l) - detr(ig, l)
@@ -198,5 +198,5 @@
 
       !     do l=1,nlay
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (fm(ig, l + 1)<0.) THEN
           !              PRINT*,'fm1<0',l+1,lmax(ig),fm(ig,l+1)
@@ -217,5 +217,5 @@
       IF (iflag_thermals_optflux==0) THEN
         !     do l=1,nlay
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           IF (l>=lalim(ig).AND.l<=lmax(ig) &
                   .AND.(zw2(ig, l + 1)>1.e-10).AND.(zw2(ig, l)>1.e-10)) THEN
@@ -243,5 +243,5 @@
       IF (iflag_thermals_optflux==0) THEN
         !     do l=1,nlay
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           IF ((fm(ig, l + 1)>fm(ig, l)).AND.(l>lalim(ig))) THEN
             f_old = fm(ig, l + 1)
@@ -267,5 +267,5 @@
 
         labort_physic = .FALSE.
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           IF (entr(ig, l)<0.) THEN
             labort_physic = .TRUE.
@@ -281,5 +281,5 @@
         endif
 
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           IF (detr(ig, l)>fm(ig, l)) THEN
             ncorecfm6 = ncorecfm6 + 1
@@ -307,5 +307,5 @@
 
         labort_physic = .FALSE.
-        do ig = 1, ngrid
+        DO ig = 1, ngrid
           IF (entr(ig, l)<0.) THEN
             labort_physic = .TRUE.
@@ -335,5 +335,5 @@
 
       !     do l=1,nlay
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (fm(ig, l + 1)<0.) THEN
           detr(ig, l) = detr(ig, l) + fm(ig, l + 1)
@@ -344,5 +344,5 @@
 
       labort_physic = .FALSE.
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (detr(ig, l)<0.) THEN
           labort_physic = .TRUE.
@@ -384,5 +384,5 @@
 
       !    do l=1,nlay
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (zw2(ig, l + 1)>1.e-10) THEN
           zfm = rhobarz(ig, l + 1) * zw2(ig, l + 1) * alphamax
@@ -419,6 +419,6 @@
     IF (1==1) THEN
       labort_physic = .FALSE.
-      do l = 1, nlay - 1
-        do ig = 1, ngrid
+      DO l = 1, nlay - 1
+        DO ig = 1, ngrid
           eee0 = entr(ig, l)
           ddd0 = detr(ig, l)
@@ -476,5 +476,5 @@
     !              ddd=detr(ig)-entre
     !on s assure que tout s annule bien en zmax
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       fm(ig, lmax(ig) + 1) = 0.
       entr(ig, lmax(ig)) = 0.
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_height.F90	(revision 5158)
@@ -28,9 +28,9 @@
 
 !calcul de la hauteur max du thermique
-      do ig=1,ngrid
+      DO ig=1,ngrid
          lmax(ig)=lalim(ig)
       enddo
-      do ig=1,ngrid
-         do l=nlay,lalim(ig)+1,-1
+      DO ig=1,ngrid
+         DO l=nlay,lalim(ig)+1,-1
             IF (zw2(ig,l)<=1.e-10) THEN
                lmax(ig)=l-1
@@ -41,5 +41,5 @@
 ! On traite le cas particulier qu'il faudrait éviter ou le thermique
 ! atteind le haut du modele ...
-      do ig=1,ngrid
+      DO ig=1,ngrid
       IF ( zw2(ig,nlay) > 1.e-10 ) THEN
           PRINT*,'WARNING !!!!! W2 thermiques non nul derniere couche '
@@ -49,5 +49,5 @@
 
 ! pas de thermique si couche 1 stable
-      do ig=1,ngrid
+      DO ig=1,ngrid
          IF (lmin(ig)>1) THEN
              lmax(ig)=1
@@ -58,10 +58,10 @@
 
 ! Determination de zw2 max
-      do ig=1,ngrid
+      DO ig=1,ngrid
          wmax(ig)=0.
       enddo
 
-      do l=1,nlay
-         do ig=1,ngrid
+      DO l=1,nlay
+         DO ig=1,ngrid
             IF (l<=lmax(ig)) THEN
                 IF (zw2(ig,l)<0.)THEN
@@ -77,5 +77,5 @@
 
 !   Longueur caracteristique correspondant a la hauteur des thermiques.
-      do  ig=1,ngrid
+      DO  ig=1,ngrid
          zmax(ig)=0.
          zlevinter(ig)=zlev(ig,1)
@@ -87,11 +87,11 @@
          num(:)=0.
          denom(:)=0.
-         do ig=1,ngrid
-          do l=1,nlay
+         DO ig=1,ngrid
+          DO l=1,nlay
              num(ig)=num(ig)+zw2(ig,l)*zlev(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
              denom(ig)=denom(ig)+zw2(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
           enddo
        enddo
-       do ig=1,ngrid
+       DO ig=1,ngrid
        IF (denom(ig)>1.e-10) THEN
           zmax(ig)=2.*num(ig)/denom(ig)
@@ -102,5 +102,5 @@
       else
 !CR:Calcul de zmax continu via le linter      
-      do  ig=1,ngrid
+      DO  ig=1,ngrid
 ! calcul de zlevinter
           zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*  &
@@ -114,5 +114,5 @@
 
 !CR:calcul du zcong
-      do  ig=1,ngrid
+      DO  ig=1,ngrid
 ! calcul de zlevintercong
          zlevintercong(ig)=(zlev(ig,lcong(ig)+1)-zlev(ig,lcong(ig)))*  &
@@ -127,5 +127,5 @@
 
 ! def de  zmix continu (profil parabolique des vitesses)
-      do ig=1,ngrid
+      DO ig=1,ngrid
            IF (lmix(ig)>1) THEN
 ! test 
@@ -158,6 +158,6 @@
 
 ! calcul du nouveau lmix correspondant
-      do ig=1,ngrid
-         do l=1,nlay
+      DO ig=1,ngrid
+         DO l=1,nlay
             IF (zmix(ig)>=zlev(ig,l).AND.  &
             zmix(ig)<zlev(ig,l+1)) THEN
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90	(revision 5158)
@@ -33,5 +33,5 @@
    ! depending on other flags.
 
-   real               :: fact_epsilon=0.002
+   REAL               :: fact_epsilon=0.002
 
 !$OMP THREADPRIVATE(r_aspect_thermals,tau_thermals,fact_thermals_ed_dz)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90	(revision 5158)
@@ -197,5 +197,5 @@
     !PRINT*,'thermcell_main debut'
     !     WRITE(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       f0(ig) = max(f0(ig), 1.e-2)
       zmax0(ig) = max(zmax0(ig), 40.)
@@ -204,5 +204,5 @@
 
     IF (prt_level>=20) THEN
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         PRINT*, 'th_main ig f0', ig, f0(ig)
       enddo
@@ -256,6 +256,6 @@
       ! contenu thermcell_env : enddo
 
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           zl(ig, l) = 0.
           zu(ig, l) = puwind(ig, l)
@@ -296,13 +296,13 @@
     !-----------------------------------------------------------------------
 
-    do l = 2, nlay
+    DO l = 2, nlay
       zlev(:, l) = 0.5 * (pphi(:, l) + pphi(:, l - 1)) / RG
     enddo
     zlev(:, 1) = 0.
     zlev(:, nlay + 1) = (2. * pphi(:, nlay) - pphi(:, nlay - 1)) / RG
-    do l = 1, nlay
+    DO l = 1, nlay
       zlay(:, l) = pphi(:, l) / RG
     enddo
-    do l = 1, nlay
+    DO l = 1, nlay
       deltaz(:, l) = zlev(:, l + 1) - zlev(:, l)
     enddo
@@ -315,8 +315,8 @@
     IF (prt_level>=10) WRITE(lunout, *) 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
     rhobarz(:, 1) = rho(:, 1)
-    do l = 2, nlay
+    DO l = 2, nlay
       rhobarz(:, l) = 0.5 * (rho(:, l) + rho(:, l - 1))
     enddo
-    do l = 1, nlay
+    DO l = 1, nlay
       masse(:, l) = (pplev(:, l) - pplev(:, l + 1)) / RG
     enddo
@@ -457,5 +457,5 @@
     ! Le probleme vient du fait que linter et lmix sont souvent egaux a 1.
     wmax_tmp = 0.
-    do  l = 1, nlay
+    DO  l = 1, nlay
       wmax_tmp(:) = max(wmax_tmp(:), zw2(:, l))
     enddo
@@ -562,10 +562,10 @@
     ! Calcul de la fraction de l'ascendance
     !------------------------------------------------------------------
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       fraca(ig, 1) = 0.
       fraca(ig, nlay + 1) = 0.
     enddo
-    do l = 2, nlay
-      do ig = 1, ngrid
+    DO l = 2, nlay
+      DO ig = 1, ngrid
         IF (zw2(ig, l)>1.e-10) THEN
           fraca(ig, l) = fm(ig, l) / (rhobarz(ig, l) * zw2(ig, l))
@@ -592,6 +592,6 @@
 
       ! Temperature potentielle liquide effectivement mélangée par les thermiques
-      do ll = 1, nlay
-        do ig = 1, ngrid
+      DO ll = 1, nlay
+        DO ig = 1, ngrid
           zthl(ig, ll) = ptemp(ig, ll) / zpspsk(ig, ll)
         enddo
@@ -600,6 +600,6 @@
               zthl, zdthladj, zta, lev_out)
 
-      do ll = 1, nlay
-        do ig = 1, ngrid
+      DO ll = 1, nlay
+        DO ig = 1, ngrid
           z_o(ig, ll) = p_o(ig, ll)
         enddo
@@ -610,6 +610,6 @@
 #ifdef ISO
         ! C Risi: on utilise directement la meme routine
-        do ixt=1,ntiso
-          do ll=1,nlay
+        DO ixt=1,ntiso
+          DO ll=1,nlay
             DO ig=1,ngrid
                 xtpo_tmp(ig,ll)=xtpo(ixt,ig,ll)
@@ -619,5 +619,5 @@
           CALL thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
                      xtpo_tmp,xtpdoadj_tmp,xtzo_tmp,lev_out)
-          do ll=1,nlay
+          DO ll=1,nlay
             DO ig=1,ngrid
                 xtpdoadj(ixt,ig,ll)=xtpdoadj_tmp(ig,ll)
@@ -674,6 +674,6 @@
 
     !     PRINT*,'13 OK convect8'
-    do l = 1, nlay
-      do ig = 1, ngrid
+    DO l = 1, nlay
+      DO ig = 1, ngrid
         pdtadj(ig, l) = zdthladj(ig, l) * zpspsk(ig, l)
       enddo
@@ -690,10 +690,10 @@
       ! calcul du niveau de condensation
       ! initialisation
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         nivcon(ig) = 0
         zcon(ig) = 0.
       enddo
       !nouveau calcul
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         ! WARNING !!! verifier que c'est bien ztemp_env qu'on veut là
         CHI = ztemp_env(ig, 1) / (1669.0 - 122.0 * z_o(ig, 1) / zqsat(ig, 1) - ztemp_env(ig, 1))
@@ -701,6 +701,6 @@
       enddo
       !IM   do k=1,nlay
-      do k = 1, nlay - 1
-        do ig = 1, ngrid
+      DO k = 1, nlay - 1
+        DO ig = 1, ngrid
           IF ((pcon(ig)<=pplay(ig, k))  &
                   .AND.(pcon(ig)>pplay(ig, k + 1))) THEN
@@ -711,5 +711,5 @@
       !IM
       ierr = 0
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (pcon(ig)<=pplay(ig, nlay)) THEN
           zcon2(ig) = zlay(ig, nlay) - (pcon(ig) - pplay(ig, nlay)) / (RG * rho(ig, nlay)) / 100.
@@ -723,6 +723,6 @@
 
       IF (prt_level>=1) PRINT*, '14b OK convect8'
-      do k = nlay, 1, -1
-        do ig = 1, ngrid
+      DO k = nlay, 1, -1
+        DO ig = 1, ngrid
           IF (zqla(ig, k)>1e-10) THEN
             nivcon(ig) = k
@@ -734,6 +734,6 @@
       !calcul des moments
       !initialisation
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           q2(ig, l) = 0.
           wth2(ig, l) = 0.
@@ -746,6 +746,6 @@
       IF (prt_level>=10)WRITE(lunout, *)                                &
               'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           zf = fraca(ig, l)
           zf2 = zf / (1. - zf)
@@ -765,6 +765,6 @@
       enddo
       !calcul des flux: q, thetal et thetav
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           wq(ig, l) = fraca(ig, l) * zw2(ig, l) * (zqta(ig, l) * 1000. - p_o(ig, l) * 1000.)
           wthl(ig, l) = fraca(ig, l) * zw2(ig, l) * (ztla(ig, l) - zthl(ig, l))
@@ -779,6 +779,6 @@
       ratqsdiff(:, :) = 0.
 
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           IF (l<=lalim(ig)) THEN
             var = var + alim_star(ig, l) * zqta(ig, l) * 1000.
@@ -789,6 +789,6 @@
       IF (prt_level>=1) PRINT*, '14f OK convect8'
 
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           IF (l<=lalim(ig)) THEN
             zf = fraca(ig, l)
@@ -800,6 +800,6 @@
 
       IF (prt_level>=1) PRINT*, '14g OK convect8'
-      do l = 1, nlay
-        do ig = 1, ngrid
+      DO l = 1, nlay
+        DO ig = 1, ngrid
           ratqsdiff(ig, l) = sqrt(vardiff) / (p_o(ig, l) * 1000.)
         enddo
@@ -837,10 +837,10 @@
 
     !  test sur la hauteur des thermiques ...
-    do i = 1, ngrid
+    DO i = 1, ngrid
       !IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) THEN
       IF (prt_level>=10) THEN
         PRINT*, 'WARNING ', comment, ' au point ', i, ' K= ', long(i)
         PRINT*, '  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
-        do k = 1, nlay
+        DO k = 1, nlay
           WRITE(6, '(i3,7f10.3)') k, pplay(i, k), ztv(i, k), 1000 * p_o(i, k), ztva(i, k), 1000 * zqla(i, k), f_star(i, k), zw2(i, k)
         enddo
@@ -896,5 +896,5 @@
 
     !   calcul du detrainement
-    do k = 1, nlay
+    DO k = 1, nlay
       detr0(:, k) = fm0(:, k) - fm0(:, k + 1) + entr0(:, k)
       masse0(:, k) = (pplev(:, k) - pplev(:, k + 1)) / RG
@@ -907,5 +907,5 @@
     detr(:, 1) = 0.5 * detr0(:, 1)
     fm(:, 1) = 0.
-    do k = 1, nlay - 1
+    DO k = 1, nlay - 1
       masse(:, k + 1) = 0.5 * (masse0(:, k) + masse0(:, k + 1))
       entr(:, k + 1) = 0.5 * (entr0(:, k) + entr0(:, k + 1))
@@ -917,5 +917,5 @@
     q(:, :) = therm_tke_max(:, :)
     !!! nrlmd le 16/09/2010
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       qa(ig, 1) = q(ig, 1)
     enddo
@@ -923,6 +923,6 @@
 
     IF (1==1) THEN
-      do k = 2, nlay
-        do ig = 1, ngrid
+      DO k = 2, nlay
+        DO ig = 1, ngrid
           IF ((fm(ig, k + 1) + detr(ig, k)) * ptimestep>  &
                   1.e-5 * masse(ig, k)) THEN
@@ -943,6 +943,6 @@
       ! Calcul du flux subsident
 
-      do k = 2, nlay
-        do ig = 1, ngrid
+      DO k = 2, nlay
+        DO ig = 1, ngrid
           wqd(ig, k) = fm(ig, k) * q(ig, k)
           IF (wqd(ig, k)<0.) THEN
@@ -951,5 +951,5 @@
         enddo
       enddo
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         wqd(ig, 1) = 0.
         wqd(ig, nlay + 1) = 0.
@@ -957,6 +957,6 @@
 
       ! Calcul des tendances
-      do k = 1, nlay
-        do ig = 1, ngrid
+      DO k = 1, nlay
+        DO ig = 1, ngrid
           q(ig, k) = q(ig, k) + (detr(ig, k) * qa(ig, k) - entr(ig, k) * q(ig, k)  &
                   - wqd(ig, k) + wqd(ig, k + 1))  &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume.f90	(revision 5158)
@@ -169,5 +169,5 @@
     ! dans une couche l>1
     !------------------------------------------------------------------------------
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       ! Le panache va prendre au debut les caracteristiques de l'air contenu
       ! dans cette couche.
@@ -188,5 +188,5 @@
     !boucle de calcul de la vitesse verticale dans le thermique
     !==============================================================================
-    do l = 2, nlay - 1
+    DO l = 2, nlay - 1
       !==============================================================================
 
@@ -194,5 +194,5 @@
       ! On decide si le thermique est encore actif ou non
       ! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         active(ig) = active(ig) &
                 &                 .AND. zw2(ig, l)>1.e-10 &
@@ -214,5 +214,5 @@
       ztemp(:) = zpspsk(:, l) * ztla(:, l - 1)
       CALL thermcell_qsat(ngrid, active, pplev(:, l), ztemp, zqta(:, l - 1), zqsat(:))
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         !       PRINT*,'active',active(ig),ig,l
         IF(active(ig)) THEN
@@ -250,5 +250,5 @@
           zdz2 = zlev(ig, lt) - zlev(ig, l)
 
-          do while (lmel>zdz2)
+          DO while (lmel>zdz2)
             lt = lt + 1
             zlt = zlev(ig, lt)
@@ -283,5 +283,5 @@
       !-------------------------------------------------
 
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (active(ig)) THEN
           !          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
@@ -331,5 +331,5 @@
 
       activetmp(:) = active(:) .AND. f_star(:, l + 1)>1.e-10
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (activetmp(ig)) THEN
           Zsat = .FALSE.
@@ -346,5 +346,5 @@
       ztemp(:) = zpspsk(:, l) * ztla(:, l)
       CALL thermcell_qsat(ngrid, activetmp, pplev(:, l), ztemp, zqta(:, l), zqsatth(:, l))
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (activetmp(ig)) THEN
           ! on ecrit de maniere conservative (sat ou non)
@@ -376,5 +376,5 @@
 
       nbpb = 0
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (zw2(ig, l + 1)>0. .AND. zw2(ig, l + 1)<1.e-10) THEN
           !               stop 'On tombe sur le cas particulier de thermcell_dry'
@@ -420,9 +420,9 @@
 
     !on recalcule alim_star_tot
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       alim_star_tot(ig) = 0.
     enddo
-    do ig = 1, ngrid
-      do l = 1, lalim(ig) - 1
+    DO ig = 1, ngrid
+      DO l = 1, lalim(ig) - 1
         alim_star_tot(ig) = alim_star_tot(ig) + alim_star(ig, l)
       enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_plume_6A.f90	(revision 5158)
@@ -170,5 +170,5 @@
     ! dans une couche l>1
     !------------------------------------------------------------------------------
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       ! Le panache va prendre au debut les caracteristiques de l'air contenu
       ! dans cette couche.
@@ -189,5 +189,5 @@
     !boucle de calcul de la vitesse verticale dans le thermique
     !==============================================================================
-    do l = 2, nlay - 1
+    DO l = 2, nlay - 1
       !==============================================================================
 
@@ -195,5 +195,5 @@
       ! On decide si le thermique est encore actif ou non
       ! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         active(ig) = active(ig) &
                 &                 .AND. zw2(ig, l)>1.e-10 &
@@ -215,5 +215,5 @@
       ztemp(:) = zpspsk(:, l) * ztla(:, l - 1)
       CALL thermcell_qsat(ngrid, active, pplev(:, l), ztemp, zqta(:, l - 1), zqsat(:))
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         !       PRINT*,'active',active(ig),ig,l
         IF(active(ig)) THEN
@@ -252,5 +252,5 @@
             ! afin de faire moins de calcul dans la boucle
             !--------------------------------------------------
-            do while (zlmelup>zltup)
+            DO while (zlmelup>zltup)
               lt = lt + 1
               zlt = zlev(ig, lt)
@@ -334,5 +334,5 @@
             zdz2 = zlev(ig, lt) - zlev(ig, l)
 
-            do while (lmel>zdz2)
+            DO while (lmel>zdz2)
               lt = lt + 1
               zlt = zlev(ig, lt)
@@ -440,5 +440,5 @@
       !-------------------------------------------------
 
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (active(ig)) THEN
           !          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
@@ -530,5 +530,5 @@
 
       activetmp(:) = active(:) .AND. f_star(:, l + 1)>1.e-10
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (activetmp(ig)) THEN
           Zsat = .FALSE.
@@ -545,5 +545,5 @@
       ztemp(:) = zpspsk(:, l) * ztla(:, l)
       CALL thermcell_qsat(ngrid, activetmp, pplev(:, l), ztemp, zqta(:, l), zqsatth(:, l))
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (activetmp(ig)) THEN
           ! on ecrit de maniere conservative (sat ou non)
@@ -614,5 +614,5 @@
 
       nbpb = 0
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (zw2(ig, l + 1)>0. .AND. zw2(ig, l + 1)<1.e-10) THEN
           !               stop 'On tombe sur le cas particulier de thermcell_dry'
@@ -658,9 +658,9 @@
 
     !on recalcule alim_star_tot
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       alim_star_tot(ig) = 0.
     enddo
-    do ig = 1, ngrid
-      do l = 1, lalim(ig) - 1
+    DO ig = 1, ngrid
+      DO l = 1, lalim(ig) - 1
         alim_star_tot(ig) = alim_star_tot(ig) + alim_star(ig, l)
       enddo
@@ -817,6 +817,6 @@
     ! Definition de l'alimentation
     !-------------------------------------------------------------------------
-    do l = 1, nlay - 1
-      do ig = 1, ngrid
+    DO l = 1, nlay - 1
+      DO ig = 1, ngrid
         IF (ztv(ig, l)> ztv(ig, l + 1) .AND. ztv(ig, 1)>=ztv(ig, l)) THEN
           alim_star(ig, l) = MAX((ztv(ig, l) - ztv(ig, l + 1)), 0.)  &
@@ -827,6 +827,6 @@
       enddo
     enddo
-    do l = 1, nlay
-      do ig = 1, ngrid
+    DO l = 1, nlay
+      DO ig = 1, ngrid
         IF (alim_star_tot(ig) > 1.e-10) THEN
           alim_star(ig, l) = alim_star(ig, l) / alim_star_tot(ig)
@@ -845,5 +845,5 @@
     ! dans une couche l>1
     !------------------------------------------------------------------------------
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       ! Le panache va prendre au debut les caracteristiques de l'air contenu
       ! dans cette couche.
@@ -864,5 +864,5 @@
     !boucle de calcul de la vitesse verticale dans le thermique
     !==============================================================================
-    do l = 2, nlay - 1
+    DO l = 2, nlay - 1
       !==============================================================================
 
@@ -870,5 +870,5 @@
       ! On decide si le thermique est encore actif ou non
       ! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         active(ig) = active(ig) &
                 &                 .AND. zw2(ig, l)>1.e-10 &
@@ -891,5 +891,5 @@
       CALL thermcell_qsat(ngrid, active, pplev(:, l), ztemp, zqta(:, l - 1), zqsat(:))
 
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         !       PRINT*,'active',active(ig),ig,l
         IF(active(ig)) THEN
@@ -922,5 +922,5 @@
       !-------------------------------------------------
 
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (active(ig)) THEN
           zw2m = max(0.5 * (w_est(ig, l) + w_est(ig, l + 1)), 0.1)
@@ -959,5 +959,5 @@
       !---------------------------------------------------------------------------
       activetmp(:) = active(:) .AND. f_star(:, l + 1)>1.e-10
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (activetmp(ig)) THEN
           Zsat = .FALSE.
@@ -975,5 +975,5 @@
       CALL thermcell_qsat(ngrid, activetmp, pplev(:, l), ztemp, zqta(:, l), zqsatth(:, l))
 
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (activetmp(ig)) THEN
           ! on ecrit de maniere conservative (sat ou non)
@@ -1003,5 +1003,5 @@
 
       nbpb = 0
-      do ig = 1, ngrid
+      DO ig = 1, ngrid
         IF (zw2(ig, l + 1)>0. .AND. zw2(ig, l + 1)<1.e-10) THEN
           !               stop 'On tombe sur le cas particulier de thermcell_dry'
@@ -1046,9 +1046,9 @@
 
     !on recalcule alim_star_tot
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       alim_star_tot(ig) = 0.
     enddo
-    do ig = 1, ngrid
-      do l = 1, lalim(ig) - 1
+    DO ig = 1, ngrid
+      DO l = 1, lalim(ig) - 1
         alim_star_tot(ig) = alim_star_tot(ig) + alim_star(ig, l)
       enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_qsat.F90	(revision 5158)
@@ -74,5 +74,5 @@
     DO iter = 1, 10
       afaire(:) = abs(DT(:))>DDT0
-      do ig = 1, klon
+      DO ig = 1, klon
         IF (afaire(ig)) THEN
           Tbef(ig) = Tbef(ig) + DT(ig)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90	(revision 5158)
@@ -1055,5 +1055,5 @@
           ! c        PRINT*, 'd_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
           ! c     $  death_rate(i),ktop(i),kupper(i)',
-          ! c     $	         d_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
+          ! c     $             d_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
           ! c     $  death_rate(i),ktop(i),kupper(i)
     
@@ -1169,7 +1169,7 @@
     ! c      DO i=1,klon
     ! c        PRINT*,'Pente entre 0 et kupper (reference)'
-    ! c     $   	,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
+    ! c     $       ,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
     ! c        PRINT*,'Pente entre ktop et kupper'
-    ! c     $  	,(omg(i,kupper(i)+1)-omgtop(i))/(pupper(i)-ptop(i))
+    ! c     $      ,(omg(i,kupper(i)+1)-omgtop(i))/(pupper(i)-ptop(i))
     ! c      ENDDO
     ! c
@@ -2660,5 +2660,5 @@
  
     ! On se limite ?? des poches avec integrale dT * dp < -wk_int_delta_t_min
-    do i=1,klon
+    DO i=1,klon
           IF (int_dth(i,k_ptop_provis(i)) > -wk_int_delta_t_min .OR. k_ptop_provis(i)==1) THEN
           !if (1==0) THEN
@@ -2740,5 +2740,5 @@
 !if (iflag_wk_new_ptop==2) THEN
 IF (iflag_wk_new_ptop>0) THEN 
-   do i=1,klon
+   DO i=1,klon
       ptop(i)=ptop1(i)
       ktop(i)=ktop1(i)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_yomcst2.f90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_yomcst2.f90	(revision 5158)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_yomcst2.f90	(revision 5158)
@@ -0,0 +1,13 @@
+MODULE lmdz_yomcst2
+  IMPLICIT NONE; PRIVATE
+  PUBLIC gammas, alphas, betas, Fmax, scut, qqa1, qqa2, qqa3, Qcoef1max, &
+          Qcoef2max, Supcrit1, Supcrit2, choice, iflag_mix, coef_clos_ls, iflag_mix_adiab
+
+  INTEGER choice, iflag_mix, iflag_mix_adiab
+  REAL  gammas, alphas, betas, Fmax, qqa1, qqa2, qqa3, scut
+  REAL  Qcoef1max, Qcoef2max, Supcrit1, Supcrit2
+  REAL coef_clos_ls
+
+  !$OMP THREADPRIVATE(gammas, alphas, betas, Fmax, scut, qqa1, qqa2, qqa3, Qcoef1max, &
+  !$OMP     Qcoef2max, Supcrit1, Supcrit2, choice, iflag_mix, coef_clos_ls, iflag_mix_adiab)
+END MODULE lmdz_yomcst2
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90	(revision 5158)
@@ -161,5 +161,5 @@
     ! above the middle of layer "k":
     sigma_mass(:, nbp_lev) = zmasse(:, nbp_lev) * q(:, nbp_lev) ! top layer
-    do k =  nbp_lev - 1, 1, -1
+    DO k =  nbp_lev - 1, 1, -1
        sigma_mass(:, k) = sigma_mass(:, k+1) + zmasse(:, k) * q(:, k)
     END DO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/oasis.F90	(revision 5158)
@@ -155,6 +155,6 @@
         clmodnam = 'LMDZ'                  ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
     ELSE
-	abort_message='Pb : type of grid unknown'
-	CALL abort_physic(modname,abort_message,1)
+    abort_message='Pb : type of grid unknown'
+    CALL abort_physic(modname,abort_message,1)
     ENDIF
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_albedo.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_albedo.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_albedo.F90	(revision 5158)
@@ -24,5 +24,5 @@
 !!    AUTHOR
 !!    ------
-!!	R. Séférian           * Meteo-France *
+!!    R. Séférian           * Meteo-France *
 !!
 !!    MODIFICATIONS
@@ -158,5 +158,5 @@
 !!  ENDWHERE
 
-    do JI = 1, knon
+    DO JI = 1, knon
       IF (ZCHL(JI) > 0.02) THEN
         ZNU(JI)=MIN(0.0,0.5*(ZWORK3(JI)-0.3))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_albedo_para.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_albedo_para.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_albedo_para.F90	(revision 5158)
@@ -18,5 +18,5 @@
 !!    AUTHOR
 !!    ------
-!!	R. Séférian           * Meteo-France *
+!!    R. Séférian           * Meteo-France *
 !!
 !!    MODIFICATIONS
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90	(revision 5158)
@@ -189,5 +189,5 @@
     ! assertion: tsurf_new == tsurf_cpl
 
-    do j = 1, knon
+    DO j = 1, knon
       i = knindex(j)
       sens_prec_liq_o(i, 1) = sens_prec_liq(j)
@@ -351,5 +351,5 @@
             tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
             sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
-    do j = 1, knon
+    DO j = 1, knon
       i = knindex(j)
       sens_prec_liq_o(i, 2) = sens_prec_liq(j)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_forced_mod.F90	(revision 5158)
@@ -198,5 +198,5 @@
     IF (activate_ocean_skin == 2) tsurf_new = tsurf_lim
 
-    do j = 1, knon
+    DO j = 1, knon
       i = knindex(j)
       sens_prec_liq_o(i,1) = sens_prec_liq(j)
@@ -405,5 +405,5 @@
          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
          sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
-    do j = 1, knon
+    DO j = 1, knon
       i = knindex(j)
       sens_prec_liq_o(i,2) = sens_prec_liq(j)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90	(revision 5158)
@@ -2209,6 +2209,6 @@
         ! we assume that the eddy diffsivity coefficient for
         ! suspended particles is a fraction of Kh
-        do k = 1, klev
-          do j = 1, knon
+        DO k = 1, klev
+          DO j = 1, knon
             ycoefqbs(j, k) = ycoefh(j, k) * zeta_bs
           enddo
@@ -2528,5 +2528,5 @@
                'pbl_surface 1095a: apres surf_landice')
                ENDDO
-                do ixt=1,niso
+                DO ixt=1,niso
                    CALL iso_verif_noNaN(yxtsol(ixt,j), &
         'pbl_surface 1095b: apres surf_landice')
@@ -2536,5 +2536,5 @@
 #ifdef ISOVERIF
              !WRITE(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
-             do j=1,knon
+             DO j=1,knon
                IF (iso_eau >= 0) THEN
                  CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phyaqua_mod.F90	(revision 5158)
@@ -934,5 +934,5 @@
         !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
 
-        do j = 1, klon
+        DO j = 1, klon
           phy_sst(j, i) = 248. + 55. * (1 - sin(rlatd(j))**2)
         enddo
@@ -942,5 +942,5 @@
         PRINT*, 'Profile SST 21'
         !     Méthode 13 "Qmax2K" plateau réel é|  l'Equateur augmenté +2K
-        do j = 1, klon
+        DO j = 1, klon
           phy_sst(j, i) = 252. + 55. * (1 - sin(rlatd(j))**2)
         enddo
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phys_output_mod.F90	(revision 5158)
@@ -552,5 +552,5 @@
 #ifdef ISO
     WRITE(*,*) 'phys_output_mid 589'
-    do ixt=1,ntraciso
+    DO ixt=1,ntraciso
       outiso = TRIM(isoName(ixt))
       i = INDEX(outiso, '_', .TRUE.)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90	(revision 5158)
@@ -2445,5 +2445,5 @@
       WRITE(lunout, *)' WARNING: tr_ancien initialised to tr_seri'
       itr = 0
-      do iq = 1, nqtot
+      DO iq = 1, nqtot
         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
         itr = itr + 1
@@ -2745,6 +2745,6 @@
     ! Conservation des variables avant l'appel à l a diffusion pour les tehrmic  !
     IF (iflag_thermals_tenv / 10 == 1) then                                 !
-      do k = 1, klev                                                          !
-        do i = 1, klon                                                       !
+      DO k = 1, klev                                                          !
+        DO i = 1, klon                                                       !
           t_env(i, k) = t_seri(i, k)                                         !
           q_env(i, k) = q_seri(i, k)                                         !
@@ -2752,6 +2752,6 @@
       enddo                                                                !
     ELSE IF (iflag_thermals_tenv / 10 == 2) then                            !
-      do k = 1, klev                                                          !
-        do i = 1, klon                                                       !
+      DO k = 1, klev                                                          !
+        DO i = 1, klon                                                       !
           t_env(i, k) = t_seri(i, k)                                         !
         enddo                                                             !
@@ -3264,5 +3264,5 @@
 
         IF (.NOT. ok_gust) THEN
-          do i = 1, klon
+          DO i = 1, klon
             wd(i) = 0.0
           enddo
@@ -3550,6 +3550,6 @@
         ! A detruire en 2024 une fois les tests documentes et les choix faits        !
         IF (iflag_thermals_tenv / 10 == 0) then                            !
-          do k = 1, klev                                                      !
-            do i = 1, klon                                                   !
+          DO k = 1, klev                                                      !
+            DO i = 1, klon                                                   !
               t_env(i, k) = t_seri(i, k)                                     !
               q_env(i, k) = q_seri(i, k)                                     !
@@ -3557,12 +3557,12 @@
           enddo                                                            !
         ELSE IF (iflag_thermals_tenv / 10 == 2) then                      !
-          do k = 1, klev                                                      !
-            do i = 1, klon                                                   !
+          DO k = 1, klev                                                      !
+            DO i = 1, klon                                                   !
               q_env(i, k) = q_seri(i, k)                                     !
             enddo                                                         !
           enddo                                                            !
         ELSE IF (iflag_thermals_tenv / 10 == 3) then                      !
-          do k = 1, klev                                                      !
-            do i = 1, klon                                                   !
+          DO k = 1, klev                                                      !
+            DO i = 1, klon                                                   !
               t_env(i, k) = t(i, k)                                          !
               q_env(i, k) = qx(i, k, 1)                                       !
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/phystokenc_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/phystokenc_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/phystokenc_mod.F90	(revision 5158)
@@ -282,5 +282,5 @@
            de_d(i,k)=de_d(i,k)/dtcum
            coefh(i,k)=coefh(i,k)/dtcum
-           t(i,k)=t(i,k)/dtcum	
+           t(i,k)=t(i,k)/dtcum
            fm_therm(i,k)=fm_therm(i,k)/dtcum
            entr_therm(i,k)=entr_therm(i,k)/dtcum
@@ -318,5 +318,5 @@
      CALL histwrite_phy(physid,lstokenc,"en_d",itap,en_d)
      CALL histwrite_phy(physid,lstokenc,"de_d",itap,de_d)
-     CALL histwrite_phy(physid,lstokenc,"coefh",itap,coefh)	
+     CALL histwrite_phy(physid,lstokenc,"coefh",itap,coefh)
      CALL histwrite_phy(physid,lstokenc,"fm_th",itap,fm_therm)
      CALL histwrite_phy(physid,lstokenc,"en_th",itap,entr_therm)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/radlwsw_m.F90	(revision 5158)
@@ -903,5 +903,5 @@
           DO k=1,kflev
              POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:)
-!!!            POZON_i(1:klon,k)=POZON(1:klon,k)	    !!! on laisse 1=sol et klev=top 
+!!!            POZON_i(1:klon,k)=POZON(1:klon,k)        !!! on laisse 1=sol et klev=top
              !          print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k)
 !!!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6      
@@ -1153,6 +1153,6 @@
                 ENDIF
                 !          print *,'heat cool heat0 cool0 ',zheat(i,k),zcool(i,k),zheat0(i,k),zcool0(i,k)
-                !	   ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k)
-                !	   ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k)	   
+                !       ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k)
+                !       ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k)
              ENDDO
           ENDDO
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 5158)
@@ -180,5 +180,5 @@
 
     ! Get the IDs of ozone parameters in the input file:
-    do i_v = 1, n_o3_param
+    DO i_v = 1, n_o3_param
        CALL nf95_inq_varid(ncid_in, trim(name_in(i_v)), varid_in(i_v))
     END DO
@@ -198,5 +198,5 @@
     allocate(o3_par_out(nbp_lat, n_plev, 360))
 
-    do i_v = 1, n_o3_param
+    DO i_v = 1, n_o3_param
        ! Process ozone parameter "name_in(i_v)"
 
@@ -291,5 +291,5 @@
     ! Define primary variables:
 
-    do i = 1, n_o3_param
+    DO i = 1, n_o3_param
        CALL nf95_def_var(ncid_out, name_out(i), nf90_float, &
             (/dimid_rlatu, dimid_plev, dimid_time/), varid_out(i))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90	(revision 5158)
@@ -94,5 +94,5 @@
 
     ! Regrid in pressure at each horizontal position:
-    do i = 1, klon
+    DO i = 1, klon
        CALL regr_lint(1, v2(i, :), (/0., plev/), pplay(i, nbp_lev:1:-1), &
                          v3(i, nbp_lev:1:-1))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90	(revision 5158)
@@ -73,5 +73,5 @@
 
     ! Poles:
-    do j = 1, nbp_lat, nbp_lat-1
+    DO j = 1, nbp_lat, nbp_lat-1
        CALL regr_conserv(1, r_mob(j, :), press_in_edg, &
             p3d(1, j, nbp_lev + 1:1:-1), o3_mob_regr(1, j, nbp_lev:1:-1))
@@ -80,6 +80,6 @@
 
     ! Other latitudes:
-    do j = 2, nbp_lat-1
-       do i = 1, nbp_lon
+    DO j = 2, nbp_lat-1
+       DO i = 1, nbp_lon
           CALL regr_conserv(1, r_mob(j, :), press_in_edg, &
                p3d(i, j, nbp_lev + 1:1:-1), o3_mob_regr(i, j, nbp_lev:1:-1))
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dates.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dates.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dates.F90	(revision 5158)
@@ -26,21 +26,21 @@
 ! - gregoi: Conversion Ecart par rapport a une date fixe > Date.
 ! - daplus: Quelle sera la date dans n jours (ou heures, etc...)?
-! - amqhms_vers_dj: Conversion date grégorienne (en 5 entiers et un réel) > date julienne.
-! - dj_vers_amqhms: Conversion date julienne > date grégorienne (en 5 entiers et un réel).
-! - amqhmsree_vers_dj: Conversion date grégorienne (en un seul réel) > date julienne.
-! - dj_vers_amqhmsree: Conversion date julienne > date grégorienne (en un seul réel).
-!
-! --------------------------------------------------------------
-!
-! Définition des dates employées ci-dessous:
+! - amqhms_vers_dj: Conversion date gr�gorienne (en 5 entiers et un r�el) > date julienne.
+! - dj_vers_amqhms: Conversion date julienne > date gr�gorienne (en 5 entiers et un r�el).
+! - amqhmsree_vers_dj: Conversion date gr�gorienne (en un seul r�el) > date julienne.
+! - dj_vers_amqhmsree: Conversion date julienne > date gr�gorienne (en un seul r�el).
+!
+! --------------------------------------------------------------
+!
+! D�finition des dates employ�es ci-dessous:
 !
 ! Date julienne DJ:
-!       Elle est composée d'un réel.
-!       R1: Ce réel croît de 1 tous les jours,
-!               et vaut 2451545.0 le 1er janvier 2000 à 12 UTC.
-!
-! Date grégorienne "en clair" AMQHMS:
-!       Elle est composée de 5 entiers et d'un réel.
-!       E1: Année (4 chiffres!)
+!       Elle est compos�e d'un r�el.
+!       R1: Ce r�el cro�t de 1 tous les jours,
+!               et vaut 2451545.0 le 1er janvier 2000 � 12 UTC.
+!
+! Date gr�gorienne "en clair" AMQHMS:
+!       Elle est compos�e de 5 entiers et d'un r�el.
+!       E1: Ann�e (4 chiffres!)
 !       E2: Mois
 !       E3: Jour
@@ -82,5 +82,5 @@
 !
 !-------------------------------------------------
-! Date de validité.
+! Date de validit�.
 !-------------------------------------------------
 !
@@ -92,27 +92,27 @@
 zsssss=zsssss-real(imi)
 call amqhms_vers_dj(kan,kmo,kqu,ihe,imi,zs,zdj)
-zdj=zdj+pstati/86400. ! date julienne de validité.
-call dj_vers_amqhms(zdj,ianv,imov,iquv,ihev,imiv,zsv) ! date grégorienne de validité.
+zdj=zdj+pstati/86400. ! date julienne de validit�.
+call dj_vers_amqhms(zdj,ianv,imov,iquv,ihev,imiv,zsv) ! date gr�gorienne de validit�.
 if(pstati < 3600.) then
 !
 !-------------------------------------------------
-! Echéance en minutes.
-!-------------------------------------------------
-!
-	zech=pstati/60. ; clzue='mn'
+! Ech�ance en minutes.
+!-------------------------------------------------
+!
+    zech=pstati/60. ; clzue='mn'
 elseif(pstati < 259200.) then
 !
 !-------------------------------------------------
-! Echéance en heures.
-!-------------------------------------------------
-!
-	zech=pstati/3600. ; clzue='h'
+! Ech�ance en heures.
+!-------------------------------------------------
+!
+    zech=pstati/3600. ; clzue='h'
 else
 !
 !-------------------------------------------------
-! Echéance en jours.
-!-------------------------------------------------
-!
-	zech=pstati/86400. ; clzue='j'
+! Ech�ance en jours.
+!-------------------------------------------------
+!
+    zech=pstati/86400. ; clzue='j'
 endif
 !
@@ -125,5 +125,5 @@
 !
 if(clze(len_trim(clze)-2:len_trim(clze)) == '.00') then
-	clze=clze(1:len_trim(clze)-3)
+    clze=clze(1:len_trim(clze)-3)
 endif
 clze=adjustl(clze)
@@ -139,21 +139,21 @@
 !
 !-------------------------------------------------
-! Les minutes de base et validité sont nulles.
+! Les minutes de base et validit� sont nulles.
 ! On ne les affiche pas.
 !-------------------------------------------------
 !
-	write(cdtit,fmt='(a,i2,a,i2.2,a,i4.4,a,i2.2,3a,i2,a,i2.2,a,i4.4,a,i2.2,a)')&
-	&'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,'h UTC + ',clech(1:len_trim(clech))&
-	&,', VALID ',iquv,'.',imov,'.',ianv,' ',ihev,'h UTC'
+    write(cdtit,fmt='(a,i2,a,i2.2,a,i4.4,a,i2.2,3a,i2,a,i2.2,a,i4.4,a,i2.2,a)')&
+    &'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,'h UTC + ',clech(1:len_trim(clech))&
+    &,', VALID ',iquv,'.',imov,'.',ianv,' ',ihev,'h UTC'
 else
 !
 !-------------------------------------------------
-! Les minutes de base ou validité sont non nulles.
+! Les minutes de base ou validit� sont non nulles.
 ! On les affiche.
 !-------------------------------------------------
 !
-	write(cdtit,fmt='(a,i2,a,i2.2,a,i4.4,a,i2.2,a,i2.2,3a,i2,a,i2.2,a,i4.4,a,i2.2,a,i2.2,a)')&
-	&'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,':',imi,' UTC + ',clech(1:len_trim(clech))&
-	&,' VALID ',iquv,'.',imov,'.',ianv,' ',ihev,':',imiv,' UTC'
+    write(cdtit,fmt='(a,i2,a,i2.2,a,i4.4,a,i2.2,a,i2.2,3a,i2,a,i2.2,a,i4.4,a,i2.2,a,i2.2,a)')&
+    &'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,':',imi,' UTC + ',clech(1:len_trim(clech))&
+    &,' VALID ',iquv,'.',imov,'.',ianv,' ',ihev,':',imiv,' UTC'
 endif
 end
@@ -209,5 +209,5 @@
 !
 !-------------------------------------------------
-! Date courante à la f90.
+! Date courante � la f90.
 !-------------------------------------------------
 !
@@ -259,12 +259,12 @@
 ! --------------------------------------------------------------------------
 ! En entree:
-! kaaaa année (4 chiffres!)
+! kaaaa ann�e (4 chiffres!)
 ! kmm   mois
-! kqq   quantième du mois
+! kqq   quanti�me du mois
 ! khh   heure
 ! kmn   minute
 ! ps    seconde
 ! En sortie:
-! pdj date julienne associée à la date grégorienne UTC d'entrée
+! pdj date julienne associ�e � la date gr�gorienne UTC d'entr�e
 ! --------------------------------------------------------------------------
 
@@ -286,6 +286,6 @@
 !
 !-------------------------------------------------
-! Nombre de jours écoulés entre la date
-! d'entrée à 0h UTC et le 1er janvier 2000 à 0h UTC.
+! Nombre de jours �coul�s entre la date
+! d'entr�e � 0h UTC et le 1er janvier 2000 � 0h UTC.
 !-------------------------------------------------
 !
@@ -476,9 +476,9 @@
 ! --------------------------------------------------------------------------
 ! En entree:
-! pdj date julienne associée à la date grégorienne UTC d'entrée
-! En sortie:
-! kaaaa année (4 chiffres!)
+! pdj date julienne associ�e � la date gr�gorienne UTC d'entr�e
+! En sortie:
+! kaaaa ann�e (4 chiffres!)
 ! kmm   mois
-! kqq   quantième du mois
+! kqq   quanti�me du mois
 ! khh   heure
 ! kmn   minute
@@ -487,5 +487,5 @@
 !
 !-------------------------------------------------
-! Nombre de jours entre le 1er janvier 2000 à 0 UTC
+! Nombre de jours entre le 1er janvier 2000 � 0 UTC
 ! et la date julienne courante.
 !-------------------------------------------------
@@ -517,5 +517,5 @@
 !
 !-------------------------------------------------
-! Date grégorienne associée.
+! Date gr�gorienne associ�e.
 !-------------------------------------------------
 !
@@ -563,5 +563,5 @@
 !
 !-------------------------------------------------
-! Conversion grégorien julien; cible 5 entiers et un réel.
+! Conversion gr�gorien julien; cible 5 entiers et un r�el.
 !-------------------------------------------------
 !
@@ -569,5 +569,5 @@
 !
 !-------------------------------------------------
-! On passe de ces 5 entiers et un réel à un seul réel.
+! On passe de ces 5 entiers et un r�el � un seul r�el.
 !-------------------------------------------------
 !
@@ -591,5 +591,5 @@
 ! pgrer date en clair au format AAAAMMQQ.HHMMSS
 ! En sortie:
-! pdj date julienne associée à la date grégorienne
+! pdj date julienne associ�e � la date gr�gorienne
 ! --------------------------------------------------------------------------
 !
@@ -602,6 +602,6 @@
 !
 !-------------------------------------------------
-! On passe de cette date grégorienne donnée
-! comme un seul réel à 5 entiers et un réel.
+! On passe de cette date gr�gorienne donn�e
+! comme un seul r�el � 5 entiers et un r�el.
 !-------------------------------------------------
 !
@@ -619,5 +619,5 @@
 !
 !-------------------------------------------------
-! Conversion grégorien julien; cible 5 entiers et un réel.
+! Conversion gr�gorien julien; cible 5 entiers et un r�el.
 !-------------------------------------------------
 !
@@ -1058,5 +1058,5 @@
 if(ibissext == 1) ijours(2)=29
 ! *       Boucle sur les jours
-do ieci=1,iec
+DO ieci=1,iec
   iqq=iqq+1
   if(iqq > ijours(imm)) then
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90	(revision 5158)
@@ -150,5 +150,5 @@
 if( l_regions_debug )then
   write(*,'("eq_regions: N=",I6," n_regions_ns=",I4)') N,n_regions_ns
-  do j=1,n_regions_ns
+  DO j=1,n_regions_ns
     write(*,'("eq_regions: n_regions(",I4,")=",I4)') j,n_regions(j)
   enddo
@@ -207,5 +207,5 @@
   a_fitting = (pi-2.0_jprb*c_polar)/float(n_collars)
   ideal_region_area = area_of_ideal_region(N)
-  do collar_n=1,n_collars
+  DO collar_n=1,n_collars
     ideal_collar_area = area_of_collar(c_polar+(collar_n-1)*a_fitting, &
      & c_polar+collar_n*a_fitting)
@@ -248,5 +248,5 @@
 n_regions(1:n_collars+2) = r_regions(:)
 discrepancy = 0.0_jprb
-do zone_n = 1,n_collars+2
+DO zone_n = 1,n_collars+2
     n_regions(zone_n) = nint(r_regions(zone_n)+discrepancy);
     discrepancy = discrepancy+r_regions(zone_n)-float(n_regions(zone_n));
@@ -351,10 +351,10 @@
 if (n .gt. 0) then
   w = x - 1
-  do k = 2, n
+  DO k = 2, n
     w = w * (x - k)
   end do
 else
   w = 1
-  do k = 0, -n - 1
+  DO k = 0, -n - 1
     y = y * (x + k)
   end do
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/lw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/lw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/lw.F90	(revision 5158)
@@ -142,5 +142,5 @@
 
 IF (LHOOK) CALL DR_HOOK('LW',0,ZHOOK_HANDLE)
-print *,'	LW: Avant LWU'
+print *,'    LW: Avant LWU'
 CALL LWU &
  & (  KIDIA, KFDIA, KLON, KLEV,&
@@ -156,5 +156,5 @@
 !                ---------------------------------
 
-print *,'	LW: Avant LWBV'
+print *,'    LW: Avant LWBV'
 CALL LWBV &
  & ( KIDIA, KFDIA, KLON , KLEV  , KMODE,&
@@ -169,5 +169,5 @@
 !                --------------------------------
 
-print *,'	LW: Avant LWC'
+print *,'    LW: Avant LWC'
 CALL LWC &
  & ( KIDIA , KFDIA, KLON  , KLEV,&
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerop.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerop.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerop.F90	(revision 5158)
@@ -70,10 +70,10 @@
 ! of RH (12 values) for the 8 wavelengths
 ! For sea-salt (_SS), 3 bins are considered      (0.03, 0.50, 5.0, 20.)
-! For desert dust (_DD), 3 bins are considered	 (0.03, 0.55, 0.9, 20.)
+! For desert dust (_DD), 3 bins are considered     (0.03, 0.55, 0.9, 20.)
 !
 ! IF BIN LIMITS ARE CHANGED, MAKE SURE THAT THE RELEVANT SEDIMENTATION SPEEDS ARE 
 ! RECOMPUTED ACCORDINGLY
 
-! RH  0.   	 10.	     20.         30.         40.         50.
+! RH  0.        10.         20.         30.         40.         50.
 !    60.         70.         80.         85.         90.         95.    
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerp.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerp.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerp.F90	(revision 5158)
@@ -65,13 +65,13 @@
 !      (RHTAB, RHHO_SS, RSSGROW)
 !   or to 12 types/bins of aerosols with the following mapping: NTYPAER
-!   1- 3  sea-salt  0.03 - 0.5 -  5  - 20 microns		   1
-!   4- 6  dust      0.03 - 0.5 - 0.9 - 20 microns		   2
-!   7- 8  POM	    hydrophilic, hydrophobic			   3
-!   9-10  BC	    hydrophilic, hydrophobic			   4
-!  11     sulfate						   5
-!  12     fly ash						   6
-!  13     stratospheric aerosols				   7
-!  14     volcanic aerosols					   8
-!  15    							   9
+!   1- 3  sea-salt  0.03 - 0.5 -  5  - 20 microns           1
+!   4- 6  dust      0.03 - 0.5 - 0.9 - 20 microns           2
+!   7- 8  POM        hydrophilic, hydrophobic               3
+!   9-10  BC        hydrophilic, hydrophobic               4
+!  11     sulfate                           5
+!  12     fly ash                           6
+!  13     stratospheric aerosols                   7
+!  14     volcanic aerosols                       8
+!  15                                   9
 !      (RVDPOCE, RVDSIC, RVDPLND, RVDPLIC)
 !      (RVSEDOCE,RVSEDSIC,RVSEDLND,RVSEDLIC)
@@ -268,5 +268,5 @@
  &  0.01_JPRB,  0.01_JPRB,  0.01_JPRB,  0.01_JPRB,  0.01_JPRB,  0.01_JPRB,  0.01_JPRB /)
 
-										 
+
 !*      3.    PARAMETERS RELATED TO TRANSPORT WITHIN THE FREE ATMOSPHERE
 !             ----------------------------------------------------------
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerw.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerw.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_aerw.F90	(revision 5158)
@@ -119,6 +119,6 @@
 !     1       1- 3  sea-salt  0.03 - 0.5 -  5  - 20 microns
 !     2       4- 6  dust      0.03 - 0.5 - 0.9 - 20 microns
-!     3       7- 8  POM	    hydrophilic, hydrophobic
-!     4       9-10  BC	    hydrophilic, hydrophobic
+!     3       7- 8  POM        hydrophilic, hydrophobic
+!     4       9-10  BC        hydrophilic, hydrophobic
 !     5      11     sulfate
 !     6      12     fly ash
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_uvrad.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_uvrad.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/su_uvrad.F90	(revision 5158)
@@ -928,5 +928,5 @@
 RFA0 = (/-0.236447E-03_JPRB,-0.266955E-03_JPRB,-0.293599E-03_JPRB,-0.258858E-03_JPRB /)
 RFA1 = (/ 0.253817E+01_JPRB, 0.254179E+01_JPRB, 0.254540E+01_JPRB, 0.253815E+01_JPRB /)
-!	   single scattering albedo
+!       single scattering albedo
 RFB0 = (/-0.269916E-06_JPRB,-0.100570E-06_JPRB, 0.182299E-06_JPRB,-0.198529E-06_JPRB /)
 RFB1 = (/ 0.212909E-06_JPRB, 0.160441E-06_JPRB, 0.112454E-06_JPRB, 0.939480E-07_JPRB /)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sucst.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sucst.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/sucst.F90	(revision 5158)
@@ -290,5 +290,5 @@
   WRITE(KULOUT,'(10(1X,E10.4))') (ESS(RTT+10._JPRB*J),J=-4,4)
 !  call flush(0)       !!!!! A REVOIR (MPL) les 7 lignes qui suivent
-   do j=1,9
+   DO j=1,9
      print*,'TEST J',j
      print*,'RTT...',RTT+10._JPRB*(J-5)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/suecrad.F90	(revision 5158)
@@ -293,6 +293,6 @@
   !                     3: f(T,IWC) Sun'01: 22.5 to 175 microns
   !  conversion factor between effective radius and particle size for ice
-  NRADIP = 3            ! before 3?R1 default=2 	3
-  NRADLP = 2            ! before 3?R1 default=2	2
+  NRADIP = 3            ! before 3?R1 default=2     3
+  NRADLP = 2            ! before 3?R1 default=2    2
   print *, 'SUECRAD: NRADLP, NRADIP=', NRADLP, NRADIP
   RRe2De = 0.64952_JPRB ! before 3?R1 default=0.5_JPRB
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yoeaerop.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yoeaerop.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yoeaerop.F90	(revision 5158)
@@ -28,6 +28,6 @@
 
 ! ALF is alpha , the mass extinction coefficient   in m2/g
-! ASY is g     , the assymetry factor		     ND
-! OMG is pizero, the single scattering albedo	     ND
+! ASY is g     , the assymetry factor             ND
+! OMG is pizero, the single scattering albedo         ND
 !     ------------------------------------------------------------------
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomarar.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomarar.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomarar.F90	(revision 5158)
@@ -58,5 +58,5 @@
 
 REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE  :: XSW_BANDS  !SW spectral bands
-					      ! for ext. surface scheme
+                          ! for ext. surface scheme
 LOGICAL :: LOSUBG_COND ! see OSUBG_COND in mesoNH
 LOGICAL :: LOSUBG_AUCV ! see OSUBG_AUCV in mesoNH
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomcoaphy.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomcoaphy.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomcoaphy.F90	(revision 5158)
@@ -16,5 +16,5 @@
 INTEGER(KIND=JPIM) :: NPHYINT      ! NPHYINT=0 -> Physics and dynamics at the same resolution
                                    ! NPHYINT=1 -> Physics grid coarser than dynamics grid
-				   ! NPHYINT=2 -> Physics grid finer than dynamics grid
+                   ! NPHYINT=2 -> Physics grid finer than dynamics grid
 TYPE(gridpoint_buffer) :: PHYS_GPPBUF
 CHARACTER (LEN = 32) ::   CPTABLEFIL
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomgrb.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomgrb.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/yomgrb.F90	(revision 5158)
@@ -227,40 +227,40 @@
 ! NGRBAERMR14 - 014 aerosol mixing ratio 14
 ! NGRBAERMR15 - 015 aerosol mixing ratio 15
-! NGRBAERGN01 - 016 aerosol gain acc. 1		2D
-! NGRBAERGN02 - 017 aerosol gain acc. 2		2D
-! NGRBAERGN03 - 018 aerosol gain acc. 3		2D
-! NGRBAERGN04 - 019 aerosol gain acc. 4		2D
-! NGRBAERGN05 - 020 aerosol gain acc. 5		2D
-! NGRBAERGN06 - 021 aerosol gain acc. 6		2D
-! NGRBAERGN07 - 022 aerosol gain acc. 7		2D
-! NGRBAERGN08 - 023 aerosol gain acc. 8		2D
-! NGRBAERGN09 - 024 aerosol gain acc. 9		2D
-! NGRBAERGN10 - 025 aerosol gain acc. 10	2D
-! NGRBAERGN11 - 026 aerosol gain acc. 11	2D
-! NGRBAERGN12 - 027 aerosol gain acc. 12	2D
-! NGRBAERGN13 - 028 aerosol gain acc. 13	2D
-! NGRBAERGN14 - 029 aerosol gain acc. 14	2D
-! NGRBAERGN15 - 030 aerosol gain acc. 15	2D
-! NGRBAERLS01 - 031 aerosol loss acc. 1		2D
-! NGRBAERLS02 - 032 aerosol loss acc. 2		2D
-! NGRBAERLS03 - 033 aerosol loss acc. 3		2D
-! NGRBAERLS04 - 034 aerosol loss acc. 4		2D
-! NGRBAERLS05 - 035 aerosol loss acc. 5		2D
-! NGRBAERLS06 - 036 aerosol loss acc. 6		2D
-! NGRBAERLS07 - 037 aerosol loss acc. 7		2D
-! NGRBAERLS08 - 038 aerosol loss acc. 8		2D
-! NGRBAERLS09 - 039 aerosol loss acc. 9		2D
-! NGRBAERLS10 - 040 aerosol loss acc. 10	2D
-! NGRBAERLS11 - 041 aerosol loss acc. 11	2D
-! NGRBAERLS12 - 042 aerosol loss acc. 12	2D
-! NGRBAERLS13 - 043 aerosol loss acc. 13	2D
-! NGRBAERLS14 - 044 aerosol loss acc. 14	2D
-! NGRBAERLS15 - 045 aerosol loss acc. 15	2D
+! NGRBAERGN01 - 016 aerosol gain acc. 1        2D
+! NGRBAERGN02 - 017 aerosol gain acc. 2        2D
+! NGRBAERGN03 - 018 aerosol gain acc. 3        2D
+! NGRBAERGN04 - 019 aerosol gain acc. 4        2D
+! NGRBAERGN05 - 020 aerosol gain acc. 5        2D
+! NGRBAERGN06 - 021 aerosol gain acc. 6        2D
+! NGRBAERGN07 - 022 aerosol gain acc. 7        2D
+! NGRBAERGN08 - 023 aerosol gain acc. 8        2D
+! NGRBAERGN09 - 024 aerosol gain acc. 9        2D
+! NGRBAERGN10 - 025 aerosol gain acc. 10    2D
+! NGRBAERGN11 - 026 aerosol gain acc. 11    2D
+! NGRBAERGN12 - 027 aerosol gain acc. 12    2D
+! NGRBAERGN13 - 028 aerosol gain acc. 13    2D
+! NGRBAERGN14 - 029 aerosol gain acc. 14    2D
+! NGRBAERGN15 - 030 aerosol gain acc. 15    2D
+! NGRBAERLS01 - 031 aerosol loss acc. 1        2D
+! NGRBAERLS02 - 032 aerosol loss acc. 2        2D
+! NGRBAERLS03 - 033 aerosol loss acc. 3        2D
+! NGRBAERLS04 - 034 aerosol loss acc. 4        2D
+! NGRBAERLS05 - 035 aerosol loss acc. 5        2D
+! NGRBAERLS06 - 036 aerosol loss acc. 6        2D
+! NGRBAERLS07 - 037 aerosol loss acc. 7        2D
+! NGRBAERLS08 - 038 aerosol loss acc. 8        2D
+! NGRBAERLS09 - 039 aerosol loss acc. 9        2D
+! NGRBAERLS10 - 040 aerosol loss acc. 10    2D
+! NGRBAERLS11 - 041 aerosol loss acc. 11    2D
+! NGRBAERLS12 - 042 aerosol loss acc. 12    2D
+! NGRBAERLS13 - 043 aerosol loss acc. 13    2D
+! NGRBAERLS14 - 044 aerosol loss acc. 14    2D
+! NGRBAERLS15 - 045 aerosol loss acc. 15    2D
 ! NGRBAERPR   - 046 aerosol precursor mixing ratio 
 ! NGRBAERSM   - 047 small aerosols mixing ratio 
 ! NGRBAERLG   - 048 large aerosols mixing ratio 
 ! NGRBAODPR   - 049 aerosol precursor opt.depth 2D
-! NGRBAODSM   - 050 small aerosols opt. depth	2D
-! NGRBAODLG   - 051 large aerosols opt. depth	2D
+! NGRBAODSM   - 050 small aerosols opt. depth    2D
+! NGRBAODLG   - 051 large aerosols opt. depth    2D
 ! NGRBAERDEP  - 052 dust emission potential clim2D 
 ! NGRBAERLTS  - 053 lifting threshold speed clim2D
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/screenp_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/screenp_mod.F90	(revision 5157)
+++ 	(revision )
@@ -1,185 +1,0 @@
-
-MODULE screenp_mod
-
-! This module contains some procedures for calculation of the first
-! guess of temperature, specific humidity and wind at a reference level
-! coefficients for turbulent diffusion at surface
-
-  IMPLICIT NONE
-
-CONTAINS
-
-!****************************************************************************************
-
-!r original routine
-
-      SUBROUTINE screenp(klon, knon, nsrf, &
-                     speed, tair, qair, &
-                     ts, qsurf, rugos, lmon, &
-                     ustar, testar, qstar, zref, &
-                     delu, delte, delq)
-      IMPLICIT NONE
-!-------------------------------------------------------------------------
-
-! Objet : calcul "predicteur" des anomalies du vent, de la temperature 
-!         potentielle et de l'humidite relative au niveau de reference zref et 
-!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
-!         a partir des relations de Dyer-Businger.
-
-! Reference : Hess, Colman et McAvaney (1995)
-
-! I. Musat, 01.07.2002
-!-------------------------------------------------------------------------
-
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! speed---input-R- module du vent au 1er niveau du modele
-! tair----input-R- temperature de l'air au 1er niveau du modele
-! qair----input-R- humidite relative au 1er niveau du modele
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! rugos---input-R- rugosite
-! lmon----input-R- longueur de Monin-Obukov
-! ustar---input-R- facteur d'echelle pour le vent
-! testar--input-R- facteur d'echelle pour la temperature potentielle
-! qstar---input-R- facteur d'echelle pour l'humidite relative
-! zref----input-R- altitude de reference
-
-! delu----input-R- anomalie du vent par rapport au 1er niveau
-! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
-! delq----input-R- anomalie de l'humidite relative par rapport a la surface
-
-      INTEGER, INTENT(IN) :: klon, knon, nsrf
-      REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
-      REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
-      DOUBLE PRECISION, DIMENSION(klon), INTENT(IN) :: lmon
-      REAL, DIMENSION(klon), INTENT(IN) :: ustar, testar, qstar
-      REAL, INTENT(IN) :: zref
-
-      REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
-
-!-------------------------------------------------------------------------
-! Variables locales et constantes :
-      REAL, PARAMETER :: RKAR=0.40
-      INTEGER :: i
-      REAL :: xtmp, xtmp0
-!-------------------------------------------------------------------------
-      DO i = 1, knon
-
-        IF (lmon(i)>=0.) THEN
-
-! STABLE CASE
-
-          IF (speed(i)>1.5.AND.lmon(i)<=1.0                        &
-                        .AND. rugos(i)<=1.0) THEN
-            delu(i) = (ustar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) + &
-                      min(5.d0, 5.0 *(zref - rugos(i))/lmon(i)))
-            delte(i) = (testar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) + &
-                       min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
-            delq(i) = (qstar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) + &
-                      min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
-          ELSE
-            delu(i)  = 0.1 * speed(i)
-            delte(i) = 0.1 * (tair(i) - ts(i) )
-            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-          ENDIF
-        ELSE  
-
-! UNSTABLE CASE
-
-          IF (speed(i)>5.0.AND.abs(lmon(i))<=50.0) THEN
-            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
-            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
-            delu(i) = (ustar(i)/RKAR)* &
-                      (log(zref/(rugos(i))+1.) & 
-                      - 2.*log(0.5*(1. + xtmp)) &
-                      + 2.*log(0.5*(1. + xtmp0)) &
-                      - log(0.5*(1. + xtmp*xtmp)) &
-                      + log(0.5*(1. + xtmp0*xtmp0)) &
-                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
-            delte(i) = (testar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) &
-                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
-                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
-            delq(i)  = (qstar(i)/RKAR)* &
-                       (log(zref/(rugos(i))+1.) &
-                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) & 
-                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
-          ELSE
-            delu(i)  = 0.5 * speed(i)
-            delte(i) = 0.5 * (tair(i) - ts(i) )
-            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-          ENDIF
-        ENDIF
-
-      ENDDO
-
-      END SUBROUTINE screenp
-
-      SUBROUTINE screenpn(klon, knon, nsrf, &
-                     speed, tair, qair, &
-                     ts, qsurf, rugos, zri1, &
-                     zref, &
-                     delu, delte, delq)
-      IMPLICIT NONE
-!-------------------------------------------------------------------------
-
-! Objet : calcul "predicteur" des anomalies du vent, de la temperature 
-!         potentielle et de l'humidite relative au niveau de reference zref et 
-!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q) 
-!         a partir des relations de Dyer-Businger.
-
-! Reference : Hess, Colman et McAvaney (1995)
-
-! I. Musat, 01.07.2002
-!-------------------------------------------------------------------------
-
-! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
-! knon----input-I- nombre de points pour un type de surface
-! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
-! speed---input-R- module du vent au 1er niveau du modele
-! tair----input-R- temperature de l'air au 1er niveau du modele
-! qair----input-R- humidite relative au 1er niveau du modele
-! ts------input-R- temperature de l'air a la surface
-! qsurf---input-R- humidite relative a la surface
-! rugos---input-R- rugosite
-! zref----input-R- altitude de reference
-
-! delu----input-R- anomalie du vent par rapport au 1er niveau
-! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
-! delq----input-R- anomalie de l'humidite relative par rapport a la surface
-
-      INTEGER, INTENT(IN) :: klon, knon, nsrf
-      REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
-      REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
-      REAL, DIMENSION(klon), INTENT(IN) :: zri1
-      REAL, INTENT(IN) :: zref
-
-      REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
-
-!-------------------------------------------------------------------------
-! Variables locales et constantes :
-      REAL, PARAMETER :: RKAR=0.40
-      INTEGER :: i
-      REAL :: xtmp, xtmp0
-!-------------------------------------------------------------------------
-      DO i = 1, knon
-
-       IF (zri1(i)>=0.) THEN
-          delu(i)  = 0.1 * speed(i)
-          delte(i) = 0.1 * (tair(i) - ts(i) )
-          delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-       ELSE
-          delu(i)  = 0.5 * speed(i)
-          delte(i) = 0.5 * (tair(i) - ts(i) )
-          delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
-       ENDIF
-
-      ENDDO
-
-      END SUBROUTINE screenpn
-END MODULE screenp_mod 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90	(revision 5158)
@@ -5,5 +5,5 @@
 
   USE cdrag_mod
-  USE screenp_mod
+  USE lmdz_screenp, ONLY: screenp
   USE screenc_mod
   IMPLICIT NONE
@@ -157,5 +157,5 @@
     !----------First aproximation of variables at zref --------------------------
     zref = 2.0
-    CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
+    CALL screenp(klon, knon, speed, tpot, q1, &
             ts1, qsurf, z0m, lmon, &
             ustar, testar, qstar, zref, &
@@ -259,8 +259,6 @@
 
     zref = 10.0
-    CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
-            ts1, qsurf, z0m, lmon, &
-            ustar, testar, qstar, zref, &
-            delu, delte, delq)
+    CALL screenp(klon, knon, speed, tpot, q1, ts1, qsurf, z0m, lmon, ustar, &
+            testar, qstar, zref, delu, delte, delq)
 
     DO i = 1, knon
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/stratosphere_mask.F90	(revision 5158)
@@ -120,10 +120,10 @@
   REAL, parameter :: deltaz = 2000.0
 
-  real :: faktor
-  real :: pmk, pm, a, b, tm, dtdp, dtdz, dlnp, tdlnp
-  real :: ag, bg, ptph, ttph, a0, b0
-  real :: pm0, tm0, pmk0, dtdz0
-  real :: p2km, asum, aquer
-  real :: pmk2, pm2, a2, b2, tm2, dtdp2, dtdz2
+  REAL :: faktor
+  REAL :: pmk, pm, a, b, tm, dtdp, dtdz, dlnp, tdlnp
+  REAL :: ag, bg, ptph, ttph, a0, b0
+  REAL :: pm0, tm0, pmk0, dtdz0
+  REAL :: p2km, asum, aquer
+  REAL :: pmk2, pm2, a2, b2, tm2, dtdp2, dtdz2
   INTEGER :: icount, jj, j
 
@@ -171,5 +171,5 @@
 
     ! test until apm < p2km
-    do jj = j, 2, -1
+    DO jj = j, 2, -1
 
       pmk2 = .5 * (p(jj - 1)**rkappa + p(jj)**rkappa)    ! p mean ^kappa
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_mod.F90	(revision 5158)
@@ -178,5 +178,5 @@
 #ifdef ISOVERIF
 !        WRITE(*,*) 'surf_land_mod 162'
-        do i=1,knon
+        DO i=1,knon
           IF (iso_eau.gt.0) THEN
             CALL iso_verif_egalite_choix(precip_snow(i), &
@@ -191,6 +191,6 @@
 #ifdef ISOVERIF
 !       WRITE(*,*) 'surf_land 169: ok_veget=',ok_veget
-        do i=1,knon
-         do ixt=1,ntiso
+        DO i=1,knon
+         DO ixt=1,ntiso
            CALL iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
          enddo
@@ -251,5 +251,5 @@
 #ifdef ISOVERIF
      WRITE(*,*) 'surf_land 193: apres surf_land_orchidee'
-     do i=1,knon
+     DO i=1,knon
         IF (iso_eau.gt.0) THEN
              CALL iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 5158)
@@ -591,5 +591,5 @@
     ENDIF
     
-    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+nbp_lon-1)-offset-1	
+    ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+nbp_lon-1)-offset-1
     
 
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/surf_landice_mod.F90	(revision 5158)
@@ -447,5 +447,5 @@
         coefc = log(z03 / z02) / (ta3 - ta2)
         coefd = log(z03) - coefc * ta3
-        do j = 1, knon
+        DO j = 1, knon
           IF (temp_air(j) < ta1) THEN
             z0m(j) = z01
@@ -474,5 +474,5 @@
       IF (ok_bs) THEN
         fluxbs(:) = 0.
-        do j = 1, knon
+        DO j = 1, knon
           ws1(j) = (u1(j)**2 + v1(j)**2)**0.5
           ustar(j) = (cdragm(j) * (u1(j)**2 + v1(j)**2))**0.5
@@ -482,5 +482,5 @@
 
         ! 1st step: erosion of fresh snow accumulated during the time step
-        do j = 1, knon
+        DO j = 1, knon
           IF (precip_snow(j) > 0.) THEN
             rhos(j) = rhofresh_bs
@@ -528,5 +528,5 @@
         ! computation of threshold friction velocity
         ! which depends on surface snow density
-        do j = 1, knon
+        DO j = 1, knon
           IF (ok_remaining_freshsnow(j)) THEN
             fluxbs_2(j) = 0.
@@ -564,5 +564,5 @@
 
         ! final flux and outputs
-        do j = 1, knon
+        DO j = 1, knon
           ! total flux is the erosion of fresh snow +
           ! a fraction of the underlying snow (if all the fresh snow has been eroded)
Index: LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90
===================================================================
--- LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90	(revision 5157)
+++ LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_c.F90	(revision 5158)
@@ -162,5 +162,5 @@
   zt(:, :) = pt(:, :) + zalpha * d_t(:, :)
 
-  do k = 1, klev
+  DO k = 1, klev
     exner(:, k) = (play(:, k) / plev(:, 1))**RKAPPA
     masse(:, k) = (plev(:, k) - plev(:, k + 1)) / RG
@@ -170,5 +170,5 @@
   ! Atmospheric mass at layer interfaces, where the TKE is computed
   masseb(:, :) = 0.
-  do k = 1, klev
+  DO k = 1, klev
     masseb(:, k) = masseb(:, k) + masse(:, k)
     masseb(:, k + 1) = masseb(:, k + 1) + masse(:, k)
@@ -178,5 +178,5 @@
   zlev(:, 1) = 0.
   zlay(:, 1) = RCPD * teta(:, 1) * (1. - exner(:, 1))
-  do k = 1, klev - 1
+  DO k = 1, klev - 1
     zlay(:, k + 1) = zlay(:, k) + 0.5 * RCPD * (teta(:, k) + teta(:, k + 1)) * (exner(:, k) - exner(:, k + 1)) / RG
     zlev(:, k) = 0.5 * (zlay(:, k) + zlay(:, k + 1)) ! PASBO
@@ -187,5 +187,5 @@
   fluxt(:, klev + 1) = 0.
 
-  do k = klev, 1, -1
+  DO k = klev, 1, -1
     fluxu(:, k) = fluxu(:, k + 1) + masse(:, k) * d_u(:, k)
     fluxv(:, k) = fluxv(:, k + 1) + masse(:, k) * d_v(:, k)
@@ -197,5 +197,5 @@
   dddt(:, 1) = (exner(:, 1) - 1.) * fluxt(:, 1)
 
-  do k = 2, klev
+  DO k = 2, klev
     dddu(:, k) = (zu(:, k) - zu(:, k - 1)) * fluxu(:, k)
     dddv(:, k) = (zv(:, k) - zv(:, k - 1)) * fluxv(:, k)
@@ -263,6 +263,6 @@
   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-  do k = 2, klev
-    do ig = 1, ngrid
+  DO k = 2, klev
+    DO ig = 1, ngrid
       dz(ig, k) = zlay(ig, k) - zlay(ig, k - 1)
       m2(ig, k) = ((zu(ig, k) - zu(ig, k - 1))**2 + (zv(ig, k) - zv(ig, k - 1))**2) / (dz(ig, k) * dz(ig, k))
@@ -301,10 +301,10 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       sq(ig) = 1.e-10
       sqz(ig) = 1.e-10
     enddo
-    do k = 2, klev - 1
-      do ig = 1, ngrid
+    DO k = 2, klev - 1
+      DO ig = 1, ngrid
         zq = sqrt(q2(ig, k))
         sqz(ig) = sqz(ig) + zq * zlev(ig, k) * (zlay(ig, k) - zlay(ig, k - 1))
@@ -312,9 +312,9 @@
       enddo
     enddo
-    do ig = 1, ngrid
+    DO ig = 1, ngrid
       l0(ig) = 0.2 * sqz(ig) / sq(ig)
     enddo
-    do k = 2, klev
-      do ig = 1, ngrid
+    DO k = 2, klev
+      DO ig = 1, ngrid
         l(ig, k) = fl(zlev(ig, k), l0(ig), q2(ig, k), n2(ig, k))
       enddo
@@ -329,6 +329,6 @@
 
     l0(:) = 150.
-    do k = 2, klev
-      do ig = 1, ngrid
+    DO k = 2, klev
+      DO ig = 1, ngrid
         l(ig, k) = fl(zlev(ig, k), l0(ig), q2(ig, k), n2(ig, k))
       enddo
