Index: trunk/DOC/chantiers/commit_importants.log
===================================================================
--- trunk/DOC/chantiers/commit_importants.log	(revision 1507)
+++ trunk/DOC/chantiers/commit_importants.log	(revision 1508)
@@ -1558,2 +1558,47 @@
 - ran1.F, sort.F, minmax.F, minmax2.F, juldate.F moved over from dyn3d_common
 
+**********************
+**** commit_v1508 ****
+**********************
+Ehouarn: Updates in the dynamics (seq and //) to keep up with updates
+in LMDZ5 (up to LMDZ5 trunk, rev 2325):
+IMPORTANT: Modifications for isotopes are only done in dyn3d, not in dyn3dpar
+           as in LMDZ5 these modifications were done in dyn3dmem.
+           Related LMDZ5 revisions are r2270 and r2281
+* in dynlonlat_phylonlat:
+- add module "grid_atob_m.F90" (a regridding utility
+  so far only used by phylmd/ce0l.F90, used to be dyn3d_common/grid_atob.F)
+
+* in misc:
+- follow up updates on wxios.F (add missing_val module variable)
+
+* in dyn3d_common:
+- pression.F => pression.F90
+- misc_mod.F90: moved from misc to dyn3d_common
+- added new iso_verif_dyn.F 
+- covcont.F => covcont.F90
+- infotrac.F90 : add handling of isotopes (reading of corresponding
+  traceur.def for planets not implemented)
+- dynetat0.F => dynetat0.F90 with some code factorization
+- dynredem.F => dynredem.F90 with some code factorization
+- added dynredem_mod.F90: routines used by dynredem 
+- iniacademic.F90 : added isotopes-related initialization for Earth case
+
+* in dyn3d:
+- added check_isotopes.F
+- modified (isotopes) advtrac.F90, caladvtrac.F
+- guide_mod.F90: ported updates
+- leapfrog.F : (isotopes) updates (NB: call integrd with nqtot tracers)
+- qminimium.F : adaptations for isotopes (copied over, except that #include
+  comvert.h is not needed).
+- vlsplt.F: adaptations for isotopes (copied over, except than #include
+  logic.h, comvert.h not needed, and replace "include comconst.h" with 
+  use comconst_mod, ONLY: pi)
+- vlspltqs.F : same as vlsplt.F, but also keeping added modification for CP(T)
+
+* in dyn3dpar:
+- leapfrog_p.F: remove unecessary #ifdef CPP_EARTH cpp flag. and call
+  integrd_p with nqtot tracers (only important for Earth)
+- dynredem_p.F => dynredem_p.F90 and some code factorization
+- and no isotopes-relates changes in dyn3dpar (since these changes
+  have been made in LMDZ5 dyn3dmem).
Index: trunk/LMDZ.COMMON/libf/dyn3d/advtrac.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/advtrac.F90	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d/advtrac.F90	(revision 1508)
@@ -9,5 +9,5 @@
   !            M.A Filiberti (04/2002)
   !
-  USE infotrac, ONLY: nqtot, iadv
+  USE infotrac, ONLY: nqtot, iadv, nqperes, ok_iso_verif
   USE control_mod, ONLY: iapp_tracvl, day_step
   USE comconst_mod, ONLY: dtvr
@@ -218,5 +218,10 @@
      !     Appel des sous programmes d'advection
      !-----------------------------------------------------------
-     do iq=1,nqtot
+     if (ok_iso_verif) then
+           write(*,*) 'advtrac 227'
+           call check_isotopes_seq(q,ip1jmp1,'advtrac 162')
+     endif !if (ok_iso_verif) then
+
+     do iq=1,nqperes
         !        call clock(t_initial)
         if(iadv(iq) == 0) cycle 
@@ -225,5 +230,8 @@
         !   ----------------------------------------------------------------
         if(iadv(iq).eq.10) THEN
-           call vlsplt(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)
+           ! CRisi: on fait passer tout q pour avoir acces aux fils
+           
+           !write(*,*) 'advtrac 239: iq,q(1721,19,:)=',iq,q(1721,19,:)     
+           call vlsplt(q,2.,massem,wg,pbarug,pbarvg,dtvr,iq)
 
            !   ----------------------------------------------------------------
@@ -233,6 +241,8 @@
         else if(iadv(iq).eq.14) then
            !
-           CALL vlspltqs( q(1,1,1), 2., massem, wg , &
-                pbarug,pbarvg,dtvr,p,pk,teta )
+           !write(*,*) 'advtrac 248: iq,q(1721,19,:)=',iq,q(1721,19,:)
+           CALL vlspltqs( q, 2., massem, wg , &
+                pbarug,pbarvg,dtvr,p,pk,teta,iq)
+
            !   ----------------------------------------------------------------
            !   Schema de Frederic Hourdin
@@ -383,4 +393,8 @@
      end DO
 
+     if (ok_iso_verif) then
+           write(*,*) 'advtrac 402'
+           call check_isotopes_seq(q,ip1jmp1,'advtrac 397')
+     endif !if (ok_iso_verif) then
 
      !------------------------------------------------------------------
Index: trunk/LMDZ.COMMON/libf/dyn3d/caladvtrac.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/caladvtrac.F	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d/caladvtrac.F	(revision 1508)
@@ -53,5 +53,8 @@
       if (planet_type.eq."earth") then
 C initialisation
-        dq(:,:,1:2)=q(:,:,1:2)
+! CRisi: il faut gérer tous les traceurs si on veut pouvoir faire des
+! isotopes
+!        dq(:,:,1:2)=q(:,:,1:2)
+        dq(:,:,1:nqtot)=q(:,:,1:nqtot)
        
 c  test des valeurs minmax
@@ -82,5 +85,7 @@
           ENDDO
           
-          CALL qminimum( q, 2, finmasse )
+          !write(*,*) 'caladvtrac 87'
+          CALL qminimum( q, nqtot, finmasse )
+          !write(*,*) 'caladvtrac 89'
 
           CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
@@ -92,5 +97,5 @@
           dtvrtrac = iapp_tracvl * dtvr
 c
-           DO iq = 1 , 2
+           DO iq = 1 , nqtot
             DO l = 1 , llm
              DO ij = 1,ip1jmp1
@@ -105,5 +110,5 @@
         if (planet_type.eq."earth") then
 ! Earth-specific treatment for the first 2 tracers (water)
-          dq(:,:,1:2)=0.
+          dq(:,:,1:nqtot)=0.
         endif ! of if (planet_type.eq."earth")
       ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
Index: trunk/LMDZ.COMMON/libf/dyn3d/check_isotopes.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/check_isotopes.F	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d/check_isotopes.F	(revision 1508)
@@ -0,0 +1,203 @@
+        subroutine check_isotopes_seq(q,ip1jmp1,err_msg)
+        USE infotrac, ONLY: nqtot,niso,nqo,ntraceurs_zone,ntraciso,
+     &                      ok_isotopes,ok_isotrac,iqiso,use_iso,
+     &                      indnum_fn_num,tnat,index_trac
+        implicit none
+
+#include "dimensions.h"
+
+        ! inputs
+        integer ip1jmp1
+        real q(ip1jmp1,llm,nqtot)
+        character*(*) err_msg ! message d''erreur à afficher
+
+        ! locals
+        integer ixt,phase,k,i,iq,iiso,izone,ieau,iqeau
+        real xtractot,xiiso
+        real borne
+        real qmin
+        real errmax ! erreur maximale en absolu.
+        real errmaxrel ! erreur maximale en relatif autorisée
+        real deltaDmax,deltaDmin
+        real ridicule
+        parameter (borne=1e19)
+        parameter (errmax=1e-8)
+        parameter (errmaxrel=1e-3)
+        parameter (qmin=1e-11)
+        parameter (deltaDmax=200.0,deltaDmin=-999.9)
+        parameter (ridicule=1e-12)
+        real deltaD
+
+        if (ok_isotopes) then
+
+        write(*,*) 'check_isotopes 31: err_msg=',err_msg
+        ! verifier que rien n'est NaN
+        do ixt=1,ntraciso
+          do phase=1,nqo
+            iq=iqiso(ixt,phase)
+            do k=1,llm
+              DO i = 1,ip1jmp1
+                if ((q(i,k,iq).gt.-borne).and.
+     :            (q(i,k,iq).lt.borne)) then
+                else !if ((x(ixt,i,j).gt.-borne).and.
+                  write(*,*) 'erreur detectee par iso_verif_noNaN:'
+                  write(*,*) err_msg
+                  write(*,*) 'q,i,k,iq=',q(i,k,iq),i,k,iq
+                  write(*,*) 'borne=',borne
+                  stop
+                endif  !if ((x(ixt,i,j).gt.-borne).and.
+              enddo !DO i = 1,ip1jmp1
+            enddo !do k=1,llm
+          enddo !do phase=1,nqo
+        enddo !do ixt=1,ntraciso
+
+        !write(*,*) 'check_isotopes 52'
+        ! verifier que l'eau normale est OK
+        if (use_iso(1)) then
+          ixt=indnum_fn_num(1)
+          do phase=1,nqo
+            iq=iqiso(ixt,phase)
+            do k=1,llm
+            DO i = 1,ip1jmp1  
+              if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
+     :          (abs((q(i,k,phase)-q(i,k,iq))/
+     :           max(max(abs(q(i,k,phase)),abs(q(i,k,iq))),1e-18))
+     :           .gt.errmaxrel)) then
+                  write(*,*) 'erreur detectee par iso_verif_egalite:'
+                  write(*,*) err_msg
+                  write(*,*) 'ixt,phase=',ixt,phase
+                  write(*,*) 'q,iq,i,k=',q(i,k,iq),iq,i,k
+                  write(*,*) 'q(i,k,phase)=',q(i,k,phase)
+                  stop
+              endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
+              ! bidouille pour éviter divergence:
+              q(i,k,iq)= q(i,k,phase) 
+            enddo ! DO i = 1,ip1jmp1
+            enddo !do k=1,llm
+          enddo ! do phase=1,nqo 
+        endif !if (use_iso(1)) then
+        
+        !write(*,*) 'check_isotopes 78'
+        ! verifier que HDO est raisonable
+        if (use_iso(2)) then
+          ixt=indnum_fn_num(2)
+          do phase=1,nqo
+            iq=iqiso(ixt,phase)
+            do k=1,llm
+            DO i = 1,ip1jmp1
+            if (q(i,k,iq).gt.qmin) then
+             deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(2)-1)*1000
+             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
+                  write(*,*) 'erreur detectee par iso_verif_aberrant:'
+                  write(*,*) err_msg
+                  write(*,*) 'ixt,phase=',ixt,phase
+                  write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
+                  write(*,*) 'q=',q(i,k,:)
+                  write(*,*) 'deltaD=',deltaD
+                  stop
+             endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
+            endif !if (q(i,k,iq).gt.qmin) then
+            enddo !DO i = 1,ip1jmp1
+            enddo !do k=1,llm
+          enddo ! do phase=1,nqo 
+        endif !if (use_iso(2)) then
+
+        !write(*,*) 'check_isotopes 103'
+        ! verifier que O18 est raisonable
+        if (use_iso(3)) then
+          ixt=indnum_fn_num(3)
+          do phase=1,nqo
+            iq=iqiso(ixt,phase)
+            do k=1,llm
+            DO i = 1,ip1jmp1
+            if (q(i,k,iq).gt.qmin) then
+             deltaD=(q(i,k,iq)/q(i,k,phase)/tnat(3)-1)*1000
+             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
+                  write(*,*) 'erreur detectee iso_verif_aberrant O18:'
+                  write(*,*) err_msg
+                  write(*,*) 'ixt,phase=',ixt,phase
+                  write(*,*) 'q,iq,i,k,=',q(i,k,phase),iq,i,k
+                  write(*,*) 'xt=',q(i,k,:)
+                  write(*,*) 'deltaO18=',deltaD
+                  stop
+             endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
+            endif !if (q(i,k,iq).gt.qmin) then
+            enddo !DO i = 1,ip1jmp1
+            enddo !do k=1,llm
+          enddo ! do phase=1,nqo 
+        endif !if (use_iso(2)) then
+
+
+        !write(*,*) 'check_isotopes 129'
+        if (ok_isotrac) then
+
+          if (use_iso(2).and.use_iso(1)) then
+            do izone=1,ntraceurs_zone
+             ixt=index_trac(izone,indnum_fn_num(2))
+             ieau=index_trac(izone,indnum_fn_num(1))
+             do phase=1,nqo
+               iq=iqiso(ixt,phase)
+               iqeau=iqiso(ieau,phase)
+               do k=1,llm
+                DO i = 1,ip1jmp1
+                if (q(i,k,iq).gt.qmin) then
+                 deltaD=(q(i,k,iq)/q(i,k,iqeau)/tnat(2)-1)*1000
+                 if ((deltaD.gt.deltaDmax).or.
+     &                   (deltaD.lt.deltaDmin)) then
+                  write(*,*) 'erreur dans iso_verif_aberrant trac:'
+                  write(*,*) err_msg
+                  write(*,*) 'izone,phase=',izone,phase
+                  write(*,*) 'ixt,ieau=',ixt,ieau
+                  write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
+                  write(*,*) 'deltaD=',deltaD
+                  stop
+                 endif !if ((deltaD.gt.deltaDmax).or.
+                endif !if (q(i,k,iq).gt.qmin) then
+                enddo !DO i = 1,ip1jmp1
+                enddo  ! do k=1,llm
+              enddo ! do phase=1,nqo    
+            enddo !do izone=1,ntraceurs_zone
+          endif !if (use_iso(2).and.use_iso(1)) then
+
+          do iiso=1,niso
+           do phase=1,nqo
+              iq=iqiso(iiso,phase)
+              do k=1,llm
+                DO i = 1,ip1jmp1
+                   xtractot=0.0
+                   xiiso=q(i,k,iq)
+                   do izone=1,ntraceurs_zone
+                      iq=iqiso(index_trac(izone,iiso),phase)
+                      xtractot=xtractot+ q(i,k,iq)
+                   enddo !do izone=1,ntraceurs_zone
+                   if ((abs(xtractot-xiiso).gt.errmax).and.
+     :                  (abs(xtractot-xiiso)/
+     :                  max(max(abs(xtractot),abs(xiiso)),1e-18)
+     :                  .gt.errmaxrel)) then
+                  write(*,*) 'erreur detectee par iso_verif_traceurs:'
+                  write(*,*) err_msg
+                  write(*,*) 'iiso,phase=',iiso,phase
+                  write(*,*) 'i,k,=',i,k
+                  write(*,*) 'q(i,k,:)=',q(i,k,:)
+                  stop
+                 endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
+                  
+                 ! bidouille pour éviter divergence:
+                 if (abs(xtractot).gt.ridicule) then
+                   do izone=1,ntraceurs_zone
+                     ixt=index_trac(izone,iiso) 
+                     q(i,k,iq)=q(i,k,iq)/xtractot*xiiso
+                   enddo !do izone=1,ntraceurs_zone                
+                  endif !if ((abs(xtractot).gt.ridicule) then
+                enddo !DO i = 1,ip1jmp1
+              enddo !do k=1,llm
+           enddo !do phase=1,nqo
+          enddo !do iiso=1,niso
+
+        endif !if (ok_isotrac) then
+
+        endif ! if (ok_isotopes)
+        !write(*,*) 'check_isotopes 198'
+        
+        end
+
Index: trunk/LMDZ.COMMON/libf/dyn3d/guide_mod.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/guide_mod.F90	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d/guide_mod.F90	(revision 1508)
@@ -79,4 +79,5 @@
 ! Lecture des parametres:  
 ! ---------------------------------------------
+    call ini_getparam("nudging_parameters_out.txt")
 ! Variables guidees
     CALL getpar('guide_u',.true.,guide_u,'guidage de u')
@@ -144,4 +145,6 @@
     CALL getpar('guide_inverty',.true.,invert_y,'inversion N-S')
     CALL getpar('guide_2D',.false.,guide_2D,'fichier guidage lat-P')
+
+    call fin_getparam
 
 ! ---------------------------------------------
Index: trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F	(revision 1508)
@@ -12,5 +12,5 @@
       use IOIPSL
 #endif
-      USE infotrac, ONLY: nqtot
+      USE infotrac, ONLY: nqtot,ok_iso_verif
       USE guide_mod, ONLY : guide_main
       USE write_field, ONLY: writefield
@@ -305,4 +305,7 @@
       jH_cur = jH_cur - int(jH_cur)
 
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 321')
+        endif !if (ok_iso_verif) then
 
 #ifdef CPP_IOIPSL
@@ -337,4 +340,8 @@
 !      CALL SCOPY   ( ijp1llm,   masse, 1, finvmaold,     1 )
 !      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
+
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 400')
+        endif !if (ok_iso_verif) then
 
    2  CONTINUE ! Matsuno backward or leapfrog step begins here
@@ -381,4 +388,8 @@
 #endif
 
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 589')
+        endif !if (ok_iso_verif) then
+
 c-----------------------------------------------------------------------
 c   calcul des tendances dynamiques:
@@ -419,4 +430,9 @@
 c   -------------------------------------------------------------
 
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,
+     &           'leapfrog 686: avant caladvtrac')
+        endif !if (ok_iso_verif) then
+
       IF( forward. OR . leapf )  THEN
 ! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
@@ -443,8 +459,17 @@
 c   ----------------------------------
 
-
-       CALL integrd ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
+        if (ok_iso_verif) then
+           write(*,*) 'leapfrog 720' 
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 756')
+        endif !if (ok_iso_verif) then
+        
+       CALL integrd ( nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 ,
      $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis )
 !     $              finvmaold                                    )
+
+       if (ok_iso_verif) then
+          write(*,*) 'leapfrog 724'
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 762')
+        endif !if (ok_iso_verif) then
 
        IF ((planet_type.eq."titan").and.(tidal)) then
@@ -519,5 +544,5 @@
          IF (ip_ebil_dyn.ge.1 ) THEN 
           ztit='bil dyn'
-! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
+! Ehouarn: be careful, diagedyn is Earth-specific!
            IF (planet_type.eq."earth") THEN
             CALL diagedyn(ztit,2,1,1,dtphys
@@ -619,4 +644,8 @@
         CALL massdair(p,masse)
 
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 1196')
+        endif !if (ok_iso_verif) then
+
 c-----------------------------------------------------------------------
 c   dissipation horizontale et verticale  des petites echelles:
@@ -717,4 +746,8 @@
 c   preparation du pas d'integration suivant  ......
 
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 1509')
+        endif !if (ok_iso_verif) then
+
       IF ( .NOT.purmats ) THEN
 c       ........................................................
@@ -776,4 +809,8 @@
 
             ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin))
+
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 1584')
+        endif !if (ok_iso_verif) then
 
 c-----------------------------------------------------------------------
@@ -858,4 +895,8 @@
       ELSE ! of IF (.not.purmats)
 
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 1664')
+        endif !if (ok_iso_verif) then
+
 c       ........................................................
 c       ..............       schema  matsuno        ...............
@@ -880,4 +921,8 @@
 
             ELSE ! of IF(forward) i.e. backward step
+
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'leapfrog 1698')
+        endif !if (ok_iso_verif) then  
 
               IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
Index: trunk/LMDZ.COMMON/libf/dyn3d/qminimum.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/qminimum.F	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d/qminimum.F	(revision 1508)
@@ -2,6 +2,7 @@
 ! $Header$
 !
-      SUBROUTINE qminimum( q,nq,deltap )
+      SUBROUTINE qminimum( q,nqtot,deltap )
 
+      USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif
       IMPLICIT none
 c
@@ -12,6 +13,6 @@
 #include "paramet.h"
 c
-      INTEGER nq
-      REAL q(ip1jmp1,llm,nq), deltap(ip1jmp1,llm)
+      INTEGER nqtot
+      REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm)
 c
       INTEGER iq_vap, iq_liq
@@ -29,4 +30,7 @@
       INTEGER i, k, iq
       REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
+
+      real zx_defau_diag(ip1jmp1,llm,2) 
+      real q_follow(ip1jmp1,llm,2)
 c
       REAL SSUM
@@ -35,4 +39,8 @@
       SAVE imprim
       DATA imprim /0/
+      !INTEGER ijb,ije
+      !INTEGER Index_pump(ij_end-ij_begin+1)
+      !INTEGER nb_pump
+      INTEGER ixt
 c
 c Quand l'eau liquide est trop petite (ou negative), on prend
@@ -40,7 +48,20 @@
 c (sans changer la temperature !)
 c
+
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'qminimum 52')   
+        endif !if (ok_iso_verif) then     
+
+      zx_defau_diag(:,:,:)=0.0
+      q_follow(:,:,1:2)=q(:,:,1:2)  
       DO 1000 k = 1, llm
         DO 1040 i = 1, ip1jmp1
           if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
+
+              if (ok_isotopes) then
+                 zx_defau_diag(i,k,iq_liq)=AMAX1
+     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
+              endif !if (ok_isotopes) then
+
              q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
              q(i,k,iq_liq) = seuil_liq
@@ -58,4 +79,9 @@
         DO i = 1, ip1jmp1
           if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
+
+            if (ok_isotopes) then
+              zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
+            endif !if (ok_isotopes) then
+
             q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
      &                     deltap(i,k) / deltap(i,k-1)
@@ -82,4 +108,83 @@
          ENDDO
       ENDIF
+
+      !write(*,*) 'qminimum 128'
+      if (ok_isotopes) then
+      ! CRisi: traiter de même les traceurs d'eau
+      ! Mais il faut les prendre à l'envers pour essayer de conserver la
+      ! masse.
+      ! 1) pompage dans le sol  
+      ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
+      ! rien ici et on croise les doigts pour que ça ne soit pas trop
+      ! génant
+      DO i = 1,ip1jmp1
+        if (zx_pump(i).gt.0.0) then
+          q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)
+        endif !if (zx_pump(i).gt.0.0) then
+      enddo !DO i = 1,ip1jmp1
+
+      ! 2) transfert de vap vers les couches plus hautes
+      !write(*,*) 'qminimum 139'
+      do k=2,llm
+        DO i = 1,ip1jmp1
+          if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
+              ! on ajoute la vapeur en k              
+              do ixt=1,ntraciso
+               q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
+     :              +zx_defau_diag(i,k,iq_vap)
+     :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
+                
+              ! et on la retranche en k-1
+               q(i,k-1,iqiso(ixt,iq_vap))=q(i,k-1,iqiso(ixt,iq_vap))
+     :              -zx_defau_diag(i,k,iq_vap)
+     :              *deltap(i,k)/deltap(i,k-1)
+     :              *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
+
+              enddo !do ixt=1,niso
+              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
+     :               +zx_defau_diag(i,k,iq_vap)
+              q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
+     :               -zx_defau_diag(i,k,iq_vap)
+     :              *deltap(i,k)/deltap(i,k-1)
+          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+        enddo !DO i = 1, ip1jmp1        
+       enddo !do k=2,llm
+
+        if (ok_iso_verif) then     
+           call check_isotopes_seq(q,ip1jmp1,'qminimum 168')
+        endif !if (ok_iso_verif) then
+        
+      
+        ! 3) transfert d'eau de la vapeur au liquide
+        !write(*,*) 'qminimum 164'
+        do k=1,llm
+        DO i = 1,ip1jmp1
+          if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
+
+              ! on ajoute eau liquide en k en k              
+              do ixt=1,ntraciso
+               q(i,k,iqiso(ixt,iq_liq))=q(i,k,iqiso(ixt,iq_liq))
+     :              +zx_defau_diag(i,k,iq_liq)
+     :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)
+              ! et on la retranche à la vapeur en k
+               q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap))
+     :              -zx_defau_diag(i,k,iq_liq)
+     :              *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap)   
+              enddo !do ixt=1,niso
+              q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
+     :               +zx_defau_diag(i,k,iq_liq)
+              q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
+     :               -zx_defau_diag(i,k,iq_liq)
+          endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
+        enddo !DO i = 1, ip1jmp1
+       enddo !do k=2,llm  
+
+        if (ok_iso_verif) then
+           call check_isotopes_seq(q,ip1jmp1,'qminimum 197')
+        endif !if (ok_iso_verif) then
+
+      endif !if (ok_isotopes) then
+      !write(*,*) 'qminimum 188'
+      
 c
       RETURN
Index: trunk/LMDZ.COMMON/libf/dyn3d/vlsplt.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/vlsplt.F	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d/vlsplt.F	(revision 1508)
@@ -1,7 +1,8 @@
 c
-c $Id: vlsplt.F 1550 2011-07-05 09:44:55Z lguez $
-c
-
-      SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt)
+c $Id: vlsplt.F 2286 2015-05-20 13:27:07Z emillour $
+c
+
+      SUBROUTINE vlsplt(q,pente_max,masse,w,pbaru,pbarv,pdt,iq)
+      USE infotrac, ONLY: nqtot,nqdesc,iqfils
 c
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
@@ -29,7 +30,8 @@
 c      REAL masse(iip1,jjp1,llm),pente_max
       REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
-      REAL q(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nqtot)
 c      REAL q(iip1,jjp1,llm)
       REAL w(ip1jmp1,llm),pdt
+      INTEGER iq ! CRisi
 c
 c      Local 
@@ -39,9 +41,9 @@
       INTEGER ijlqmin,iqmin,jqmin,lqmin
 c
-      REAL zm(ip1jmp1,llm),newmasse
+      REAL zm(ip1jmp1,llm,nqtot),newmasse
       REAL mu(ip1jmp1,llm)
       REAL mv(ip1jm,llm)
       REAL mw(ip1jmp1,llm+1)
-      REAL zq(ip1jmp1,llm),zz
+      REAL zq(ip1jmp1,llm,nqtot),zz
       REAL dqx(ip1jmp1,llm),dqy(ip1jmp1,llm),dqz(ip1jmp1,llm)
       REAL second,temps0,temps1,temps2,temps3
@@ -52,4 +54,5 @@
       SAVE temps1,temps2,temps3
       INTEGER iminn,imaxx
+      INTEGER ifils,iq2 ! CRisi
 
       REAL qmin,qmax
@@ -76,27 +79,35 @@
          mw(ij,llm+1)=0.
       ENDDO
-      
-      CALL SCOPY(ijp1llm,q,1,zq,1)
-      CALL SCOPY(ijp1llm,masse,1,zm,1)
+           
+      CALL SCOPY(ijp1llm,q(1,1,iq),1,zq(1,1,iq),1)
+      CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1)
+        
+      if (nqdesc(iq).gt.0) then  
+        do ifils=1,nqdesc(iq)
+          iq2=iqfils(ifils,iq)
+          CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1)
+        enddo  
+      endif !if (nqfils(iq).gt.0) then
 
 cprint*,'Entree vlx1'
 c	call minmaxq(zq,qmin,qmax,'avant vlx     ')
-      call vlx(zq,pente_max,zm,mu)
+      call vlx(zq,pente_max,zm,mu,iq)
 cprint*,'Sortie vlx1'
 c	call minmaxq(zq,qmin,qmax,'apres vlx1    ')
 
 c print*,'Entree vly1'
-      call vly(zq,pente_max,zm,mv)
+
+      call vly(zq,pente_max,zm,mv,iq)
 c	call minmaxq(zq,qmin,qmax,'apres vly1     ')
 cprint*,'Sortie vly1'
-      call vlz(zq,pente_max,zm,mw)
+      call vlz(zq,pente_max,zm,mw,iq)
 c	call minmaxq(zq,qmin,qmax,'apres vlz     ')
 
 
-      call vly(zq,pente_max,zm,mv)
+      call vly(zq,pente_max,zm,mv,iq)
 c	call minmaxq(zq,qmin,qmax,'apres vly     ')
 
 
-      call vlx(zq,pente_max,zm,mu)
+      call vlx(zq,pente_max,zm,mu,iq)
 c	call minmaxq(zq,qmin,qmax,'apres vlx2    ')
 	
@@ -104,14 +115,29 @@
       DO l=1,llm
          DO ij=1,ip1jmp1
-           q(ij,l)=zq(ij,l)
+           q(ij,l,iq)=zq(ij,l,iq)
          ENDDO
          DO ij=1,ip1jm+1,iip1
-            q(ij+iim,l)=q(ij,l)
-         ENDDO
-      ENDDO
+            q(ij+iim,l,iq)=q(ij,l,iq)
+         ENDDO
+      ENDDO
+      ! CRisi: aussi pour les fils
+      if (nqdesc(iq).gt.0) then
+      do ifils=1,nqdesc(iq)
+        iq2=iqfils(ifils,iq)
+        DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l,iq2)=zq(ij,l,iq2)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l,iq2)=q(ij,l,iq2)
+         ENDDO
+        ENDDO
+      enddo !do ifils=1,nqdesc(iq)    
+      endif ! if (nqdesc(iq).gt.0) then    
 
       RETURN
       END
-      SUBROUTINE vlx(q,pente_max,masse,u_m)
+      RECURSIVE SUBROUTINE vlx(q,pente_max,masse,u_m,iq)
+      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
 
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
@@ -133,8 +159,9 @@
 c   Arguments:
 c   ----------
-      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse(ip1jmp1,llm,nqtot),pente_max
       REAL u_m( ip1jmp1,llm ),pbarv( iip1,jjm,llm)
-      REAL q(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nqtot)
       REAL w(ip1jmp1,llm)
+      INTEGER iq ! CRisi
 c
 c      Local 
@@ -149,4 +176,8 @@
       REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
       REAL u_mq(ip1jmp1,llm)
+
+      ! CRisi
+      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot)
+      INTEGER ifils,iq2 ! CRisi
 
       Logical extremum,first,testcpu
@@ -182,7 +213,7 @@
          DO l = 1, llm
             DO ij=iip2,ip1jm-1
-               dxqu(ij)=q(ij+1,l)-q(ij,l)
+               dxqu(ij)=q(ij+1,l,iq)-q(ij,l,iq)
 c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
-c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+c              sigu(ij)=u_m(ij,l)/masse(ij,l,iq)
             ENDDO
             DO ij=iip1+iip1,ip1jm,iip1
@@ -237,5 +268,5 @@
          DO l = 1, llm
             DO ij=iip2,ip1jm-1
-               dxqu(ij)=q(ij+1,l)-q(ij,l)
+               dxqu(ij)=q(ij+1,l,iq)-q(ij,l,iq)
             ENDDO
             DO ij=iip1+iip1,ip1jm,iip1
@@ -279,11 +310,11 @@
       DO l=1,llm
        DO ij=iip2,ip1jm-1
-          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
-     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l,iq),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l,iq),
      ,                     u_m(ij,l))
           zdum(ij,l)=0.5*zdum(ij,l)
           u_mq(ij,l)=cvmgp(
-     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
-     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                q(ij,l,iq)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l,iq)-zdum(ij,l)*dxq(ij+1,l),
      ,                u_m(ij,l))
           u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
@@ -297,11 +328,12 @@
       DO l=1,llm
        DO ij=iip2,ip1jm-1
-c	print*,'masse(',ij,')=',masse(ij,l)
+c	print*,'masse(',ij,')=',masse(ij,l,iq)
           IF (u_m(ij,l).gt.0.) THEN
-             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
-             u_mq(ij,l)=u_m(ij,l)*(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l))
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l,iq)
+             u_mq(ij,l)=u_m(ij,l)*(q(ij,l,iq)+0.5*zdum(ij,l)*dxq(ij,l))
           ELSE
-             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
-             u_mq(ij,l)=u_m(ij,l)*(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l))
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l,iq)
+             u_mq(ij,l)=u_m(ij,l)*(q(ij+1,l,iq)
+     &           -0.5*zdum(ij,l)*dxq(ij+1,l))
           ENDIF
        ENDDO
@@ -373,7 +405,8 @@
                      i=ijq-(j-1)*iip1
 c   accumulation pour les mailles completements advectees
-                     do while(zu_m.gt.masse(ijq,l))
-                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
-                        zu_m=zu_m-masse(ijq,l)
+                     do while(zu_m.gt.masse(ijq,l,iq))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l,iq)
+     &                          *masse(ijq,l,iq)
+                        zu_m=zu_m-masse(ijq,l,iq)
                         i=mod(i-2+iim,iim)+1
                         ijq=(j-1)*iip1+i
@@ -381,18 +414,20 @@
 c   ajout de la maille non completement advectee
                      u_mq(ij,l)=u_mq(ij,l)+zu_m*
-     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+     &                  (q(ijq,l,iq)+0.5*(1.-zu_m/masse(ijq,l,iq))
+     &                  *dxq(ijq,l))
                   ELSE
                      ijq=ij+1
                      i=ijq-(j-1)*iip1
 c   accumulation pour les mailles completements advectees
-                     do while(-zu_m.gt.masse(ijq,l))
-                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
-                        zu_m=zu_m+masse(ijq,l)
+                     do while(-zu_m.gt.masse(ijq,l,iq))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l,iq)
+     &                          *masse(ijq,l,iq)
+                        zu_m=zu_m+masse(ijq,l,iq)
                         i=mod(i,iim)+1
                         ijq=(j-1)*iip1+i
                      ENDDO
 c   ajout de la maille non completement advectee
-                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
-     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l,iq)-
+     &               0.5*(1.+zu_m/masse(ijq,l,iq))*dxq(ijq,l))
                   ENDIF
                ENDDO
@@ -411,4 +446,26 @@
       ENDDO
 
+! CRisi: appel récursif de l'advection sur les fils.
+! Il faut faire ça avant d'avoir mis à jour q et masse
+      !write(*,*) 'vlsplt 326: iq,nqfils(iq)=',iq,nqfils(iq) 
+      
+      if (nqdesc(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)
+         DO l=1,llm
+          DO ij=iip2,ip1jm
+           ! On a besoin de q et masse seulement entre iip2 et ip1jm 
+           masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
+           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
+          enddo   
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+        do ifils=1,nqfils(iq)
+         iq2=iqfils(ifils,iq)
+         call vlx(Ratio,pente_max,masseq,u_mq,iq2)
+        enddo !do ifils=1,nqfils(iq)
+      endif !if (nqfils(iq).gt.0) then
+! end CRisi
+
 
 c   calcul des tENDances
@@ -416,16 +473,34 @@
       DO l=1,llm
          DO ij=iip2+1,ip1jm
-            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+
+            new_m=masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
      &      u_mq(ij-1,l)-u_mq(ij,l))
      &      /new_m
-            masse(ij,l)=new_m
+            masse(ij,l,iq)=new_m
          ENDDO
 c   ModIF Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
          DO ij=iip1+iip1,ip1jm,iip1
-            q(ij-iim,l)=q(ij,l)
-            masse(ij-iim,l)=masse(ij,l)
-         ENDDO
-      ENDDO
+            q(ij-iim,l,iq)=q(ij,l,iq)
+            masse(ij-iim,l,iq)=masse(ij,l,iq)
+         ENDDO
+      ENDDO
+
+      ! retablir les fils en rapport de melange par rapport a l'air:
+      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio 
+      ! puis on boucle en longitude
+      if (nqdesc(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)  
+         DO l=1,llm
+          DO ij=iip2+1,ip1jm
+            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)            
+          enddo
+          DO ij=iip1+iip1,ip1jm,iip1
+             q(ij-iim,l,iq2)=q(ij,l,iq2)
+          enddo ! DO ij=ijb+iip1-1,ije,iip1
+         enddo !DO l=1,llm
+        enddo !do ifils=1,nqdesc(iq)
+      endif !if (nqfils(iq).gt.0) then
+
 c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
 c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
@@ -434,5 +509,7 @@
       RETURN
       END
-      SUBROUTINE vly(q,pente_max,masse,masse_adv_v)
+      RECURSIVE SUBROUTINE vly(q,pente_max,masse,masse_adv_v,iq)
+      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
+      USE comconst_mod, ONLY: pi
 c
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
@@ -446,6 +523,4 @@
 c
 c   --------------------------------------------------------------------
-      USE comconst_mod, ONLY: pi
-
       IMPLICIT NONE
 c
@@ -457,7 +532,8 @@
 c   Arguments:
 c   ----------
-      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse(ip1jmp1,llm,nqtot),pente_max
       REAL masse_adv_v( ip1jm,llm)
-      REAL q(ip1jmp1,llm), dq( ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nqtot), dq( ip1jmp1,llm)
+      INTEGER iq ! CRisi
 c
 c      Local 
@@ -484,4 +560,8 @@
       SAVE sinlon,coslon,sinlondlon,coslondlon
       SAVE airej2,airejjm
+
+      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi
+      INTEGER ifils,iq2 ! CRisi
+
 c
 c
@@ -490,4 +570,6 @@
       DATA first,testcpu/.true.,.false./
       DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+      !write(*,*) 'vly 578: entree, iq=',iq
 
       IF(first) THEN
@@ -522,6 +604,6 @@
 
       DO i = 1, iim
-      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
-      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l,iq)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l,iq)
       ENDDO
       qpns   = SSUM( iim,  airescb ,1 ) / airej2
@@ -531,5 +613,5 @@
 
       DO ij=1,ip1jm
-         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         dyqv(ij)=q(ij,l,iq)-q(ij+iip1,l,iq)
          adyqv(ij)=abs(dyqv(ij))
       ENDDO
@@ -546,6 +628,6 @@
 
       DO ij=1,iip1
-         dyq(ij,l)=qpns-q(ij+iip1,l)
-         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+         dyq(ij,l)=qpns-q(ij+iip1,l,iq)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l,iq)-qpsn
       ENDDO
 
@@ -668,12 +750,15 @@
       ENDDO
 
+      !write(*,*) 'vly 756'
       DO l=1,llm
        DO ij=1,ip1jm
           IF(masse_adv_v(ij,l).gt.0) THEN
-              qbyv(ij,l)=q(ij+iip1,l)+dyq(ij+iip1,l)*
-     ,                   0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l))
+              qbyv(ij,l)=q(ij+iip1,l,iq)+dyq(ij+iip1,l)*
+     ,                   0.5*(1.-masse_adv_v(ij,l)
+     ,                   /masse(ij+iip1,l,iq))
           ELSE
-              qbyv(ij,l)=q(ij,l)-dyq(ij,l)*
-     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l))
+              qbyv(ij,l)=q(ij,l,iq)-dyq(ij,l)*
+     ,                   0.5*(1.+masse_adv_v(ij,l)
+     ,                   /masse(ij,l,iq))
           ENDIF
           qbyv(ij,l)=masse_adv_v(ij,l)*qbyv(ij,l)
@@ -681,12 +766,34 @@
       ENDDO
 
+! CRisi: appel récursif de l'advection sur les fils.
+! Il faut faire ça avant d'avoir mis à jour q et masse
+      !write(*,*) 'vly 689: iq,nqfils(iq)=',iq,nqfils(iq) 
+   
+      if (nqfils(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)
+         DO l=1,llm
+         DO ij=1,ip1jmp1
+           ! attention, chaque fils doit avoir son masseq, sinon, le 1er
+           ! fils ecrase le masseq de ses freres.
+           masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
+           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
+          enddo   
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+
+        do ifils=1,nqfils(iq)
+         iq2=iqfils(ifils,iq)
+         call vly(Ratio,pente_max,masseq,qbyv,iq2)
+        enddo !do ifils=1,nqfils(iq)
+      endif !if (nqfils(iq).gt.0) then
 
       DO l=1,llm
          DO ij=iip2,ip1jm
-            newmasse=masse(ij,l)
+            newmasse=masse(ij,l,iq)
      &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
-     &         /newmasse
-            masse(ij,l)=newmasse
+            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+qbyv(ij,l)
+     &         -qbyv(ij-iip1,l))/newmasse
+            masse(ij,l,iq)=newmasse
          ENDDO
 c.-. ancienne version
@@ -696,12 +803,12 @@
          convpn=SSUM(iim,qbyv(1,l),1)
          convmpn=ssum(iim,masse_adv_v(1,l),1)
-         massepn=ssum(iim,masse(1,l),1)
+         massepn=ssum(iim,masse(1,l,iq),1)
          qpn=0.
          do ij=1,iim
-            qpn=qpn+masse(ij,l)*q(ij,l)
+            qpn=qpn+masse(ij,l,iq)*q(ij,l,iq)
          enddo
          qpn=(qpn+convpn)/(massepn+convmpn)
          do ij=1,iip1
-            q(ij,l)=qpn
+            q(ij,l,iq)=qpn
          enddo
 
@@ -711,12 +818,12 @@
          convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
          convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
-         masseps=ssum(iim, masse(ip1jm+1,l),1)
+         masseps=ssum(iim, masse(ip1jm+1,l,iq),1)
          qps=0.
          do ij = ip1jm+1,ip1jmp1-1
-            qps=qps+masse(ij,l)*q(ij,l)
+            qps=qps+masse(ij,l,iq)*q(ij,l,iq)
          enddo
          qps=(qps+convps)/(masseps+convmps)
          do ij=ip1jm+1,ip1jmp1
-            q(ij,l)=qps
+            q(ij,l,iq)=qps
          enddo
 
@@ -732,5 +839,5 @@
 c        DO ij = 1,iip1
 c           q(ij,l)=newq
-c           masse(ij,l)=newmasse*aire(ij)
+c           masse(ij,l,iq)=newmasse*aire(ij)
 c        ENDDO
 c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
@@ -742,12 +849,27 @@
 c        DO ij = ip1jm+1,ip1jmp1
 c           q(ij,l)=newq
-c           masse(ij,l)=newmasse*aire(ij)
+c           masse(ij,l,iq)=newmasse*aire(ij)
 c        ENDDO
 c._. fin nouvelle version
       ENDDO
+  
+! retablir les fils en rapport de melange par rapport a l'air:
+      if (nqfils(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)  
+         DO l=1,llm
+          DO ij=1,ip1jmp1
+            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)            
+          enddo
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+      endif !if (nqfils(iq).gt.0) then
+
+      !write(*,*) 'vly 853: sortie'
 
       RETURN
       END
-      SUBROUTINE vlz(q,pente_max,masse,w)
+      RECURSIVE SUBROUTINE vlz(q,pente_max,masse,w,iq)
+      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi 
 c
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
@@ -769,7 +891,8 @@
 c   Arguments:
 c   ----------
-      REAL masse(ip1jmp1,llm),pente_max
-      REAL q(ip1jmp1,llm)
+      REAL masse(ip1jmp1,llm,nqtot),pente_max
+      REAL q(ip1jmp1,llm,nqtot)
       REAL w(ip1jmp1,llm+1)
+      INTEGER iq
 c
 c      Local 
@@ -782,4 +905,7 @@
       REAL dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm),dzqmax
       REAL sigw
+
+      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi
+      INTEGER ifils,iq2 ! CRisi
 
       LOGICAL testcpu
@@ -795,4 +921,6 @@
 c    On oriente tout dans le sens de la pression c'est a dire dans le
 c    sens de W
+
+      !write(*,*) 'vlz 923: entree'
 
 #ifdef BIDON
@@ -803,5 +931,5 @@
       DO l=2,llm
          DO ij=1,ip1jmp1
-            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
+            dzqw(ij,l)=q(ij,l-1,iq)-q(ij,l,iq)
             adzqw(ij,l)=abs(dzqw(ij,l))
          ENDDO
@@ -825,4 +953,5 @@
       ENDDO
 
+      !write(*,*) 'vlz 954'
       DO ij=1,ip1jmp1
          dzq(ij,1)=0.
@@ -841,12 +970,14 @@
 c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
 
+       !write(*,*) 'vlz 969'
        DO l = 1,llm-1
          do  ij = 1,ip1jmp1
           IF(w(ij,l+1).gt.0.) THEN
-             sigw=w(ij,l+1)/masse(ij,l+1)
-             wq(ij,l+1)=w(ij,l+1)*(q(ij,l+1)+0.5*(1.-sigw)*dzq(ij,l+1))
+             sigw=w(ij,l+1)/masse(ij,l+1,iq)
+             wq(ij,l+1)=w(ij,l+1)*(q(ij,l+1,iq)
+     &           +0.5*(1.-sigw)*dzq(ij,l+1))
           ELSE
-             sigw=w(ij,l+1)/masse(ij,l)
-             wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
+             sigw=w(ij,l+1)/masse(ij,l,iq)
+             wq(ij,l+1)=w(ij,l+1)*(q(ij,l,iq)-0.5*(1.+sigw)*dzq(ij,l))
           ENDIF
          ENDDO
@@ -858,13 +989,46 @@
        ENDDO
 
+! CRisi: appel récursif de l'advection sur les fils.
+! Il faut faire ça avant d'avoir mis à jour q et masse
+      !write(*,*) 'vlsplt 942: iq,nqfils(iq)=',iq,nqfils(iq)
+      if (nqfils(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)
+         DO l=1,llm
+          DO ij=1,ip1jmp1
+           masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
+           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)        
+          enddo   
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+        
+        do ifils=1,nqfils(iq)
+         iq2=iqfils(ifils,iq)         
+         call vlz(Ratio,pente_max,masseq,wq,iq2)
+        enddo !do ifils=1,nqfils(iq)
+      endif !if (nqfils(iq).gt.0) then
+! end CRisi  
+
       DO l=1,llm
          DO ij=1,ip1jmp1
-            newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l))
+            newmasse=masse(ij,l,iq)+w(ij,l+1)-w(ij,l)
+            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+wq(ij,l+1)-wq(ij,l))
      &         /newmasse
-            masse(ij,l)=newmasse
-         ENDDO
-      ENDDO
-
+            masse(ij,l,iq)=newmasse
+         ENDDO
+      ENDDO
+
+! retablir les fils en rapport de melange par rapport a l'air:
+      if (nqfils(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)  
+         DO l=1,llm
+          DO ij=1,ip1jmp1
+            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)            
+          enddo
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+      endif !if (nqfils(iq).gt.0) then
+      !write(*,*) 'vlsplt 1032'
 
       RETURN
Index: trunk/LMDZ.COMMON/libf/dyn3d/vlspltqs.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d/vlspltqs.F	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d/vlspltqs.F	(revision 1508)
@@ -1,7 +1,8 @@
-!
-! $Header$
-!
+c
+c $Id: vlspltqs.F 2286 2015-05-20 13:27:07Z emillour $
+c
        SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt,
-     ,                                  p,pk,teta                 )
+     ,                                  p,pk,teta,iq             )
+       USE infotrac, ONLY: nqtot,nqdesc,iqfils
 c
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron 
@@ -33,7 +34,8 @@
       REAL masse(ip1jmp1,llm),pente_max
       REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
-      REAL q(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nqtot)
       REAL w(ip1jmp1,llm),pdt
       REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+      INTEGER iq ! CRisi
 c
 c      Local 
@@ -41,11 +43,12 @@
 c
       INTEGER i,ij,l,j,ii
+      INTEGER ifils,iq2 ! CRisi
 c
       REAL qsat(ip1jmp1,llm)
-      REAL zm(ip1jmp1,llm)
+      REAL zm(ip1jmp1,llm,nqtot)
       REAL mu(ip1jmp1,llm)
       REAL mv(ip1jm,llm)
       REAL mw(ip1jmp1,llm+1)
-      REAL zq(ip1jmp1,llm)
+      REAL zq(ip1jmp1,llm,nqtot)
       REAL temps1,temps2,temps3
       REAL zzpbar, zzw
@@ -63,5 +66,4 @@
       REAL rtt,retv,r2es,r3les,r3ies,r4les,r4ies,play
       REAL ptarg,pdelarg,foeew,zdelta
-! ADAPTATION GCM POUR CP(T)
       REAL tempe(ip1jmp1,llm)
 
@@ -115,31 +117,33 @@
       ENDDO
 
-      CALL SCOPY(ijp1llm,q,1,zq,1)
-      CALL SCOPY(ijp1llm,masse,1,zm,1)
+      CALL SCOPY(ijp1llm,q(1,1,iq),1,zq(1,1,iq),1)
+      CALL SCOPY(ijp1llm,masse,1,zm(1,1,iq),1)
+      if (nqdesc(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+        iq2=iqfils(ifils,iq)
+        CALL SCOPY(ijp1llm,q(1,1,iq2),1,zq(1,1,iq2),1)
+       enddo  
+      endif !if (nqfils(iq).gt.0) then
 
 c      call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
-      call vlxqs(zq,pente_max,zm,mu,qsat)
-
+      call vlxqs(zq,pente_max,zm,mu,qsat,iq)
 
 c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
 
-      call vlyqs(zq,pente_max,zm,mv,qsat)
-
+      call vlyqs(zq,pente_max,zm,mv,qsat,iq)
 
 c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
 
-      call vlz(zq,pente_max,zm,mw)
-
+      call vlz(zq,pente_max,zm,mw,iq)
 
 c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
 c     call minmaxq(zm,qmin,qmax,'M avant vlyqs     ')
 
-      call vlyqs(zq,pente_max,zm,mv,qsat)
-
+      call vlyqs(zq,pente_max,zm,mv,qsat,iq)
 
 c     call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
 c     call minmaxq(zm,qmin,qmax,'M avant vlxqs     ')
 
-      call vlxqs(zq,pente_max,zm,mu,qsat)
+      call vlxqs(zq,pente_max,zm,mu,qsat,iq)
 
 c     call minmaxq(zq,qmin,qmax,'apres vlxqs     ')
@@ -149,14 +153,31 @@
       DO l=1,llm
          DO ij=1,ip1jmp1
-           q(ij,l)=zq(ij,l)
+           q(ij,l,iq)=zq(ij,l,iq)
          ENDDO
          DO ij=1,ip1jm+1,iip1
-            q(ij+iim,l)=q(ij,l)
-         ENDDO
-      ENDDO
+            q(ij+iim,l,iq)=q(ij,l,iq)
+         ENDDO
+      ENDDO
+      ! CRisi: aussi pour les fils
+      if (nqdesc(iq).gt.0) then
+      do ifils=1,nqdesc(iq)
+        iq2=iqfils(ifils,iq)
+        DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l,iq2)=zq(ij,l,iq2)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l,iq2)=q(ij,l,iq2)
+         ENDDO
+        ENDDO
+      enddo !do ifils=1,nqdesc(iq)  
+      endif ! if (nqfils(iq).gt.0) then
+      !write(*,*) 'vlspltqs 183: fin de la routine'
 
       RETURN
       END
-      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat)
+      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat,iq)
+      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
+
 c
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
@@ -175,8 +196,9 @@
 c   Arguments:
 c   ----------
-      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse(ip1jmp1,llm,nqtot),pente_max
       REAL u_m( ip1jmp1,llm )
-      REAL q(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nqtot)
       REAL qsat(ip1jmp1,llm)
+      INTEGER iq ! CRisi
 c
 c      Local 
@@ -191,4 +213,8 @@
       REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
       REAL u_mq(ip1jmp1,llm)
+
+      ! CRisi
+      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot)
+      INTEGER ifils,iq2 ! CRisi
 
       Logical first,testcpu
@@ -223,7 +249,7 @@
          DO l = 1, llm
             DO ij=iip2,ip1jm-1
-               dxqu(ij)=q(ij+1,l)-q(ij,l)
+               dxqu(ij)=q(ij+1,l,iq)-q(ij,l,iq)
 c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
-c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+c              sigu(ij)=u_m(ij,l)/masse(ij,l,iq)
             ENDDO
             DO ij=iip1+iip1,ip1jm,iip1
@@ -277,5 +303,5 @@
          DO l = 1, llm
             DO ij=iip2,ip1jm-1
-               dxqu(ij)=q(ij+1,l)-q(ij,l)
+               dxqu(ij)=q(ij+1,l,iq)-q(ij,l,iq)
             ENDDO
             DO ij=iip1+iip1,ip1jm,iip1
@@ -319,11 +345,11 @@
       DO l=1,llm
        DO ij=iip2,ip1jm-1
-          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
-     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l,iq),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l,iq),
      ,                     u_m(ij,l))
           zdum(ij,l)=0.5*zdum(ij,l)
           u_mq(ij,l)=cvmgp(
-     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
-     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                q(ij,l,iq)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l,iq)-zdum(ij,l)*dxq(ij+1,l),
      ,                u_m(ij,l))
           u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
@@ -337,11 +363,11 @@
        DO ij=iip2,ip1jm-1
           IF (u_m(ij,l).gt.0.) THEN
-             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l,iq)
              u_mq(ij,l)=u_m(ij,l)*
-     $         min(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l),qsat(ij+1,l))
+     $         min(q(ij,l,iq)+0.5*zdum(ij,l)*dxq(ij,l),qsat(ij+1,l))
           ELSE
-             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l,iq)
              u_mq(ij,l)=u_m(ij,l)*
-     $         min(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l),qsat(ij,l))
+     $         min(q(ij+1,l,iq)-0.5*zdum(ij,l)*dxq(ij+1,l),qsat(ij,l))
           ENDIF
        ENDDO
@@ -412,7 +438,8 @@
                      i=ijq-(j-1)*iip1
 c   accumulation pour les mailles completements advectees
-                     do while(zu_m.gt.masse(ijq,l))
-                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
-                        zu_m=zu_m-masse(ijq,l)
+                     do while(zu_m.gt.masse(ijq,l,iq))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l,iq)
+     &                          *masse(ijq,l,iq)
+                        zu_m=zu_m-masse(ijq,l,iq)
                         i=mod(i-2+iim,iim)+1
                         ijq=(j-1)*iip1+i
@@ -420,18 +447,20 @@
 c   ajout de la maille non completement advectee
                      u_mq(ij,l)=u_mq(ij,l)+zu_m*
-     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+     &                  (q(ijq,l,iq)+0.5*(1.-zu_m/masse(ijq,l,iq))
+     &                  *dxq(ijq,l))
                   ELSE
                      ijq=ij+1
                      i=ijq-(j-1)*iip1
 c   accumulation pour les mailles completements advectees
-                     do while(-zu_m.gt.masse(ijq,l))
-                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
-                        zu_m=zu_m+masse(ijq,l)
+                     do while(-zu_m.gt.masse(ijq,l,iq))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l,iq)
+     &                          *masse(ijq,l,iq)
+                        zu_m=zu_m+masse(ijq,l,iq)
                         i=mod(i,iim)+1
                         ijq=(j-1)*iip1+i
                      ENDDO
 c   ajout de la maille non completement advectee
-                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
-     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l,iq)-
+     &               0.5*(1.+zu_m/masse(ijq,l,iq))*dxq(ijq,l))
                   ENDIF
                ENDDO
@@ -450,4 +479,25 @@
       ENDDO
 
+! CRisi: appel récursif de l'advection sur les fils.
+! Il faut faire ça avant d'avoir mis à jour q et masse
+      !write(*,*) 'vlspltqs 326: iq,nqfils(iq)=',iq,nqfils(iq) 
+      
+      if (nqfils(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)
+         DO l=1,llm
+          DO ij=iip2,ip1jm
+           ! On a besoin de q et masse seulement entre iip2 et ip1jm 
+           masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
+           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
+          enddo   
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+        do ifils=1,nqfils(iq)
+         iq2=iqfils(ifils,iq)
+         call vlx(Ratio,pente_max,masseq,u_mq,iq2)
+        enddo !do ifils=1,nqfils(iq)
+      endif !if (nqfils(iq).gt.0) then
+! end CRisi
 
 c   calcul des tendances
@@ -455,16 +505,33 @@
       DO l=1,llm
          DO ij=iip2+1,ip1jm
-            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+
+            new_m=masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
      &      u_mq(ij-1,l)-u_mq(ij,l))
      &      /new_m
-            masse(ij,l)=new_m
+            masse(ij,l,iq)=new_m
          ENDDO
 c   Modif Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
          DO ij=iip1+iip1,ip1jm,iip1
-            q(ij-iim,l)=q(ij,l)
-            masse(ij-iim,l)=masse(ij,l)
-         ENDDO
-      ENDDO
+            q(ij-iim,l,iq)=q(ij,l,iq)
+            masse(ij-iim,l,iq)=masse(ij,l,iq)
+         ENDDO
+      ENDDO
+
+      ! retablir les fils en rapport de melange par rapport a l'air:
+      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio 
+      ! puis on boucle en longitude
+      if (nqdesc(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)  
+         DO l=1,llm
+          DO ij=iip2+1,ip1jm
+            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)            
+          enddo
+          DO ij=iip1+iip1,ip1jm,iip1
+             q(ij-iim,l,iq2)=q(ij,l,iq2)
+          enddo ! DO ij=ijb+iip1-1,ije,iip1
+         enddo !DO l=1,llm
+        enddo !do ifils=1,nqdesc(iq)
+      endif !if (nqfils(iq).gt.0) then
 
 c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
@@ -474,5 +541,7 @@
       RETURN
       END
-      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat)
+      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat,iq)
+      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
+      USE comconst_mod, ONLY: pi
 c
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
@@ -486,6 +555,4 @@
 c
 c   --------------------------------------------------------------------
-      USE comconst_mod, ONLY: pi
-
       IMPLICIT NONE
 c
@@ -497,8 +564,9 @@
 c   Arguments:
 c   ----------
-      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse(ip1jmp1,llm,nqtot),pente_max
       REAL masse_adv_v( ip1jm,llm)
-      REAL q(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nqtot)
       REAL qsat(ip1jmp1,llm)
+      INTEGER iq ! CRisi
 c
 c      Local 
@@ -524,4 +592,7 @@
       SAVE sinlon,coslon,sinlondlon,coslondlon
       SAVE airej2,airejjm
+
+      REAL masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot) ! CRisi
+      INTEGER ifils,iq2 ! CRisi
 c
 c
@@ -562,6 +633,6 @@
 
       DO i = 1, iim
-      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
-      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l,iq)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l,iq)
       ENDDO
       qpns   = SSUM( iim,  airescb ,1 ) / airej2
@@ -571,5 +642,5 @@
 
       DO ij=1,ip1jm
-         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         dyqv(ij)=q(ij,l,iq)-q(ij+iip1,l,iq)
          adyqv(ij)=abs(dyqv(ij))
       ENDDO
@@ -586,6 +657,6 @@
 
       DO ij=1,iip1
-         dyq(ij,l)=qpns-q(ij+iip1,l)
-         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+         dyq(ij,l)=qpns-q(ij+iip1,l,iq)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l,iq)-qpsn
       ENDDO
 
@@ -705,9 +776,10 @@
        DO ij=1,ip1jm
          IF( masse_adv_v(ij,l).GT.0. ) THEN
-           qbyv(ij,l)= MIN( qsat(ij+iip1,l), q(ij+iip1,l )  +
-     ,      dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l)))
+           qbyv(ij,l)= MIN( qsat(ij+iip1,l), q(ij+iip1,l,iq )  +
+     ,      dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l)
+     ,      /masse(ij+iip1,l,iq)))
          ELSE
-              qbyv(ij,l)= MIN( qsat(ij,l), q(ij,l) - dyq(ij,l) *
-     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l)) )
+              qbyv(ij,l)= MIN( qsat(ij,l), q(ij,l,iq) - dyq(ij,l) *
+     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l,iq)) )
          ENDIF
           qbyv(ij,l) = masse_adv_v(ij,l)*qbyv(ij,l)
@@ -716,11 +788,33 @@
 
 
+! CRisi: appel récursif de l'advection sur les fils.
+! Il faut faire ça avant d'avoir mis à jour q et masse
+      !write(*,*) 'vlyqs 689: iq,nqfils(iq)=',iq,nqfils(iq) 
+   
+      if (nqfils(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)
+         DO l=1,llm
+         DO ij=1,ip1jmp1
+           masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
+           Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
+          enddo   
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+
+        do ifils=1,nqfils(iq)
+         iq2=iqfils(ifils,iq)
+         !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
+         call vly(Ratio,pente_max,masseq,qbyv,iq2)
+        enddo !do ifils=1,nqfils(iq)
+      endif !if (nqfils(iq).gt.0) then
+
       DO l=1,llm
          DO ij=iip2,ip1jm
-            newmasse=masse(ij,l)
+            newmasse=masse(ij,l,iq)
      &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
-     &         /newmasse
-            masse(ij,l)=newmasse
+            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+qbyv(ij,l)
+     &         -qbyv(ij-iip1,l))/newmasse
+            masse(ij,l,iq)=newmasse
          ENDDO
 c.-. ancienne version
@@ -728,16 +822,16 @@
          convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
          DO ij = 1,iip1
-            newmasse=masse(ij,l)+convmpn*aire(ij)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
+            newmasse=masse(ij,l,iq)+convmpn*aire(ij)
+            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+convpn*aire(ij))/
      &               newmasse
-            masse(ij,l)=newmasse
+            masse(ij,l,iq)=newmasse
          ENDDO
          convps  = -SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
          convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols
          DO ij = ip1jm+1,ip1jmp1
-            newmasse=masse(ij,l)+convmps*aire(ij)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
+            newmasse=masse(ij,l,iq)+convmps*aire(ij)
+            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+convps*aire(ij))/
      &               newmasse
-            masse(ij,l)=newmasse
+            masse(ij,l,iq)=newmasse
          ENDDO
 c.-. fin ancienne version
@@ -752,5 +846,5 @@
 c        DO ij = 1,iip1
 c           q(ij,l)=newq
-c           masse(ij,l)=newmasse*aire(ij)
+c           masse(ij,l,iq)=newmasse*aire(ij)
 c        ENDDO
 c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
@@ -762,9 +856,24 @@
 c        DO ij = ip1jm+1,ip1jmp1
 c           q(ij,l)=newq
-c           masse(ij,l)=newmasse*aire(ij)
+c           masse(ij,l,iq)=newmasse*aire(ij)
 c        ENDDO
 c._. fin nouvelle version
       ENDDO
 
+      !write(*,*) 'vly 866'
+
+! retablir les fils en rapport de melange par rapport a l'air:
+      if (nqdesc(iq).gt.0) then  
+       do ifils=1,nqdesc(iq)
+         iq2=iqfils(ifils,iq)  
+         DO l=1,llm
+          DO ij=1,ip1jmp1
+            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)            
+          enddo
+         enddo
+        enddo !do ifils=1,nqdesc(iq)
+      endif !if (nqfils(iq).gt.0) then
+      !write(*,*) 'vly 879'
+
       RETURN
       END
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/covcont.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/covcont.F	(revision 1507)
+++ 	(revision )
@@ -1,43 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE covcont (klevel,ucov, vcov, ucont, vcont )
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c
-c  *********************************************************************
-c    calcul des compos. contravariantes a partir des comp.covariantes
-c  ********************************************************************
-c
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-      INTEGER klevel
-      REAL ucov( ip1jmp1,klevel ),  vcov( ip1jm,klevel )
-      REAL ucont( ip1jmp1,klevel ), vcont( ip1jm,klevel )
-      INTEGER   l,ij
-
-
-      DO 10 l = 1,klevel
-
-      DO 2  ij = iip2, ip1jm
-      ucont( ij,l ) = ucov( ij,l ) * unscu2( ij )
-   2  CONTINUE
-
-      DO 4 ij = 1,ip1jm
-      vcont( ij,l ) = vcov( ij,l ) * unscv2( ij )
-   4  CONTINUE
-
-  10  CONTINUE
-      RETURN
-      END
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/covcont.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/covcont.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/covcont.F90	(revision 1508)
@@ -0,0 +1,29 @@
+SUBROUTINE covcont (klevel,ucov, vcov, ucont, vcont )
+!
+!-------------------------------------------------------------------------------
+! Author: P. Le Van
+!-------------------------------------------------------------------------------
+! Purpose: Compute contravariant components from covariant components.
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "comgeom.h"
+!===============================================================================
+! Arguments:
+  INTEGER, INTENT(IN)  :: klevel                    !--- VERTICAL LEVELS NUMBER
+  REAL,    INTENT(IN)  :: ucov ( ip1jmp1,klevel )   !--- U COVARIANT WIND
+  REAL,    INTENT(IN)  :: vcov ( ip1jm  ,klevel )   !--- V COVARIANT WIND
+  REAL,    INTENT(OUT) :: ucont( ip1jmp1,klevel )   !--- U CONTRAVAR WIND
+  REAL,    INTENT(OUT) :: vcont( ip1jm  ,klevel )   !--- V CONTRAVAR WIND
+!===============================================================================
+!   Local variables:
+  INTEGER :: l
+!===============================================================================
+  DO l=1,klevel
+    ucont(iip2:ip1jm,l)=ucov(iip2:ip1jm,l) * unscu2(iip2:ip1jm)
+    vcont(   1:ip1jm,l)=vcov(   1:ip1jm,l) * unscv2(   1:ip1jm)
+  END DO
+
+END SUBROUTINE covcont
+
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F	(revision 1507)
+++ 	(revision )
@@ -1,499 +1,0 @@
-!
-! $Id $
-!
-      SUBROUTINE dynetat0(fichnom,vcov,ucov,
-     .                    teta,q,masse,ps,phis,time0)
-
-      USE infotrac, only: tname, nqtot
-      use netcdf, only: nf90_open,NF90_NOWRITE,nf90_noerr,nf90_strerror,
-     &                  nf90_get_var, nf90_inq_varid, nf90_inq_dimid,
-     &                  nf90_inquire_dimension,nf90_close
-
-      use control_mod, only : planet_type, timestart
-      USE comvert_mod, ONLY: pa,preff
-      USE comconst_mod, ONLY: im,jm,lllm,daysec,dtvr,
-     .			rad,omeg,g,cpp,kappa,pi
-      USE logic_mod, ONLY: fxyhypb,ysinus
-      USE serre_mod, ONLY: clon,clat,grossismx,grossismy
-      USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,
-     .			start_time,day_ini,hour_ini
-      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
-
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van / L.Fairhead
-c   -------
-c
-c   objet:
-c   ------
-c
-c   Lecture de l'etat initial
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "netcdf.inc"
-#include "iniprint.h"
-
-c   Arguments:
-c   ----------
-
-      CHARACTER(len=*),INTENT(IN) :: fichnom
-      REAL,INTENT(OUT) :: vcov(iip1,jjm,llm)
-      REAL,INTENT(OUT) :: ucov(iip1,jjp1,llm)
-      REAL,INTENT(OUT) :: teta(iip1,jjp1,llm)
-      REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot)
-      REAL,INTENT(OUT) :: masse(iip1,jjp1,llm)
-      REAL,INTENT(OUT) :: ps(iip1,jjp1)
-      REAL,INTENT(OUT) :: phis(iip1,jjp1)
-      REAL,INTENT(OUT) :: time0
-
-c   Variables 
-c
-      INTEGER length,iq
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr, nid, nvarid
-
-      character(len=12) :: start_file_type="earth" ! default start file type
-      INTEGER idecal
-
-
-      REAL,ALLOCATABLE :: time(:) ! times stored in start
-      INTEGER timelen ! number of times stored in the file
-      INTEGER indextime ! index of selected time
-      !REAL  hour_ini ! fraction of day of stored date. Equivalent of day_ini, but 0=<hour_ini<1
-
-      INTEGER edges(4),corner(4)
-      integer :: i
-
-c-----------------------------------------------------------------------
-
-c  Ouverture NetCDF du fichier etat initial
-
-      ierr=nf90_open(fichnom,NF90_NOWRITE,nid)
-      IF (ierr.NE.nf90_noerr) THEN
-        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
-        write(lunout,*)trim(nf90_strerror(ierr))
-        CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-c
-      ierr = nf90_inq_varid (nid, "controle", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <controle> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, tab_cntrl)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      !!! AS: idecal is a hack to be able to read planeto starts...
-      !!!     .... while keeping everything OK for LMDZ EARTH
-      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
-          write(lunout,*)'dynetat0 : Planeto-like start file'
-          start_file_type="planeto"
-          idecal = 4
-          annee_ref  = 2000
-      else
-          write(lunout,*)'dynetat0 : Earth-like start file'
-          idecal = 5
-          annee_ref  = tab_cntrl(5)
-      endif
-
-
-      im         = tab_cntrl(1)
-      jm         = tab_cntrl(2)
-      lllm       = tab_cntrl(3)
-      if (start_file_type.eq."earth") then
-        day_ref    = tab_cntrl(4)
-      else
-        day_ini    = tab_cntrl(4)
-        day_ref=0
-      endif
-      rad        = tab_cntrl(idecal+1)
-      omeg       = tab_cntrl(idecal+2)
-      g          = tab_cntrl(idecal+3)
-      cpp        = tab_cntrl(idecal+4)
-      kappa      = tab_cntrl(idecal+5)
-      daysec     = tab_cntrl(idecal+6)
-      dtvr       = tab_cntrl(idecal+7)
-      etot0      = tab_cntrl(idecal+8)
-      ptot0      = tab_cntrl(idecal+9)
-      ztot0      = tab_cntrl(idecal+10)
-      stot0      = tab_cntrl(idecal+11)
-      ang0       = tab_cntrl(idecal+12)
-      pa         = tab_cntrl(idecal+13)
-      preff      = tab_cntrl(idecal+14)
-c
-      clon       = tab_cntrl(idecal+15)
-      clat       = tab_cntrl(idecal+16)
-      grossismx  = tab_cntrl(idecal+17)
-      grossismy  = tab_cntrl(idecal+18)
-c
-      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
-        fxyhypb  = . TRUE .
-c        dzoomx   = tab_cntrl(25)
-c        dzoomy   = tab_cntrl(26)
-c        taux     = tab_cntrl(28)
-c        tauy     = tab_cntrl(29)
-      ELSE
-        fxyhypb = . FALSE .
-        ysinus  = . FALSE .
-        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE. 
-      ENDIF
-
-      if (planet_type=="mars") then ! so far this is only for Mars
-        hour_ini = tab_cntrl(29)
-      else
-        hour_ini=0
-      endif
-
-      if (start_file_type.eq."earth") then
-        day_ini = tab_cntrl(30)
-        itau_dyn = tab_cntrl(31)
-        start_time = tab_cntrl(32)
-      else
-        day_ini=tab_cntrl(4)
-        itau_dyn=0
-        start_time=0
-      endif
-c   .................................................................
-c
-c
-      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa ',
-     &               rad,omeg,g,cpp,kappa
-
-      IF(   im.ne.iim           )  THEN
-          PRINT 1,im,iim
-          STOP
-      ELSE  IF( jm.ne.jjm       )  THEN
-          PRINT 2,jm,jjm
-          STOP
-      ELSE  IF( lllm.ne.llm     )  THEN
-          PRINT 3,lllm,llm
-          STOP
-      ENDIF
-
-      ierr=nf90_inq_varid(nid, "rlonu", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, rlonu)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = nf90_inq_varid (nid, "rlatu", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, rlatu)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = nf90_inq_varid (nid, "rlonv", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, rlonv)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = nf90_inq_varid (nid, "rlatv", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, rlatv)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = nf90_inq_varid (nid, "cu", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <cu> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, cu)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = nf90_inq_varid (nid, "cv", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <cv> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, cv)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = nf90_inq_varid (nid, "aire", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <aire> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, aire)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr = nf90_inq_varid (nid, "phisinit", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr = nf90_get_var(nid, nvarid, phis)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-! read time axis
-      ierr = nf90_inq_varid (nid, "temps", nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-        write(lunout,*)"dynetat0: Le champ <temps> est absent"
-        write(lunout,*)"dynetat0: J essaie <Time>"
-        ierr = nf90_inq_varid (nid, "Time", nvarid)
-        IF (ierr .NE. nf90_noerr) THEN
-           write(lunout,*)"dynetat0: Le champ <Time> est absent"
-           write(lunout,*)trim(nf90_strerror(ierr))
-           CALL ABORT_gcm("dynetat0", "", 1)
-        ENDIF
-        ! Get the length of the "Time" dimension
-        ierr = nf90_inq_dimid(nid,"Time",nvarid)
-        ierr = nf90_inquire_dimension(nid,nvarid,len=timelen)
-        allocate(time(timelen))
-        ! Then look for the "Time" variable
-        ierr  =nf90_inq_varid(nid,"Time",nvarid)
-        ierr = nf90_get_var(nid, nvarid, time)
-        IF (ierr .NE. nf90_noerr) THEN
-           write(lunout,*)"dynetat0: Lecture echouee <Time>"
-           write(lunout,*)trim(nf90_strerror(ierr))
-           CALL ABORT_gcm("dynetat0", "", 1)
-        ENDIF
-      ELSE   
-        ! Get the length of the "temps" dimension
-        ierr = nf90_inq_dimid(nid,"temps",nvarid)
-        ierr = nf90_inquire_dimension(nid,nvarid,len=timelen)
-        allocate(time(timelen))
-        ! Then look for the "temps" variable
-        ierr = nf90_inq_varid (nid, "temps", nvarid)
-        ierr = nf90_get_var(nid, nvarid, time)
-        IF (ierr .NE. nf90_noerr) THEN
-           write(lunout,*)"dynetat0: Lecture echouee <temps>"
-           write(lunout,*)trim(nf90_strerror(ierr))
-           CALL ABORT_gcm("dynetat0", "", 1)
-        ENDIF
-      ENDIF
-
-! select the desired time
-      IF (timestart .lt. 0) THEN  ! default: we use the last time value
-        indextime = timelen
-      ELSE  ! else we look for the desired value in the time axis
-       indextime = 0
-        DO i=1,timelen
-          IF (abs(time(i) - timestart) .lt. 0.01) THEN
-             indextime = i
-             EXIT
-          ENDIF
-        ENDDO
-        IF (indextime .eq. 0) THEN
-          write(lunout,*)"Time", timestart," is not in "
-     &                                      //trim(fichnom)//"!!"
-          write(lunout,*)"Stored times are:"
-          DO i=1,timelen
-             PRINT*, time(i)
-          ENDDO
-          CALL ABORT_gcm("dynetat0", "", 1)
-        ENDIF
-      ENDIF
-
-      if (planet_type=="mars") then
-        ! In start the absolute date is day_ini + hour_ini + time
-        ! For now on, in the GCM dynamics, it is day_ini + time0
-        time0 = time(indextime) + hour_ini
-        day_ini = day_ini + INT(time0)
-        time0 = time0 - INT(time0) ! time0 devient le nouveau hour_ini
-        hour_ini = time0
-      else
-        time0 = time(indextime) 
-      endif
-      
-      PRINT*, "dynetat0: Selected time ",time(indextime),
-     .        " at index ",indextime
-      
-      DEALLOCATE(time)
-
-! read vcov
-      corner(1)=1
-      corner(2)=1
-      corner(3)=1
-      corner(4)=indextime
-      edges(1)=iip1
-      edges(2)=jjm
-      edges(3)=llm
-      edges(4)=1
-      ierr=nf90_inq_varid(nid,"vcov",nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,vcov,corner,edges)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-! read ucov
-      corner(1)=1
-      corner(2)=1
-      corner(3)=1
-      corner(4)=indextime
-      edges(1)=iip1
-      edges(2)=jjp1
-      edges(3)=llm
-      edges(4)=1
-      ierr=nf90_inq_varid(nid,"ucov",nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,ucov,corner,edges)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
- 
-! read teta (same corner/edges as ucov)
-      ierr=nf90_inq_varid(nid,"teta",nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <teta> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,teta,corner,edges)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-! read tracers (same corner/edges as ucov)
-      IF(nqtot.GE.1) THEN
-      DO iq=1,nqtot
-        ierr= nf90_inq_varid(nid,tname(iq),nvarid)
-        IF (ierr .NE. nf90_noerr) THEN
-           write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
-     &                    "> est absent"
-           write(lunout,*)"          Il est donc initialise a zero"
-           q(:,:,:,iq)=0.
-        ELSE
-           ierr=nf90_get_var(nid,nvarid,q(:,:,:,iq),corner,edges)
-          IF (ierr .NE. nf90_noerr) THEN
-            write(lunout,*)"dynetat0: Lecture echouee pour "
-     &                                //trim(tname(iq))
-            write(lunout,*)trim(nf90_strerror(ierr))
-            CALL ABORT_gcm("dynetat0", "", 1)
-          ENDIF
-        ENDIF
-      ENDDO
-      ENDIF
-
-!read masse (same corner/edges as ucov)
-      ierr=nf90_inq_varid(nid,"masse",nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <masse> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,masse,corner,edges)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-! read ps
-      corner(1)=1
-      corner(2)=1
-      corner(3)=indextime
-      edges(1)=iip1
-      edges(2)=jjp1
-      edges(3)=1
-      ierr=nf90_inq_varid(nid,"ps",nvarid)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Le champ <ps> est absent"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,ps,corner,edges)
-      IF (ierr .NE. nf90_noerr) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
-         write(lunout,*)trim(nf90_strerror(ierr))
-         CALL ABORT_gcm("dynetat0", "", 1)
-      ENDIF
-
-      ierr=nf90_close(nid)
-
-      if (planet_type/="mars") then
-       day_ini=day_ini+INT(time0) ! obsolete stuff ; 0<time<1 anyways
-       time0=time0-INT(time0)
-      endif
-
-  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
-     *arrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
-     *arrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
-     *rrage est differente de la valeur parametree llm =',i4//)
-   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
-     *rrage est differente de la valeur  dtinteg =',i4//)
-
-      RETURN
-      END
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/dynetat0.F90	(revision 1508)
@@ -0,0 +1,398 @@
+!
+! $Id $
+!
+SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time0)
+
+      USE infotrac, only: tname, nqtot, zone_num, iso_indnum,&
+                          iso_num, phase_num, alpha_ideal, iqiso, &
+                          ok_isotopes, iqpere, tnat
+      use netcdf, only: nf90_open,NF90_NOWRITE,nf90_noerr,nf90_strerror, &
+                        nf90_get_var, nf90_inq_varid, nf90_inq_dimid, &
+                        nf90_inquire_dimension,nf90_close
+
+      use control_mod, only : planet_type, timestart
+      USE comvert_mod, ONLY: pa,preff
+      USE comconst_mod, ONLY: im,jm,lllm,daysec,dtvr, &
+     			rad,omeg,g,cpp,kappa,pi
+      USE logic_mod, ONLY: fxyhypb,ysinus
+      USE serre_mod, ONLY: clon,clat,grossismx,grossismy
+      USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn, &
+      			start_time,day_ini,hour_ini
+      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
+
+      IMPLICIT NONE
+
+!=======================================================================
+!
+! Read initial confitions file
+!
+!=======================================================================
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comgeom2.h"
+  include "iniprint.h"
+
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
+  REAL, INTENT(OUT) ::  vcov(iip1,jjm, llm)        !--- V COVARIANT WIND
+  REAL, INTENT(OUT) ::  ucov(iip1,jjp1,llm)        !--- U COVARIANT WIND
+  REAL, INTENT(OUT) ::  teta(iip1,jjp1,llm)        !--- POTENTIAL TEMP.
+  REAL, INTENT(OUT) ::     q(iip1,jjp1,llm,nqtot)  !--- TRACERS
+  REAL, INTENT(OUT) :: masse(iip1,jjp1,llm)        !--- MASS PER CELL
+  REAL, INTENT(OUT) ::    ps(iip1,jjp1)            !--- GROUND PRESSURE
+  REAL, INTENT(OUT) ::  phis(iip1,jjp1)            !--- GEOPOTENTIAL
+  REAL,INTENT(OUT) :: time0
+!===============================================================================
+!   Local Variables 
+  CHARACTER(LEN=256) :: msg, var, modname
+  INTEGER,PARAMETER :: length=100
+  INTEGER :: iq, fID, vID, idecal
+  REAL :: tab_cntrl(length) ! array containing run parameters
+  INTEGER :: ierr
+  CHARACTER(len=12) :: start_file_type="earth" ! default start file type
+
+  REAL,ALLOCATABLE :: time(:) ! times stored in start
+  INTEGER :: timelen ! number of times stored in the file
+  INTEGER :: indextime ! index of selected time
+  !REAL  hour_ini ! fraction of day of stored date. Equivalent of day_ini, but 0=<hour_ini<1
+
+  INTEGER :: edges(4),corner(4)
+  INTEGER :: i
+
+!-----------------------------------------------------------------------
+  modname="dynetat0"
+
+!  Open initial state NetCDF file
+  var=fichnom
+  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
+!
+  CALL get_var1("controle",tab_cntrl)
+
+      !!! AS: idecal is a hack to be able to read planeto starts...
+      !!!     .... while keeping everything OK for LMDZ EARTH
+      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
+          write(lunout,*)'dynetat0 : Planeto-like start file'
+          start_file_type="planeto"
+          idecal = 4
+          annee_ref  = 2000
+      else
+          write(lunout,*)'dynetat0 : Earth-like start file'
+          idecal = 5
+          annee_ref  = tab_cntrl(5)
+      endif
+
+
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      if (start_file_type.eq."earth") then
+        day_ref    = tab_cntrl(4)
+      else
+        day_ini    = tab_cntrl(4)
+        day_ref=0
+      endif
+      rad        = tab_cntrl(idecal+1)
+      omeg       = tab_cntrl(idecal+2)
+      g          = tab_cntrl(idecal+3)
+      cpp        = tab_cntrl(idecal+4)
+      kappa      = tab_cntrl(idecal+5)
+      daysec     = tab_cntrl(idecal+6)
+      dtvr       = tab_cntrl(idecal+7)
+      etot0      = tab_cntrl(idecal+8)
+      ptot0      = tab_cntrl(idecal+9)
+      ztot0      = tab_cntrl(idecal+10)
+      stot0      = tab_cntrl(idecal+11)
+      ang0       = tab_cntrl(idecal+12)
+      pa         = tab_cntrl(idecal+13)
+      preff      = tab_cntrl(idecal+14)
+!
+      clon       = tab_cntrl(idecal+15)
+      clat       = tab_cntrl(idecal+16)
+      grossismx  = tab_cntrl(idecal+17)
+      grossismy  = tab_cntrl(idecal+18)
+!
+      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
+        fxyhypb  = .TRUE.
+!        dzoomx   = tab_cntrl(25)
+!        dzoomy   = tab_cntrl(26)
+!        taux     = tab_cntrl(28)
+!        tauy     = tab_cntrl(29)
+      ELSE
+        fxyhypb = .FALSE.
+        ysinus  = .FALSE.
+        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = .TRUE. 
+      ENDIF
+
+      if (planet_type=="mars") then ! so far this is only for Mars
+        hour_ini = tab_cntrl(29)
+      else
+        hour_ini=0
+      endif
+
+      if (start_file_type.eq."earth") then
+        day_ini = tab_cntrl(30)
+        itau_dyn = tab_cntrl(31)
+        start_time = tab_cntrl(32)
+      else
+        day_ini=tab_cntrl(4)
+        itau_dyn=0
+        start_time=0
+      endif
+!   .................................................................
+!
+!
+  WRITE(lunout,*)trim(modname)//': rad,omeg,g,cpp,kappa ', &
+                     rad,omeg,g,cpp,kappa
+
+  CALL check_dim(im,iim,'im','iim')
+  CALL check_dim(jm,jjm,'jm','jjm')
+  CALL check_dim(llm,lllm,'llm','lllm')
+
+  CALL get_var1("rlonu",rlonu)
+  CALL get_var1("rlatu",rlatu)
+  CALL get_var1("rlonv",rlonv)
+  CALL get_var1("rlatv",rlatv)
+
+  CALL get_var2("cu"   ,cu)
+  CALL get_var2("cv"   ,cv)
+
+  CALL get_var2("aire" ,aire)
+  CALL get_var2("phisinit",phis)
+
+! read time axis
+      ierr = nf90_inq_varid (fID, "temps", vID)
+      IF (ierr .NE. nf90_noerr) THEN
+        write(lunout,*)"dynetat0: Le champ <temps> est absent"
+        write(lunout,*)"dynetat0: J essaie <Time>"
+        ierr = nf90_inq_varid (fID, "Time", vID)
+        IF (ierr .NE. nf90_noerr) THEN
+           write(lunout,*)"dynetat0: Le champ <Time> est absent"
+           write(lunout,*)trim(nf90_strerror(ierr))
+           CALL ABORT_gcm("dynetat0", "", 1)
+        ENDIF
+        ! Get the length of the "Time" dimension
+        ierr = nf90_inq_dimid(fID,"Time",vID)
+        ierr = nf90_inquire_dimension(fID,vID,len=timelen)
+        allocate(time(timelen))
+        ! Then look for the "Time" variable
+        ierr  =nf90_inq_varid(fID,"Time",vID)
+        ierr = nf90_get_var(fID, vID, time)
+        IF (ierr .NE. nf90_noerr) THEN
+           write(lunout,*)"dynetat0: Lecture echouee <Time>"
+           write(lunout,*)trim(nf90_strerror(ierr))
+           CALL ABORT_gcm("dynetat0", "", 1)
+        ENDIF
+      ELSE   
+        ! Get the length of the "temps" dimension
+        ierr = nf90_inq_dimid(fID,"temps",vID)
+        ierr = nf90_inquire_dimension(fID,vID,len=timelen)
+        allocate(time(timelen))
+        ! Then look for the "temps" variable
+        ierr = nf90_inq_varid (fID, "temps", vID)
+        ierr = nf90_get_var(fID, vID, time)
+        IF (ierr .NE. nf90_noerr) THEN
+           write(lunout,*)"dynetat0: Lecture echouee <temps>"
+           write(lunout,*)trim(nf90_strerror(ierr))
+           CALL ABORT_gcm("dynetat0", "", 1)
+        ENDIF
+      ENDIF
+
+! select the desired time
+      IF (timestart .lt. 0) THEN  ! default: we use the last time value
+        indextime = timelen
+      ELSE  ! else we look for the desired value in the time axis
+       indextime = 0
+        DO i=1,timelen
+          IF (abs(time(i) - timestart) .lt. 0.01) THEN
+             indextime = i
+             EXIT
+          ENDIF
+        ENDDO
+        IF (indextime .eq. 0) THEN
+          write(lunout,*)"Time", timestart," is not in " &
+                                            //trim(fichnom)//"!!"
+          write(lunout,*)"Stored times are:"
+          DO i=1,timelen
+             PRINT*, time(i)
+          ENDDO
+          CALL ABORT_gcm("dynetat0", "", 1)
+        ENDIF
+      ENDIF
+
+      if (planet_type=="mars") then
+        ! In start the absolute date is day_ini + hour_ini + time
+        ! For now on, in the GCM dynamics, it is day_ini + time0
+        time0 = time(indextime) + hour_ini
+        day_ini = day_ini + INT(time0)
+        time0 = time0 - INT(time0) ! time0 devient le nouveau hour_ini
+        hour_ini = time0
+      else
+        time0 = time(indextime) 
+      endif
+      
+      PRINT*, "dynetat0: Selected time ",time(indextime), &
+              " at index ",indextime
+      
+      DEALLOCATE(time)
+
+! read vcov
+  CALL get_var3v_t("vcov",vcov,indextime)
+
+! read ucov
+  CALL get_var3u_t("ucov",ucov,indextime)
+ 
+! read teta (same corner/edges as ucov)
+  CALL get_var3u_t("teta",teta,indextime)
+
+! read tracers (same corner/edges as ucov)
+  corner(1)=1
+  corner(2)=1
+  corner(3)=1
+  corner(4)=indextime
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=llm
+  edges(4)=1
+  IF(nqtot.GE.1) THEN
+      DO iq=1,nqtot
+        ierr= nf90_inq_varid(fID,tname(iq),vID)
+        IF (ierr .NE. nf90_noerr) THEN
+           write(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
+           write(lunout,*)"         It is hence initialized to zero"
+           q(:,:,:,iq)=0.
+           IF (planet_type=="earth") THEN
+            !--- CRisi: for isotops, theoretical initialization using very simplified
+            !           Rayleigh distillation las.
+            IF(ok_isotopes.AND.iso_num(iq)>0) THEN
+             IF(zone_num(iq)==0) q(:,:,:,iq)=q(:,:,:,iqpere(iq))*tnat(iso_num(iq))    &
+             &             *(q(:,:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
+             IF(zone_num(iq)==1) q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),phase_num(iq)))
+            END IF
+           ENDIF
+        ELSE
+           ierr=nf90_get_var(fID,vID,q(:,:,:,iq),corner,edges)
+          IF (ierr .NE. nf90_noerr) THEN
+            write(lunout,*)"dynetat0: Lecture echouee pour " &
+                                      //trim(tname(iq))
+            write(lunout,*)trim(nf90_strerror(ierr))
+            CALL ABORT_gcm("dynetat0", "", 1)
+          ENDIF
+        ENDIF
+      ENDDO
+  ENDIF
+
+!read masse (same corner/edges as ucov)
+  CALL get_var3u_t("masse",masse,indextime)
+
+!read ps
+  CALL get_var2_t("ps",ps,indextime)
+
+  CALL err(NF90_CLOSE(fID),"close",fichnom)
+
+  if (planet_type/="mars") then
+    day_ini=day_ini+INT(time0) ! obsolete stuff ; 0<time<1 anyways
+    time0=time0-INT(time0)
+  endif
+
+
+  CONTAINS
+
+SUBROUTINE check_dim(n1,n2,str1,str2)
+  INTEGER,          INTENT(IN) :: n1, n2
+  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
+  CHARACTER(LEN=256) :: s1, s2
+  IF(n1/=n2) THEN
+    s1='value of '//TRIM(str1)//' ='
+    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
+    WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2
+    CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
+  END IF
+END SUBROUTINE check_dim
+
+
+SUBROUTINE get_var1(var,v)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:)
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
+END SUBROUTINE get_var1
+
+
+SUBROUTINE get_var2(var,v)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:)
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
+END SUBROUTINE get_var2
+
+SUBROUTINE get_var2_t(var,v,indextime)
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:)
+  INTEGER, INTENT(IN) :: indextime
+  corner(1)=1
+  corner(2)=1
+  corner(3)=indextime
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=1
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v,corner,edges),"get",var)
+END SUBROUTINE get_var2_t
+
+
+SUBROUTINE get_var3(var,v) ! on U grid
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:,:)
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
+END SUBROUTINE get_var3
+
+SUBROUTINE get_var3u_t(var,v,indextime) ! on U grid
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:,:)
+  INTEGER, INTENT(IN) :: indextime
+  corner(1)=1
+  corner(2)=1
+  corner(3)=1
+  corner(4)=indextime
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=llm
+  edges(4)=1
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v,corner,edges),"get",var)
+END SUBROUTINE get_var3u_t
+
+SUBROUTINE get_var3v_t(var,v,indextime) ! on V grid
+  CHARACTER(LEN=*), INTENT(IN)  :: var
+  REAL,             INTENT(OUT) :: v(:,:,:)
+  INTEGER, INTENT(IN) :: indextime
+  corner(1)=1
+  corner(2)=1
+  corner(3)=1
+  corner(4)=indextime
+  edges(1)=iip1
+  edges(2)=jjm
+  edges(3)=llm
+  edges(4)=1
+  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(fID,vID,v,corner,edges),"get",var)
+END SUBROUTINE get_var3v_t
+
+SUBROUTINE err(ierr,typ,nam)
+  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
+  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
+  IF(ierr==NF90_NoERR) RETURN
+  SELECT CASE(typ)
+    CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
+    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
+    CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
+    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
+  END SELECT
+  CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
+END SUBROUTINE err
+
+END SUBROUTINE dynetat0
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F	(revision 1507)
+++ 	(revision )
@@ -1,800 +1,0 @@
-!
-! $Id: dynredem.F 1635 2012-07-12 11:37:16Z lguez $
-!
-c
-      SUBROUTINE dynredem0(fichnom,iday_end,phis)
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#endif
-      USE infotrac
-      use netcdf95, only: NF95_PUT_VAR
-      use control_mod, only : planet_type
-      USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff,
-     .			nivsig,nivsigs
-      USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
-      USE logic_mod, ONLY: fxyhypb,ysinus
-      USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy,
-     .			taux,tauy
-      USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin,
-     .			start_time,hour_ini
-      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
-
-      IMPLICIT NONE
-c=======================================================================
-c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
-c=======================================================================
-c   Declarations:
-c   -------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "netcdf.inc"
-#include "iniprint.h"
-
-c   Arguments:
-c   ----------
-      INTEGER iday_end
-      REAL phis(iip1, jjp1)
-      CHARACTER*(*) fichnom
-
-c   Local:
-c   ------
-      INTEGER iq,l
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr
-      character*20 modname
-      character*80 abort_message
-
-c   Variables locales pour NetCDF:
-c
-      INTEGER dims2(2), dims3(3), dims4(4)
-      INTEGER idim_index
-      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
-      INTEGER idim_s, idim_sig
-      INTEGER idim_tim
-      INTEGER nid,nvarid
-
-      REAL zan0,zjulian,hours
-      INTEGER yyears0,jjour0, mmois0
-      character*30 unites
-
-      character(len=12) :: start_file_type="earth" ! default start file type
-      INTEGER idecal
-
-c-----------------------------------------------------------------------
-      modname='dynredem0'
-
-#ifdef CPP_IOIPSL
-      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
-      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
-#else
-! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
-      yyears0=0
-      mmois0=1
-      jjour0=1
-#endif        
-
-      !!! AS: idecal is a hack to be able to read planeto starts...
-      !!!     .... while keeping everything OK for LMDZ EARTH
-      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
-          write(lunout,*) trim(modname),' : Planeto-like start file'
-          start_file_type="planeto"
-          idecal = 4
-      else
-          write(lunout,*) trim(modname),' : Earth-like start file'
-          idecal = 5
-      endif
-
-      DO l=1,length
-       tab_cntrl(l) = 0.
-      ENDDO
-       tab_cntrl(1)  = REAL(iim)
-       tab_cntrl(2)  = REAL(jjm)
-       tab_cntrl(3)  = REAL(llm)
-       if (start_file_type.eq."earth") then
-         tab_cntrl(4)=REAL(day_ref)
-       else
-         !tab_cntrl(4)=REAL(day_end)
-         tab_cntrl(4)=REAL(iday_end)
-       endif
-       tab_cntrl(5)  = REAL(annee_ref)
-       tab_cntrl(idecal+1)  = rad
-       tab_cntrl(idecal+2)  = omeg
-       tab_cntrl(idecal+3)  = g
-       tab_cntrl(idecal+4)  = cpp
-       tab_cntrl(idecal+5) = kappa
-       tab_cntrl(idecal+6) = daysec
-       tab_cntrl(idecal+7) = dtvr
-       tab_cntrl(idecal+8) = etot0
-       tab_cntrl(idecal+9) = ptot0
-       tab_cntrl(idecal+10) = ztot0
-       tab_cntrl(idecal+11) = stot0
-       tab_cntrl(idecal+12) = ang0
-       tab_cntrl(idecal+13) = pa
-       tab_cntrl(idecal+14) = preff
-c
-c    .....    parametres  pour le zoom      ......   
-
-       tab_cntrl(idecal+15)  = clon
-       tab_cntrl(idecal+16)  = clat
-       tab_cntrl(idecal+17)  = grossismx
-       tab_cntrl(idecal+18)  = grossismy
-c
-      IF ( fxyhypb )   THEN
-       tab_cntrl(idecal+19) = 1.
-       tab_cntrl(idecal+20) = dzoomx
-       tab_cntrl(idecal+21) = dzoomy
-       tab_cntrl(idecal+22) = 0.
-       tab_cntrl(idecal+23) = taux
-       tab_cntrl(idecal+24) = tauy
-      ELSE
-       tab_cntrl(idecal+19) = 0.
-       tab_cntrl(idecal+20) = dzoomx
-       tab_cntrl(idecal+21) = dzoomy
-       tab_cntrl(idecal+22) = 0.
-       tab_cntrl(idecal+23) = 0.
-       tab_cntrl(idecal+24) = 0.
-       IF( ysinus )  tab_cntrl(idecal+22) = 1.
-      ENDIF
-
-      if (start_file_type.eq."earth") then
-       tab_cntrl(idecal+25) = REAL(iday_end)
-       tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
-c start_time: start_time of simulation (not necessarily 0.)
-       tab_cntrl(idecal+27) = start_time
-      endif
-
-      if (planet_type=="mars") then ! For Mars only
-        tab_cntrl(29)=hour_ini
-      endif
-c
-c    .........................................................
-c
-c Creation du fichier:
-c
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-         write(lunout,*)"dynredem0: Pb d ouverture du fichier "
-     &                  //trim(fichnom)
-         write(lunout,*)' ierr = ', ierr
-         CALL ABORT_GCM("DYNREDEM0", "", 1)
-      ENDIF
-c
-c Preciser quelques attributs globaux:
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
-     .                       "Fichier demmarage dynamique")
-c
-c Definir les dimensions du fichiers:
-c
-      if (start_file_type.eq."earth") then
-        ierr = NF_DEF_DIM (nid, "index", length, idim_index)
-        ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
-        ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
-        ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
-        ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
-        ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
-        ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
-        ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
-      else
-        ierr = NF_DEF_DIM (nid, "index", length, idim_index)
-        ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
-        ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
-        ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
-        ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
-        ierr = NF_DEF_DIM (nid, "altitude", llm, idim_s)
-        ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_sig)
-        ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
-      endif
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-c
-c Definir et enregistrer certains champs invariants:
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points U")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,rlonu)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points U")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR (nid,nvarid,rlatu)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points V")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,rlonv)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points V")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,rlatv)
-c
-      if (start_file_type.eq."earth") then
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
-     .                       "Numero naturel des couches s")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,nivsigs)
-c
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
-     .                       "Numero naturel des couches sigma")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,nivsig)
-      endif ! of if (start_file_type.eq."earth")
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient A pour hybride")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,ap)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient B pour hybride")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,bp)
-c
-      if (start_file_type.ne."earth") then
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
-     .                       "Coef AS: hybrid pressure at midlayers")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,aps)
-c
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34,
-     .                       "Coef BS: hybrid sigma at midlayers")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,bps)
-      endif ! of if (start_file_type.ne."earth")
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,presnivs)
-c
-      if (start_file_type.ne."earth") then
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-        ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-        ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .        "North latitude")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,rlatu*180/pi)
-c
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,idim_rlonv,nvarid)
-#else
-        ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,idim_rlonv,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .        "East longitude")
-        ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,rlonv*180/pi)
-c
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
-     .       idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
-     .       idim_s,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"pseudo-alt")
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,pseudoalt)
-      endif ! of if (start_file_type.ne."earth")
-c
-c Coefficients de passage cov. <-> contra. <--> naturel
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonu
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour U")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,cu)
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatv
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour V")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,cv)
-c
-c Aire de chaque maille:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Aires de chaque maille")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,aire)
-c
-c Geopentiel au sol:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Geopotentiel au sol")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,phis)
-c
-c Definir les variables pour pouvoir les enregistrer plus tard:
-c
-      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
-c
-      if (start_file_type.eq."earth") then
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
-#endif
-cIM 220306 END
-      else ! start_file_type=="planeto"
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
-#endif
-      endif ! of if (start_file_type.eq."earth")
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Temps de simulation")
-      write(unites,200)yyears0,mmois0,jjour0
-200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
-     .                         unites)
-
-c
-      dims4(1) = idim_rlonu
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse U")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatv
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse V")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
-     .                       "Temperature")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-      IF(nqtot.GE.1) THEN
-      DO iq=1,nqtot
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
-      ENDDO
-      ENDIF
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
-     .                       "C est quoi ?")
-c
-      dims3(1) = idim_rlonv
-      dims3(2) = idim_rlatu
-      dims3(3) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
-     .                       "Pression au sol")
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-      ierr = NF_CLOSE(nid) ! fermer le fichier
-
-      write(lunout,*)'dynredem0: iim,jjm,llm,iday_end',
-     &               iim,jjm,llm,iday_end
-      write(lunout,*)'dynredem0: rad,omeg,g,cpp,kappa',
-     &        rad,omeg,g,cpp,kappa
-
-      RETURN
-      END
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      SUBROUTINE dynredem1(fichnom,time,
-     .                     vcov,ucov,teta,q,masse,ps)
-      USE infotrac
-      USE control_mod, only : planet_type
-      use netcdf, only: NF90_get_VAR
-      use netcdf95, only: NF95_PUT_VAR
-      USE temps_mod, ONLY: itaufin,itau_dyn
- 
-      IMPLICIT NONE
-c=================================================================
-c  Ecriture du fichier de redemarrage sous format NetCDF
-c=================================================================
-#include "dimensions.h"
-#include "paramet.h"
-#include "netcdf.inc"
-#include "comgeom.h"
-#include "iniprint.h"
-
-
-      INTEGER l
-      REAL vcov(iip1,jjm,llm),ucov(iip1, jjp1,llm) 
-      REAL teta(iip1, jjp1,llm)                   
-      REAL ps(iip1, jjp1),masse(iip1, jjp1,llm)                   
-      REAL q(iip1, jjp1, llm, nqtot)
-      CHARACTER*(*) fichnom
-     
-      REAL time
-      INTEGER nid, nvarid, nid_trac, nvarid_trac
-      REAL trac_tmp(ip1jmp1,llm)      
-      INTEGER ierr, ierr_file 
-      INTEGER iq
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      character(len=*),parameter :: modname='dynredem1'
-      character*80 abort_message
-c
-      INTEGER nb
-      SAVE nb
-      DATA nb / 0 /
-      character(len=12) :: start_file_type="earth" ! default start file type
-
-      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
-          write(lunout,*) trim(modname),' : Planeto-like start file'
-          start_file_type="planeto"
-      else
-          write(lunout,*) trim(modname),' : Earth-like start file'
-      endif 
-
-      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynredem1: Pb. d ouverture "//trim(fichnom)
-         CALL abort_gcm("dynredem1", "", 1)
-      ENDIF
-
-c  Ecriture/extension de la coordonnee temps
-
-      nb = nb + 1
-      if (start_file_type.eq."earth") then
-        ierr = NF_INQ_VARID(nid, "temps", nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-          write(lunout,*) NF_STRERROR(ierr)
-          abort_message='Variable temps n est pas definie'
-          CALL abort_gcm(modname,abort_message,ierr)
-        ENDIF
-      else
-        ierr = NF_INQ_VARID(nid,"Time", nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-          write(lunout,*) NF_STRERROR(ierr)
-          abort_message='Variable Time not found'
-          CALL abort_gcm(modname,abort_message,ierr)
-        ENDIF
-      endif ! of if (start_file_type.eq."earth") 
-      call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/))
-      write(lunout,*) "dynredem1: Enregistrement pour ", nb, time
-
-c
-c  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
-c  on passe dans dynredem0
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="dynredem1: Le champ <controle> est absent"
-         ierr = 1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-      ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl)
-      if (start_file_type=="earth") then
-        tab_cntrl(31) = REAL(itau_dyn + itaufin)
-      else
-        tab_cntrl(31) = 0
-      endif
-      call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
-
-c  Ecriture des champs
-c
-      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="Variable ucov n est pas definie"
-         ierr=1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,ucov,start=(/1,1,1,nb/))
-
-      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="Variable vcov n est pas definie"
-         ierr=1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,vcov,start=(/1,1,1,nb/))
-
-      ierr = NF_INQ_VARID(nid, "teta", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="Variable teta n est pas definie"
-         ierr=1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,teta,start=(/1,1,1,nb/))
-
-      IF (type_trac == 'inca') THEN
-! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
-         ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
-         IF (ierr_file .NE.NF_NOERR) THEN
-            write(lunout,*)'dynredem1: Pb d''ouverture du fichier',
-     &                     ' start_trac.nc'
-            write(lunout,*)' ierr = ', ierr_file 
-         ENDIF
-      END IF
-
-      IF(nqtot.GE.1) THEN
-      do iq=1,nqtot 
-
-         IF (type_trac /= 'inca') THEN
-            ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-            IF (ierr .NE. NF_NOERR) THEN
-               abort_message="Variable  tname(iq) n est pas definie"
-               ierr=1
-               CALL abort_gcm(modname,abort_message,ierr)
-            ENDIF
-            call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq),start=(/1,1,1,nb/))
-        ELSE ! type_trac = inca
-! lecture de la valeur du traceur dans start_trac.nc
-           IF (ierr_file .ne. 2) THEN
-             ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
-             IF (ierr .NE. NF_NOERR) THEN
-                write(lunout,*) "dynredem1: ",trim(tname(iq)),
-     &                          " est absent de start_trac.nc"
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   abort_message="dynredem1: Variable "//
-     &                     trim(tname(iq))//" n est pas definie"
-                   ierr=1
-                   CALL abort_gcm(modname,abort_message,ierr)
-                ENDIF
-                call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq))
-                
-             ELSE
-                write(lunout,*) "dynredem1: ",trim(tname(iq)),
-     &              " est present dans start_trac.nc"
-               ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp)
-                IF (ierr .NE. NF_NOERR) THEN
-                   abort_message="dynredem1: Lecture echouee pour"//
-     &                    trim(tname(iq))
-                   ierr=1
-                   CALL abort_gcm(modname,abort_message,ierr)
-                ENDIF
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   abort_message="dynredem1: Variable "//
-     &                trim(tname(iq))//" n est pas definie"
-                   ierr=1
-                   CALL abort_gcm(modname,abort_message,ierr)
-                ENDIF
-                call NF95_PUT_VAR(nid, nvarid, trac_tmp)
-               
-             ENDIF ! IF (ierr .NE. NF_NOERR)
-! fin lecture du traceur
-          ELSE                  ! si il n'y a pas de fichier start_trac.nc
-!             print *, 'il n y a pas de fichier start_trac'
-             ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-             IF (ierr .NE. NF_NOERR) THEN
-                abort_message="dynredem1: Variable "//
-     &                trim(tname(iq))//" n est pas definie"
-                   ierr=1
-                   CALL abort_gcm(modname,abort_message,ierr)
-             ENDIF
-             call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq),
-     &                  start=(/1,1,1,nb/))
-          ENDIF ! (ierr_file .ne. 2)
-       END IF   !type_trac
-      
-      ENDDO
-      ENDIF
-c
-      ierr = NF_INQ_VARID(nid, "masse", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="dynredem1: Variable masse n est pas definie"
-         ierr=1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,masse,start=(/1,1,1,nb/))
-c
-      ierr = NF_INQ_VARID(nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="dynredem1: Variable ps n est pas definie"
-         ierr=1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,ps,start=(/1,1,nb/))
-
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
-
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem.F90	(revision 1508)
@@ -0,0 +1,389 @@
+!
+! $Id: dynredem.F 1635 2012-07-12 11:37:16Z lguez $
+!
+!
+SUBROUTINE dynredem0(fichnom,iday_end,phis)
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#endif
+  USE infotrac, ONLY: nqtot, tname, ttext
+  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
+                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
+  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
+  use netcdf95, only: NF95_PUT_VAR
+  use control_mod, only : planet_type
+  USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, &
+      			nivsig,nivsigs
+  USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
+  USE logic_mod, ONLY: fxyhypb,ysinus
+  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
+      			taux,tauy
+  USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin, &
+      			start_time,hour_ini
+  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
+
+  IMPLICIT NONE
+!=======================================================================
+! Writting the NetCDF restart file (initialisation)
+!=======================================================================
+!   Declarations:
+!   -------------
+  include "dimensions.h"
+  include "paramet.h"
+  include "comgeom2.h"
+  include "netcdf.inc"
+  include "iniprint.h"
+
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
+  INTEGER,          INTENT(IN) :: iday_end         !--- 
+  REAL,             INTENT(IN) :: phis(iip1, jjp1) !--- GROUND GEOPOTENTIAL
+!===============================================================================
+! Local variables:
+  INTEGER :: iq,l
+  INTEGER, PARAMETER :: length=100
+  REAL :: tab_cntrl(length) ! run parameters
+  INTEGER :: ierr
+  CHARACTER(LEN=80) :: abort_message
+
+!   For NetCDF:
+  CHARACTER(LEN=30) :: unites
+  INTEGER :: indexID
+  INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
+  INTEGER :: sID, sigID, nID, vID, timID
+  INTEGER :: yyears0, jjour0, mmois0
+  REAL    :: zan0, zjulian, hours
+
+  CHARACTER(len=12) :: start_file_type="earth" ! default start file type
+  INTEGER :: idecal
+
+!===============================================================================
+  ! fill dynredem_mod module variables
+  modname='dynredem0'; fil=fichnom
+
+#ifdef CPP_IOIPSL
+  call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
+  call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
+#else
+! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
+  yyears0=0
+  mmois0=1
+  jjour0=1
+#endif        
+
+  !!! AS: idecal is a hack to be able to read planeto starts...
+  !!!     .... while keeping everything OK for LMDZ EARTH
+  if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
+    write(lunout,*) trim(modname),' : Planeto-like start file'
+    start_file_type="planeto"
+    idecal = 4
+  else
+    write(lunout,*) trim(modname),' : Earth-like start file'
+    idecal = 5
+  endif
+
+  tab_cntrl(:)  = 0.
+  tab_cntrl(1)  = REAL(iim)
+  tab_cntrl(2)  = REAL(jjm)
+  tab_cntrl(3)  = REAL(llm)
+  if (start_file_type.eq."earth") then
+    tab_cntrl(4)=REAL(day_ref)
+  else
+    !tab_cntrl(4)=REAL(day_end)
+    tab_cntrl(4)=REAL(iday_end)
+  endif
+  tab_cntrl(5)  = REAL(annee_ref)
+  tab_cntrl(idecal+1)  = rad
+  tab_cntrl(idecal+2)  = omeg
+  tab_cntrl(idecal+3)  = g
+  tab_cntrl(idecal+4)  = cpp
+  tab_cntrl(idecal+5) = kappa
+  tab_cntrl(idecal+6) = daysec
+  tab_cntrl(idecal+7) = dtvr
+  tab_cntrl(idecal+8) = etot0
+  tab_cntrl(idecal+9) = ptot0
+  tab_cntrl(idecal+10) = ztot0
+  tab_cntrl(idecal+11) = stot0
+  tab_cntrl(idecal+12) = ang0
+  tab_cntrl(idecal+13) = pa
+  tab_cntrl(idecal+14) = preff
+
+!    .....    parameters for the zoom      ......   
+  tab_cntrl(idecal+15)  = clon
+  tab_cntrl(idecal+16)  = clat
+  tab_cntrl(idecal+17)  = grossismx
+  tab_cntrl(idecal+18)  = grossismy
+!
+  IF ( fxyhypb )   THEN
+    tab_cntrl(idecal+19) = 1.
+    tab_cntrl(idecal+20) = dzoomx
+    tab_cntrl(idecal+21) = dzoomy
+    tab_cntrl(idecal+22) = 0.
+    tab_cntrl(idecal+23) = taux
+    tab_cntrl(idecal+24) = tauy
+  ELSE
+    tab_cntrl(idecal+19) = 0.
+    tab_cntrl(idecal+20) = dzoomx
+    tab_cntrl(idecal+21) = dzoomy
+    tab_cntrl(idecal+22) = 0.
+    tab_cntrl(idecal+23) = 0.
+    tab_cntrl(idecal+24) = 0.
+    IF( ysinus )  tab_cntrl(idecal+22) = 1.
+  ENDIF
+
+  if (start_file_type.eq."earth") then
+    tab_cntrl(idecal+25) = REAL(iday_end)
+    tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
+! start_time: start_time of simulation (not necessarily 0.)
+    tab_cntrl(idecal+27) = start_time
+  endif
+
+  if (planet_type=="mars") then ! For Mars only
+    tab_cntrl(29)=hour_ini
+  endif
+
+!--- File creation
+  CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid))
+
+!--- Some global attributes
+  CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))
+
+!--- Dimensions
+  if (start_file_type.eq."earth") then
+    CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
+    CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
+    CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1,   rlatuID))
+    CALL err(NF90_DEF_DIM(nid,"rlonv", iip1,   rlonvID))
+    CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
+    CALL err(NF90_DEF_DIM(nid,"sigs",  llm,        sID))
+    CALL err(NF90_DEF_DIM(nid,"sig",   llmp1,    sigID))
+    CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))
+  else
+    CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
+    CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
+    CALL err(NF90_DEF_DIM(nid,"latitude", jjp1,   rlatuID))
+    CALL err(NF90_DEF_DIM(nid,"longitude", iip1,   rlonvID))
+    CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
+    CALL err(NF90_DEF_DIM(nid,"altitude",  llm,        sID))
+    CALL err(NF90_DEF_DIM(nid,"interlayer",   llmp1,    sigID))
+    CALL err(NF90_DEF_DIM(nid,"Time", NF90_UNLIMITED, timID))
+  endif
+
+!--- Define and save invariant fields
+  CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
+  CALL put_var1(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
+  CALL put_var1(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
+  CALL put_var1(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
+  CALL put_var1(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
+  if (start_file_type.eq."earth") then
+    CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
+    CALL put_var1(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
+  endif ! of if (start_file_type.eq."earth")
+  CALL put_var1(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
+  CALL put_var1(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
+  if (start_file_type.ne."earth") then
+    CALL put_var1(nid,"aps","Coef AS: hybrid pressure at midlayers",[sID],aps)
+    CALL put_var1(nid,"bps","Coef BS: hybrid sigma at midlayers",[sID],bps)
+  endif ! of if (start_file_type.eq."earth")
+  CALL put_var1(nid,"presnivs",""                                ,[sID]  ,presnivs)
+  if (start_file_type.ne."earth") then
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,rlatuID,vID)
+#else
+        ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,rlatuID,vID)
+#endif
+        ierr =NF_PUT_ATT_TEXT(nid,vID,'units',13,"degrees_north")
+        ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
+              "North latitude")
+        ierr = NF_ENDDEF(nid)
+        call NF95_PUT_VAR(nid,vID,rlatu*180/pi)
+!
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,rlonvID,vID)
+#else
+        ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,rlonvID,vID)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
+              "East longitude")
+        ierr = NF_PUT_ATT_TEXT(nid,vID,'units',12,"degrees_east")
+        ierr = NF_ENDDEF(nid)
+        call NF95_PUT_VAR(nid,vID,rlonv*180/pi)
+!
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, &
+             sID,vID)
+#else
+        ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, &
+             sID,vID)
+#endif
+        ierr = NF_PUT_ATT_TEXT(nid,vID,"long_name",10,"pseudo-alt")
+        ierr = NF_PUT_ATT_TEXT (nid,vID,'units',2,"km")
+        ierr = NF_PUT_ATT_TEXT (nid,vID,'positive',2,"up")
+        ierr = NF_ENDDEF(nid)
+        call NF95_PUT_VAR(nid,vID,pseudoalt)
+        CALL err(NF_REDEF(nid))
+  endif ! of if (start_file_type.ne."earth")
+
+! covariant <-> contravariant <-> natural conversion coefficients
+  CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
+  CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
+  CALL put_var2(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
+  CALL put_var2(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
+
+
+! Define variables that will be stored later:
+  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
+               yyears0,mmois0,jjour0
+  IF (planet_type.eq."earth") THEN
+    CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
+  ELSE
+    CALL cre_var(nid,"Time","Temps de simulation",[timID],unites)
+  ENDIF
+
+  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
+  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
+  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
+
+  IF(nqtot.GE.1) THEN
+    DO iq=1,nqtot
+      CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
+    END DO
+  ENDIF
+
+  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
+  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
+
+  CALL err(NF90_CLOSE (nid)) ! close file
+
+  WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
+  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+
+END SUBROUTINE dynredem0
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE dynredem1(fichnom,time,vcov,ucov,teta,q,masse,ps)
+!
+!-------------------------------------------------------------------------------
+! Purpose: Write the NetCDF restart file (append).
+!-------------------------------------------------------------------------------
+  USE infotrac, ONLY: nqtot, tname, type_trac
+  USE control_mod, only : planet_type
+  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
+                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
+  use netcdf95, only: NF95_PUT_VAR
+  USE temps_mod, ONLY: itaufin,itau_dyn
+  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
+                          err, modname, fil, msg
+ 
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "netcdf.inc"
+  include "comgeom.h"
+  include "iniprint.h"
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
+  REAL, INTENT(IN)    ::  time                         !-- TIME
+  REAL, INTENT(IN)    ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
+  REAL, INTENT(IN)    ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
+  REAL, INTENT(IN)    ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
+  REAL, INTENT(INOUT) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
+  REAL, INTENT(IN)    :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
+  REAL, INTENT(IN)    ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
+!===============================================================================
+! Local variables:
+  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
+  INTEGER,SAVE :: nb=0
+  INTEGER, PARAMETER :: length=100
+  REAL               :: tab_cntrl(length) ! tableau des parametres du run
+  CHARACTER(LEN=256) :: var, dum
+  LOGICAL            :: lread_inca
+  CHARACTER(LEN=80) :: abort_message
+  CHARACTER(len=12) :: start_file_type="earth" ! default start file type
+
+  ! fill dynredem_mod module variables
+  modname='dynredem1'; fil=fichnom
+
+  if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
+      write(lunout,*) trim(modname),' : Planeto-like start file'
+      start_file_type="planeto"
+  else
+      write(lunout,*) trim(modname),' : Earth-like start file'
+  endif 
+
+  CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
+
+!--- Write/extend time coordinate
+  nb = nb + 1
+  if (start_file_type.eq."earth") then
+        ierr = NF_INQ_VARID(nid, "temps", vID)
+        IF (ierr .NE. NF_NOERR) THEN
+          write(lunout,*) NF_STRERROR(ierr)
+          abort_message='Variable temps n est pas definie'
+          CALL abort_gcm(modname,abort_message,ierr)
+        ENDIF
+ else
+        ierr = NF_INQ_VARID(nid,"Time", vID)
+        IF (ierr .NE. NF_NOERR) THEN
+          write(lunout,*) NF_STRERROR(ierr)
+          abort_message='Variable Time not found'
+          CALL abort_gcm(modname,abort_message,ierr)
+        ENDIF
+  endif ! of if (start_file_type.eq."earth") 
+  call NF95_PUT_VAR(nid,vID,time,start=(/nb/))
+  WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
+
+!--- Rewrite control table (itaufin undefined in dynredem0)
+  var="controle"
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
+  if (start_file_type=="earth") then
+    tab_cntrl(31) = REAL(itau_dyn + itaufin)
+  else
+    tab_cntrl(31) = 0
+  endif
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
+
+!--- Save fields
+  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm, nb)
+  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm, nb)
+  CALL dynredem_write_u(nid,"teta" ,teta ,llm, nb)
+  CALL dynredem_write_u(nid,"masse",masse,llm, nb)
+  CALL dynredem_write_u(nid,"ps"   ,ps   ,1, nb)
+
+!--- Tracers in file "start_trac.nc" (added by Anne)
+  lread_inca=.FALSE.; fil="start_trac.nc"
+  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
+  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
+
+!--- Save tracers
+  IF(nqtot.GE.1) THEN
+    DO iq=1,nqtot
+      var=tname(iq); ierr=-1
+      IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
+        fil="start_trac.nc"
+        ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
+        dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
+        WRITE(lunout,*)msg(dum,var)
+
+
+        IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
+      END IF ! of IF(lread_inca)
+      fil=fichnom
+      CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm,nb)
+    END DO ! of DO iq=1,nqtot
+  ENDIF ! of IF(nqtot.GE.1)
+
+  CALL err(NF90_CLOSE(nid),"close")
+  fil="start_trac.nc"
+  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
+
+END SUBROUTINE dynredem1
+
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem_mod.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem_mod.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem_mod.F90	(revision 1508)
@@ -0,0 +1,222 @@
+MODULE dynredem_mod
+
+  USE netcdf, ONLY: NF90_NOERR, NF90_DOUBLE, NF90_STRERROR, &
+                    NF90_REDEF, NF90_ENDDEF, NF90_PUT_VAR, &
+                    NF90_PUT_ATT, NF90_GET_VAR, NF90_INQ_VARID, &
+                    NF90_DEF_VAR
+  PRIVATE
+  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
+  PUBLIC :: cre_var, get_var1, put_var1, put_var2, fil, modname, msg
+  include "dimensions.h"
+  include "paramet.h"
+  CHARACTER(LEN=256), SAVE :: fil, modname
+  INTEGER,            SAVE :: nvarid
+
+
+CONTAINS
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_write_u(ncid,id,var,ll,nb)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncid
+  CHARACTER(LEN=*), INTENT(IN) :: id
+  REAL,             INTENT(IN) :: var(iip1,jjp1,ll)
+  INTEGER,          INTENT(IN) :: ll
+  INTEGER,          INTENT(IN) :: nb
+!===============================================================================
+! Local variables:
+  INTEGER :: start(4), count(4)
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,nb]
+  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
+  
+END SUBROUTINE dynredem_write_u
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_write_v(ncid,id,var,ll,nb)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncid
+  CHARACTER(LEN=*), INTENT(IN) :: id
+  REAL,             INTENT(IN) :: var(iip1,jjm,ll)
+  INTEGER,          INTENT(IN) :: ll
+  INTEGER,          INTENT(IN) :: nb
+!===============================================================================
+! Local variables:
+  INTEGER :: start(4), count(4)
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,nb]
+  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
+  
+END SUBROUTINE dynredem_write_v
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE dynredem_read_u(ncid,id,var,ll)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,          INTENT(IN)  :: ncid
+  CHARACTER(LEN=*), INTENT(IN)  :: id
+  REAL,             INTENT(OUT) :: var(iip1,jjp1,ll)
+  INTEGER,          INTENT(IN)  :: ll
+!===============================================================================
+! Local variables:
+  INTEGER :: start(4), count(4)
+!===============================================================================
+  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
+  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
+  CALL err(NF90_GET_VAR(ncid,nvarid,var,start,count),"get",id)
+  
+END SUBROUTINE dynredem_read_u    
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE cre_var(ncid,var,title,did,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
+#ifdef NC_DOUBLE
+  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
+#else
+  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
+#endif
+  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
+  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
+
+END SUBROUTINE cre_var
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE put_var1(ncid,var,title,did,v,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(1)
+  REAL,                       INTENT(IN) :: v(:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
+  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
+  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
+  CALL err(NF90_ENDDEF(ncid))
+  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
+  CALL err(NF90_REDEF(ncid))
+
+END SUBROUTINE put_var1
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE put_var2(ncid,var,title,did,v,units)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ncid
+  CHARACTER(LEN=*),           INTENT(IN) :: var, title
+  INTEGER,                    INTENT(IN) :: did(2)
+  REAL,                       INTENT(IN) :: v(:,:)
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
+!===============================================================================
+  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
+  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
+  CALL err(NF90_ENDDEF(ncid))
+  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
+  CALL err(NF90_REDEF(ncid))
+
+END SUBROUTINE put_var2
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+FUNCTION msg(typ,nam)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
+  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
+!===============================================================================
+  SELECT CASE(typ)
+    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
+    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
+    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
+    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
+    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
+    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
+  END SELECT
+  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
+
+END FUNCTION msg
+!
+!===============================================================================
+
+
+!===============================================================================
+!
+SUBROUTINE err(ierr,typ,nam)
+!
+!===============================================================================
+  IMPLICIT NONE
+!===============================================================================
+! Arguments:
+  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
+!===============================================================================
+  IF(ierr==NF90_NoERR) RETURN
+  IF(.NOT.PRESENT(typ)) THEN
+    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
+  ELSE
+    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
+  END IF
+
+END SUBROUTINE err
+!
+!===============================================================================
+
+END MODULE dynredem_mod   
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/grid_atob.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/grid_atob.F	(revision 1507)
+++ 	(revision )
@@ -1,982 +1,0 @@
-!
-! $Id: grid_atob.F 2197 2015-02-09 07:13:05Z emillour $
-!
-      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Aucune ponderation est consideree (voir grille_p)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-      REAL distans(2200*1100)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-      include "iniprint.h"
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c Calculer les limites des zones des nouveaux points
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c Determiner la zone sur laquelle chaque ancien point se trouve
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               number(ii,jj) = number(ii,jj) + 1.0
-               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c Si aucun ancien point tombe sur une zone, c'est un probleme
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
-     $        j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Consideration de la distance des points (voir grille_m)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(200),d(200)
-      REAL number(400,200)
-      INTEGER indx(400,200), indy(400,200)
-      REAL dist(400,200), distsom(400,200)
-c
-      IF (imar.GT.400 .OR. jmar.GT.200) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
-         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c calculer les bords a et b de la nouvelle grille
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-c
-c calculer les bords c et d de la nouvelle grille
-c
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-c
-c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
-c un point de l'ancienne grille est tombe.
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               indx(i,j) = ii
-               indy(i,j) = jj
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c faire une verification
-c
-
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
-            PRINT*, 'Probleme grave,i,j,indx,indy=',
-     .              i,j,indx(i,j),indy(i,j)
-            call abort_gcm("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-c
-c calculer la distance des anciens points avec le nouveau point,
-c on prend ensuite une sorte d'inverse pour ponderation.
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         distsom(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
-     .                     +(ydata(j)-y(indy(i,j)))**2 )
-         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
-     .                                  + dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
-      ENDDO
-      ENDDO
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
-     .                                 + entree(i,j) * dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
-     .                                 + dist(i,j)
-      ENDDO
-      ENDDO
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
-     .                    imar, jmar, x, y, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
-c                           un champ indicateur (masque) terre/ocean
-c                           terre:1; ocean:0
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL relief(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL num_tot(2200,1100), num_oce(2200,1100)
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_oce(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
-     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-c
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
-              mask(i,j) = 0.
-           ELSE
-              mask(i,j) = 1.
-           ENDIF
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-c
-c
-
-
-      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
-c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
-c fixe (0.001m).
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar), mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-      include "iniprint.h"
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_tot(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
-              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-       IF (NINT(mask(i,j)).EQ.1) THEN
-         IF (num_tot(i,j) .GT. 0.0) THEN
-            sortie(i,j) = sortie(i,j) / num_tot(i,j)
-            sortie(i,j) = EXP(sortie(i,j))
-         ELSE
-            if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
-ccc            CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
-     $        j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-       ELSE
-         sortie(i,j) = 0.001
-       ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-
-      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
-     .                    imar, jmar, x, y, frac_ice)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
-c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
-c (entre 0 et 1) dans une grille plus grossiere.
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL glace01(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL frac_ice(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400), num_ice(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-      include "iniprint.h"
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_ice(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-              IF (NINT(glace01(i,j)).EQ.1 ) 
-     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF (num_ice(i,j).GT.0.001) THEN
-            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
-           ELSE
-              frac_ice(i,j) = 0.0
-           ENDIF
-         ELSE
-           if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
-ccc           CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
-     $        j_proche
-         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
-            frac_ice(i,j) = 1.0
-         ELSE
-            frac_ice(i,j) = 0.0
-         ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
-     .                    immod, jmmod, xmod, ymod, rugs)
-c=======================================================================
-c Calculer la longueur de rugosite liee au relief en utilisant
-c l'ecart-type dans une maille de 1x1
-C=======================================================================
-      IMPLICIT none
-c
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      REAL amin, AMAX
-c
-      INTEGER imrel, jmrel
-      REAL xrel(imrel),yrel(jmrel)
-      REAL relief(imrel,jmrel)
-c
-      INTEGER immod, jmmod
-      REAL xmod(immod),ymod(jmmod)
-      REAL rugs(immod,jmmod)
-c
-      INTEGER imtmp, jmtmp
-      PARAMETER (imtmp=360,jmtmp=180)
-      REAL xtmp(imtmp), ytmp(jmtmp)
-      REAL(KIND=8) cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
-      REAL zzzz
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-c
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-c
-      include "iniprint.h"
-
-      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
-         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
-         CALL ABORT_GCM("", "", 1)
-      ENDIF
-c
-c Calculs intermediares:
-c
-      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
-      DO i = 2, imtmp
-         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
-      ENDDO
-      DO i = 1, imtmp
-         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
-      DO j = 2, jmtmp
-         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
-      ENDDO
-      DO j = 1, jmtmp
-         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-c
-      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
-      b(1) = (xtmp(1)+xtmp(2))/2.0
-      DO i = 2, imtmp-1
-         a(i) = b(i-1)
-         b(i) = (xtmp(i)+xtmp(i+1))/2.0
-      ENDDO
-      a(imtmp) = b(imtmp-1)
-      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
-
-      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
-      d(1) = (ytmp(1)+ytmp(2))/2.0
-      DO j = 2, jmtmp-1
-         c(j) = d(j-1)
-         d(j) = (ytmp(j)+ytmp(j+1))/2.0
-      ENDDO
-      c(jmtmp) = d(jmtmp-1)
-      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
-
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         number(i,j) = 0.0
-         cham1tmp(i,j) = 0.0
-         cham2tmp(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imtmp
-      DO jj = 1, jmtmp
-        DO i = 1, imrel
-         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmrel
-          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
-              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
-     .                              + relief(i,j)*relief(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         IF (number(i,j) .GT. 0.001) THEN
-         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
-         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
-         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
-         if (zzzz .lt. 0.0) then
-           if (zzzz .gt. -7.5) then
-             zzzz = 0.0
-             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
-           else
-              stop 'Pb rugsoro, zzzz <-7.5'
-           endif
-         endif
-         cham2tmp(i,j) = SQRT(zzzz)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT_GCM("", "", 1)
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = cham2tmp(1,1)
-      AMAX = cham2tmp(1,1)
-      DO j = 1, jmtmp
-      DO i = 1, imtmp
-         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
-         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type 1x1:', amin, AMAX
-c
-c
-c
-      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
-      b(1) = (xmod(1)+xmod(2))/2.0
-      DO i = 2, immod-1
-         a(i) = b(i-1)
-         b(i) = (xmod(i)+xmod(i+1))/2.0
-      ENDDO
-      a(immod) = b(immod-1)
-      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
-
-      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
-      d(1) = (ymod(1)+ymod(2))/2.0
-      DO j = 2, jmmod-1
-         c(j) = d(j-1)
-         d(j) = (ymod(j)+ymod(j+1))/2.0
-      ENDDO
-      c(jmmod) = d(jmmod-1)
-      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         number(i,j) = 0.0
-         rugs(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, immod
-      DO jj = 1, jmmod
-        DO i = 1, imtmp
-         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmtmp
-          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              rugs(ii,jj) = rugs(ii,jj)
-     .                       + LOG(MAX(0.001_8,cham2tmp(i,j)))
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         IF (number(i,j) .GT. 0.001) THEN
-         rugs(i,j) = rugs(i,j) / number(i,j)
-         rugs(i,j) = EXP(rugs(i,j))
-         ELSE
-         if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT_GCM("", "", 1)
-         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imtmp*jmtmp
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imtmp + 1
-         i_proche = ij_proche - (j_proche-1)*imtmp
-         if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche,
-     $        j_proche
-         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type du modele:', amin, AMAX
-c
-      DO j = 1, jmmod
-      DO i = 1, immod
-         rugs(i,j) = rugs(i,j) / AMAX * 20.0
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
-c
-      RETURN
-      END
-c
-      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
-      IMPLICIT NONE
-c
-c Auteur: Laurent Li (le 30 decembre 1996)
-c
-c Ce programme calcule la distance minimale (selon le grand cercle)
-c entre deux points sur la terre
-c
-c Input:
-      INTEGER im, jm ! dimensions
-      REAL rf_lon ! longitude du point de reference (degres)
-      REAL rf_lat ! latitude du point de reference (degres)
-      REAL rlon(im), rlat(jm) ! longitude et latitude des points
-c
-c Output:
-      REAL distance(im,jm) ! distances en metre
-c
-      REAL rlon1, rlat1
-      REAL rlon2, rlat2
-      REAL dist
-      REAL pa, pb, p, pi
-c
-      REAL radius
-      PARAMETER (radius=6371229.)
-      INTEGER i,j
-c
-      pi = 4.0 * ATAN(1.0)
-c
-      DO 9999 j = 1, jm
-      DO 9999 i = 1, im
-c
-      rlon1=rf_lon
-      rlat1=rf_lat
-      rlon2=rlon(i)
-      rlat2=rlat(j)
-      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
-      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
-      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
-c
-      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
-      dist = radius * dist
-      distance(i,j) = dist
-c
- 9999 CONTINUE
-c
-      END
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90	(revision 1508)
@@ -12,4 +12,7 @@
   INTEGER, SAVE :: nbtr
 
+! CRisi: nb of father tracers (i.e. directly advected by air)
+  INTEGER, SAVE :: nqperes
+
 ! Name variables
   CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
@@ -22,4 +25,11 @@
 !         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 
   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
+
+! CRisi: arrays for sons
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! number of sons + all gran-sons over all generations
+  INTEGER, SAVE :: nqdesc_tot
+  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iqpere
 
 ! conv_flg(it)=0 : convection desactivated for tracer number it 
@@ -30,9 +40,24 @@
   CHARACTER(len=4),SAVE :: type_trac
   CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
- 
+
+    ! CRisi: specific stuff for isotopes
+    LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso
+    INTEGER :: niso_possibles   
+    PARAMETER ( niso_possibles=5) ! 5 possible water isotopes
+    real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal
+    LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
+    INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase) 
+    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
+    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
+    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
+    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
+    INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
+    INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
+    INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
+
 CONTAINS
 
   SUBROUTINE infotrac_init
-    USE control_mod
+    USE control_mod, ONLY: planet_type, config_inca
 #ifdef REPROBUS
     USE CHEM_REP, ONLY : Init_chem_rep_trac
@@ -63,4 +88,5 @@
 
     CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
+    CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
     CHARACTER(len=3), DIMENSION(30) :: descrq
     CHARACTER(len=1), DIMENSION(3)  :: txts
@@ -70,4 +96,8 @@
     INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
     INTEGER :: iq, new_iq, iiq, jq, ierr, ierr2, ierr3
+    INTEGER :: ifils,ipere,generation ! CRisi
+    LOGICAL :: continu,nouveau_traceurdef
+    INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
+    CHARACTER(len=15) :: tchaine    
     
     character(len=80) :: line ! to store a line of text
@@ -138,4 +168,5 @@
           WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
           READ(90,*) nqtrue
+          WRITE(lunout,*) trim(modname),' nqtrue=',nqtrue
        ELSE 
           WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
@@ -146,7 +177,24 @@
        nbtr=nqtrue-2
      ELSE ! type_trac=inca
-       ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F 
-       nqtrue=nbtr+2
-     END IF
+       ! The traceur.def file is used to define the number "nqo" of water phases 
+       ! present in the simulation. Default : nqo = 2.
+       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
+       IF(ierr.EQ.0) THEN
+          WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
+          READ(90,*) nqo
+       ELSE 
+          WRITE(lunout,*) trim(modname),': Using default value for nqo'
+          nqo=2
+       ENDIF
+       IF (nqo /= 2 .AND. nqo /= 3 ) THEN
+          WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowded. Only 2 or 3 water phases allowed'
+          CALL abort_gcm('infotrac_init','Bad number of water phases',1)
+       END IF
+       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F 
+#ifdef INCA
+       CALL Init_chem_inca_trac(nbtr)
+#endif
+       nqtrue=nbtr+nqo
+     END IF   ! type_trac
 
      IF (nqtrue < 2) THEN
@@ -155,10 +203,12 @@
      END IF
 
+!jyg<
 ! Transfert number of tracers to Reprobus
-     IF (type_trac == 'repr') THEN
-#ifdef REPROBUS
-       CALL Init_chem_rep_trac(nbtr)
-#endif
-     END IF
+!!    IF (type_trac == 'repr') THEN
+!!#ifdef REPROBUS
+!!       CALL Init_chem_rep_trac(nbtr)
+!!#endif
+!!    END IF
+!>jyg
 
     ELSE  ! not Earth
@@ -175,4 +225,5 @@
        ! in the dynamics than in the physics
        nbtr=nqtrue
+       nqo=0
      
     ENDIF  ! planet_type
@@ -180,8 +231,11 @@
 ! Allocate variables depending on nqtrue and nbtr
 !
-    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
-    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
-    conv_flg(:) = 1 ! convection activated for all tracers
-    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
+    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue),tnom_transp(nqtrue))
+!
+!jyg<
+!!    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
+!!    conv_flg(:) = 1 ! convection activated for all tracers
+!!    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
+!>jyg
 
 !-----------------------------------------------------------------------
@@ -216,7 +270,47 @@
           ! Continue to read tracer.def
           DO iq=1,nqtrue
-             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
-          END DO
+
+             write(*,*) 'infotrac 237: iq=',iq
+             ! CRisi: ajout du nom du fluide transporteur
+             ! mais rester retro compatible
+             READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine
+             write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq)
+             write(lunout,*) 'tchaine=',trim(tchaine)
+!             write(*,*) 'infotrac 238: IOstatus=',IOstatus
+             if (IOstatus.ne.0) then
+                CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1)
+             endif
+             ! Y-a-t-il 1 ou 2 noms de traceurs? -> On regarde s'il y a un
+             ! espace ou pas au milieu de la chaine.
+             continu=.true.
+             nouveau_traceurdef=.false.
+             iiq=1
+             do while (continu)
+                if (tchaine(iiq:iiq).eq.' ') then
+                  nouveau_traceurdef=.true.
+                  continu=.false.
+                else if (iiq.lt.LEN_TRIM(tchaine)) then
+                  iiq=iiq+1
+                else
+                  continu=.false.     
+                endif
+             enddo
+             write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef
+             if (nouveau_traceurdef) then
+                write(lunout,*) 'C''est la nouvelle version de traceur.def'
+                tnom_0(iq)=tchaine(1:iiq-1)
+                tnom_transp(iq)=tchaine(iiq+1:15)
+             else
+                write(lunout,*) 'C''est l''ancienne version de traceur.def'
+                write(lunout,*) 'On suppose que les traceurs sont tous d''air'
+                tnom_0(iq)=tchaine
+                tnom_transp(iq) = 'air'
+             endif
+             write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>'
+             write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
+
+          END DO ! DO iq=1,nqtrue
           CLOSE(90)  
+
        ELSE ! Without tracer.def, set default values (for Earth!)
          if ((nqtrue==4).and.(planet_type=="earth")) then
@@ -224,13 +318,17 @@
           vadv(1) = 14
           tnom_0(1) = 'H2Ov'
+          tnom_transp(1) = 'air'
           hadv(2) = 10
           vadv(2) = 10
           tnom_0(2) = 'H2Ol'
+          tnom_transp(2) = 'air'
           hadv(3) = 10
           vadv(3) = 10
           tnom_0(3) = 'RN'
+          tnom_transp(3) = 'air'
           hadv(4) = 10
           vadv(4) = 10
           tnom_0(4) = 'PB'
+          tnom_transp(4) = 'air'
          else
            ! Error message, we need a traceur.def file
@@ -240,20 +338,40 @@
            CALL abort_gcm('infotrac_init','Need a traceur.def file!',1)
          endif ! of if (nqtrue==4)
-       END IF
+       END IF ! of IF(ierr.EQ.0) 
        
-!CR: nombre de traceurs de l eau
-       if (tnom_0(3) == 'H2Oi') then
-          nqo=3
-       else
-          nqo=2
-       endif
-
        WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
        WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
        DO iq=1,nqtrue
-          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
+          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq),tnom_transp(iq)
        END DO
 
-     ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
+         !CR: nombre de traceurs de l eau
+         if (tnom_0(3) == 'H2Oi') then
+            nqo=3
+         else
+            nqo=2
+         endif
+         ! For Earth, water vapour & liquid tracers are not in the physics
+         nbtr=nqtrue-nqo
+     ENDIF  ! (type_trac == 'lmdz' .OR. type_trac == 'repr')
+!jyg<
+!
+! Transfert number of tracers to Reprobus
+    IF (type_trac == 'repr') THEN
+#ifdef REPROBUS
+       CALL Init_chem_rep_trac(nbtr)
+#endif
+    END IF
+!
+! Allocate variables depending on nbtr
+!
+    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
+    conv_flg(:) = 1 ! convection activated for all tracers
+    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
+!
+!!    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
+!
+    IF (type_trac == 'inca') THEN   ! config_inca='aero' ou 'chem'
+!>jyg
 ! le module de chimie fournit les noms des traceurs
 ! et les schemas d'advection associes.
@@ -268,14 +386,30 @@
 #endif
        tnom_0(1)='H2Ov'
+       tnom_transp(1) = 'air'
        tnom_0(2)='H2Ol'
-
-       DO iq =3,nqtrue
-          tnom_0(iq)=solsym(iq-2)
+       tnom_transp(2) = 'air'
+       IF (nqo == 3) then
+         tnom_0(3)='H2Oi'     !! jyg
+         tnom_transp(3) = 'air'
+       endif
+
+!jyg<
+       DO iq = nqo+1, nqtrue
+          tnom_0(iq)=solsym(iq-nqo)
+          tnom_transp(iq) = 'air'
        END DO
-       nqo = 2
-
-     END IF ! type_trac
+!!       DO iq =3,nqtrue
+!!          tnom_0(iq)=solsym(iq-2)
+!!       END DO
+!!       nqo = 2
+!>jyg
+
+     END IF ! (type_trac == 'inca')
 
     ELSE  ! not Earth
+       ! Other planets (for now); we have the same number of tracers
+       ! in the dynamics than in the physics
+       nbtr=nqtrue
+       ! NB: Reading a traceur.def with isotopes remains to be done...
        IF(ierr.EQ.0) THEN
           ! Continue to read tracer.def
@@ -296,4 +430,5 @@
               endif
             endif ! of if(ierr2.ne.0)
+            tnom_transp(iq)='air' ! no isotopes... for now...
           END DO ! of DO iq=1,nqtrue
           CLOSE(90)  
@@ -302,4 +437,5 @@
           vadv(1) = 10
           tnom_0(1) = 'dummy'
+          tnom_transp(1)='air'
        END IF
        
@@ -307,5 +443,5 @@
        WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
        DO iq=1,nqtrue
-          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
+          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq),tnom_transp(iq)
        END DO
 
@@ -437,10 +573,314 @@
 
 !-----------------------------------------------------------------------
+!
+! 5) Determine father/son relations for isotopes and carrying fluid
+!
+!-----------------------------------------------------------------------
+
+! CRisi: quels sont les traceurs fils et les traceurs pères.
+! initialiser tous les tableaux d'indices liés aux traceurs familiaux
+! + vérifier que tous les pères sont écrits en premières positions
+    ALLOCATE(nqfils(nqtot),nqdesc(nqtot))    
+    ALLOCATE(iqfils(nqtot,nqtot))   
+    ALLOCATE(iqpere(nqtot))
+    nqperes=0
+    nqfils(:)=0
+    nqdesc(:)=0
+    iqfils(:,:)=0
+    iqpere(:)=0
+    nqdesc_tot=0    
+    DO iq=1,nqtot
+      if (tnom_transp(iq) == 'air') then
+        ! ceci est un traceur père
+        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
+        nqperes=nqperes+1
+        iqpere(iq)=0
+      else !if (tnom_transp(iq) == 'air') then
+        ! ceci est un fils. Qui est son père?
+        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils'
+        continu=.true.
+        ipere=1
+        do while (continu)           
+          if (tnom_transp(iq) == tnom_0(ipere)) then
+            ! Son père est ipere
+            WRITE(lunout,*) 'Le traceur',iq,'appele ', &
+      &          trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere))
+            nqfils(ipere)=nqfils(ipere)+1  
+            iqfils(nqfils(ipere),ipere)=iq
+            iqpere(iq)=ipere         
+            continu=.false.
+          else !if (tnom_transp(iq) == tnom_0(ipere)) then
+            ipere=ipere+1 
+            if (ipere.gt.nqtot) then
+                WRITE(lunout,*) 'Le traceur',iq,'appele ', &
+      &          trim(tnom_0(iq)),', est orpelin.'
+                CALL abort_gcm('infotrac_init','Un traceur est orphelin',1)
+            endif !if (ipere.gt.nqtot) then
+          endif !if (tnom_transp(iq) == tnom_0(ipere)) then
+        enddo !do while (continu)
+      endif !if (tnom_transp(iq) == 'air') then
+    enddo !DO iq=1,nqtot
+    WRITE(lunout,*) 'infotrac: nqperes=',nqperes    
+    WRITE(lunout,*) 'nqfils=',nqfils
+    WRITE(lunout,*) 'iqpere=',iqpere
+    WRITE(lunout,*) 'iqfils=',iqfils
+
+! Calculer le nombre de descendants à partir de iqfils et de nbfils
+    DO iq=1,nqtot    
+      generation=0
+      continu=.true.
+      ifils=iq
+      do while (continu)
+        ipere=iqpere(ifils)
+        if (ipere.gt.0) then
+         nqdesc(ipere)=nqdesc(ipere)+1   
+         nqdesc_tot=nqdesc_tot+1      
+         iqfils(nqdesc(ipere),ipere)=iq
+         ifils=ipere
+         generation=generation+1
+        else !if (ipere.gt.0) then
+         continu=.false.
+        endif !if (ipere.gt.0) then
+      enddo !do while (continu)    
+      WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation
+    enddo !DO iq=1,nqtot
+    WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc
+    WRITE(lunout,*) 'iqfils=',iqfils
+    WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
+
+! Interdire autres schémas que 10 pour les traceurs fils, et autres schémas
+! que 10 et 14 si des pères ont des fils
+    do iq=1,nqtot
+      if (iqpere(iq).gt.0) then
+        ! ce traceur a un père qui n'est pas l'air
+        ! Seul le schéma 10 est autorisé
+        if (iadv(iq)/=10) then
+           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
+          CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
+        endif
+        ! Le traceur père ne peut être advecté que par schéma 10 ou 14:
+        IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
+          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
+          CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1)
+        endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
+     endif !if (iqpere(iq).gt.0) the
+    enddo !do iq=1,nqtot
+
+
+! detecter quels sont les traceurs isotopiques parmi des traceurs
+    call infotrac_isoinit(tnom_0,nqtrue)
+        
+!-----------------------------------------------------------------------
 ! Finalize :
 !
-    DEALLOCATE(tnom_0, hadv, vadv)
+    DEALLOCATE(tnom_0, hadv, vadv,tnom_transp)
 
 
   END SUBROUTINE infotrac_init
+
+!-----------------------------------------------------------------------
+
+  SUBROUTINE infotrac_isoinit(tnom_0,nqtrue)
+
+#ifdef CPP_IOIPSL
+  use IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  use ioipsl_getincom
+#endif
+  implicit none
+ 
+    ! inputs
+    INTEGER nqtrue
+    CHARACTER(len=15) tnom_0(nqtrue)
+    
+    ! locals    
+    CHARACTER(len=3), DIMENSION(niso_possibles) :: tnom_iso
+    INTEGER, ALLOCATABLE,DIMENSION(:,:) :: nb_iso,nb_traciso
+    INTEGER, ALLOCATABLE,DIMENSION(:) :: nb_isoind
+    INTEGER :: ntraceurs_zone_prec,iq,phase,ixt,iiso,izone
+    CHARACTER(len=19) :: tnom_trac
+    INCLUDE "iniprint.h"
+
+    tnom_iso=(/'eau','HDO','O18','O17','HTO'/)
+
+    ALLOCATE(nb_iso(niso_possibles,nqo))
+    ALLOCATE(nb_isoind(nqo))
+    ALLOCATE(nb_traciso(niso_possibles,nqo))
+    ALLOCATE(iso_num(nqtot))
+    ALLOCATE(iso_indnum(nqtot))
+    ALLOCATE(zone_num(nqtot))
+    ALLOCATE(phase_num(nqtot))
+     
+    iso_num(:)=0
+    iso_indnum(:)=0
+    zone_num(:)=0
+    phase_num(:)=0
+    indnum_fn_num(:)=0
+    use_iso(:)=.false.  
+    nb_iso(:,:)=0  
+    nb_isoind(:)=0     
+    nb_traciso(:,:)=0
+    niso=0
+    ntraceurs_zone=0  
+    ntraceurs_zone_prec=0
+    ntraciso=0
+
+    do iq=nqo+1,nqtot
+       write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq)
+       do phase=1,nqo    
+        do ixt= 1,niso_possibles   
+         tnom_trac=trim(tnom_0(phase))//'_'
+         tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt))
+         write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac      
+         IF (tnom_0(iq) == tnom_trac) then
+          write(lunout,*) 'Ce traceur est un isotope'
+          nb_iso(ixt,phase)=nb_iso(ixt,phase)+1   
+          nb_isoind(phase)=nb_isoind(phase)+1   
+          iso_num(iq)=ixt
+          iso_indnum(iq)=nb_isoind(phase)
+          indnum_fn_num(ixt)=iso_indnum(iq)
+          phase_num(iq)=phase
+          write(lunout,*) 'iso_num(iq)=',iso_num(iq)
+          write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
+          write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
+          write(lunout,*) 'phase_num(iq)=',phase_num(iq)
+          goto 20
+         else if (iqpere(iq).gt.0) then          
+          if (tnom_0(iqpere(iq)) == tnom_trac) then
+           write(lunout,*) 'Ce traceur est le fils d''un isotope'
+           ! c'est un traceur d'isotope
+           nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1
+           iso_num(iq)=ixt
+           iso_indnum(iq)=indnum_fn_num(ixt)
+           zone_num(iq)=nb_traciso(ixt,phase)
+           phase_num(iq)=phase
+           write(lunout,*) 'iso_num(iq)=',iso_num(iq)
+           write(lunout,*) 'phase_num(iq)=',phase_num(iq)
+           write(lunout,*) 'zone_num(iq)=',zone_num(iq)
+           goto 20
+          endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
+         endif !IF (tnom_0(iq) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
+        enddo !do ixt= niso_possibles
+       enddo !do phase=1,nqo
+  20   continue
+      enddo !do iq=1,nqtot
+
+      write(lunout,*) 'iso_num=',iso_num
+      write(lunout,*) 'iso_indnum=',iso_indnum
+      write(lunout,*) 'zone_num=',zone_num  
+      write(lunout,*) 'phase_num=',phase_num
+      write(lunout,*) 'indnum_fn_num=',indnum_fn_num
+
+      do ixt= 1,niso_possibles  
+       
+       if (nqo.gt.0) then ! Ehouarn: because tests below only valid if nqo>=1,
+
+        if (nb_iso(ixt,1).eq.1) then
+          ! on vérifie que toutes les phases ont le même nombre de
+          ! traceurs
+          do phase=2,nqo
+            if (nb_iso(ixt,phase).ne.nb_iso(ixt,1)) then
+!              write(lunout,*) 'ixt,phase,nb_iso=',ixt,phase,nb_iso(ixt,phase)
+              CALL abort_gcm('infotrac_init','Phases must have same number of isotopes',1)
+            endif
+          enddo !do phase=2,nqo
+
+          niso=niso+1
+          use_iso(ixt)=.true.
+          ntraceurs_zone=nb_traciso(ixt,1)
+
+          ! on vérifie que toutes les phases ont le même nombre de
+          ! traceurs
+          do phase=2,nqo
+            if (nb_traciso(ixt,phase).ne.ntraceurs_zone) then
+              write(lunout,*) 'ixt,phase,nb_traciso=',ixt,phase,nb_traciso(ixt,phase)
+              write(lunout,*) 'ntraceurs_zone=',ntraceurs_zone
+              CALL abort_gcm('infotrac_init','Phases must have same number of tracers',1)
+            endif  
+          enddo  !do phase=2,nqo
+          ! on vérifie que tous les isotopes ont le même nombre de
+          ! traceurs
+          if (ntraceurs_zone_prec.gt.0) then               
+            if (ntraceurs_zone.eq.ntraceurs_zone_prec) then
+              ntraceurs_zone_prec=ntraceurs_zone
+            else !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then
+              write(*,*) 'ntraceurs_zone_prec,ntraceurs_zone=',ntraceurs_zone_prec,ntraceurs_zone   
+              CALL abort_gcm('infotrac_init', &
+               &'Isotope tracers are not well defined in traceur.def',1)           
+            endif !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then
+           endif !if (ntraceurs_zone_prec.gt.0) then
+
+        else if (nb_iso(ixt,1).ne.0) then
+           WRITE(lunout,*) 'nqo,ixt=',nqo,ixt
+           WRITE(lunout,*) 'nb_iso(ixt,1)=',nb_iso(ixt,1)    
+           CALL abort_gcm('infotrac_init','Isotopes are not well defined in traceur.def',1)     
+        endif   !if (nb_iso(ixt,1).eq.1) then       
+
+     endif ! of if (nqo.gt.0)
+
+    enddo ! do ixt= niso_possibles
+
+    ! dimensions isotopique:
+    ntraciso=niso*(ntraceurs_zone+1)
+    WRITE(lunout,*) 'niso=',niso
+    WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso    
+ 
+    ! flags isotopiques:
+    if (niso.gt.0) then
+        ok_isotopes=.true.
+    else
+        ok_isotopes=.false.
+    endif 
+    WRITE(lunout,*) 'ok_isotopes=',ok_isotopes
+ 
+    if (ok_isotopes) then
+        ok_iso_verif=.false.
+        call getin('ok_iso_verif',ok_iso_verif)
+        ok_init_iso=.false.
+        call getin('ok_init_iso',ok_init_iso)
+        tnat=(/1.0,155.76e-6,2005.2e-6,0.004/100.,0.0/)
+        alpha_ideal=(/1.0,1.01,1.006,1.003,1.0/)
+    endif !if (ok_isotopes) then  
+    WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif
+    WRITE(lunout,*) 'ok_init_iso=',ok_init_iso
+
+    if (ntraceurs_zone.gt.0) then
+        ok_isotrac=.true.
+    else
+        ok_isotrac=.false.
+    endif   
+    WRITE(lunout,*) 'ok_isotrac=',ok_isotrac
+
+    ! remplissage du tableau iqiso(ntraciso,phase)
+    ALLOCATE(iqiso(ntraciso,nqo))   
+    iqiso(:,:)=0     
+    do iq=1,nqtot
+        if (iso_num(iq).gt.0) then
+          ixt=iso_indnum(iq)+zone_num(iq)*niso
+          iqiso(ixt,phase_num(iq))=iq
+        endif
+    enddo
+!    WRITE(lunout,*) 'iqiso=',iqiso
+
+    ! replissage du tableau index_trac(ntraceurs_zone,niso)
+    ALLOCATE(index_trac(ntraceurs_zone,niso))  
+    if (ok_isotrac) then
+        do iiso=1,niso
+          do izone=1,ntraceurs_zone 
+             index_trac(izone,iiso)=iiso+izone*niso
+          enddo
+        enddo
+    else !if (ok_isotrac) then      
+        index_trac(:,:)=0.0
+    endif !if (ok_isotrac) then
+    write(lunout,*) 'index_trac=',index_trac    
+
+! Finalize :
+    DEALLOCATE(nb_iso)
+
+  END SUBROUTINE infotrac_isoinit
+
+!-----------------------------------------------------------------------
 
 ! Ehouarn: routine iniadvtrac => from Mars/generic; does essentially the
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/iniacademic.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/iniacademic.F90	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/iniacademic.F90	(revision 1508)
@@ -5,5 +5,7 @@
 
   USE filtreg_mod, ONLY: inifilr
-  USE infotrac, ONLY : nqtot
+  USE infotrac, ONLY : nqtot, ok_isotopes, iso_num, zone_num, &
+                       iqpere, tnat, alpha_ideal, iso_indnum, &
+                       phase_num, iqiso, ok_iso_verif
   USE control_mod, ONLY: day_step,planet_type
 #ifdef CPP_IOIPSL
@@ -262,8 +264,28 @@
               if (i == 2) q(:,:,i)=1.e-15
               if (i.gt.2) q(:,:,i)=0.
+
+              ! CRisi: init des isotopes
+              ! distill de Rayleigh très simplifiée
+              if (ok_isotopes) then
+                if ((iso_num(i).gt.0).and.(zone_num(i).eq.0)) then          
+                   q(:,:,i)=q(:,:,iqpere(i))             &
+      &                  *tnat(iso_num(i))               &
+      &                  *(q(:,:,iqpere(i))/30.e-3)      &
+      &                  **(alpha_ideal(iso_num(i))-1)
+                endif                
+                if ((iso_num(i).gt.0).and.(zone_num(i).eq.1)) then
+                  q(:,:,i)=q(:,:,iqiso(iso_indnum(i),phase_num(i)))
+                endif
+              endif !if (ok_isotopes) then
+
            enddo
         else
            q(:,:,:)=0
         endif ! of if (planet_type=="earth")
+
+        if (ok_iso_verif) then
+! Ehouarn: this will onyly work in serial mode
+!           call check_isotopes_seq(q,1,ip1jmp1,'iniacademic_loc')
+        endif !if (ok_iso_verif) then
 
         ! add random perturbation to temperature
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/iso_verif_dyn.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/iso_verif_dyn.F	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/iso_verif_dyn.F	(revision 1508)
@@ -0,0 +1,101 @@
+        function iso_verif_noNaN_nostop(x,err_msg)
+        implicit none
+        ! si x est NaN, on affiche message
+        ! d'erreur et return 1 si erreur
+
+        ! input:
+        real x
+        character*(*) err_msg ! message d''erreur à afficher
+
+        ! output 
+        real borne
+        parameter (borne=1e19)
+        integer iso_verif_noNaN_nostop
+
+        if ((x.gt.-borne).and.(x.lt.borne)) then
+                iso_verif_noNAN_nostop=0
+        else
+            write(*,*) 'erreur detectee par iso_verif_nonNaN:'
+            write(*,*) err_msg
+            write(*,*) 'x=',x
+            iso_verif_noNaN_nostop=1
+        endif      
+
+        return
+        end
+
+        function iso_verif_egalite_nostop
+     :           (a,b,err_msg)
+        implicit none
+        ! compare a et b. Si pas egal, on affiche message
+        ! d'erreur et stoppe
+        ! pour egalite, on verifie erreur absolue et arreur relative
+
+        ! input:
+        real a, b
+        character*(*) err_msg ! message d''erreur à afficher
+
+        ! locals
+        real errmax ! erreur maximale en absolu.
+        real errmaxrel ! erreur maximale en relatif autorisée
+        parameter (errmax=1e-8)
+        parameter (errmaxrel=1e-3)
+
+        ! output
+        integer iso_verif_egalite_nostop
+
+        iso_verif_egalite_nostop=0
+
+        if (abs(a-b).gt.errmax) then
+          if (abs((a-b)/max(max(abs(b),abs(a)),1e-18))
+     :            .gt.errmaxrel) then
+            write(*,*) 'erreur detectee par iso_verif_egalite:'
+            write(*,*) err_msg
+            write(*,*) 'a=',a
+            write(*,*) 'b=',b
+            iso_verif_egalite_nostop=1
+          endif
+        endif     
+        
+        return
+        end        
+
+
+        function iso_verif_aberrant_nostop
+     :           (x,iso,q,err_msg)
+        USE infotrac
+        implicit none
+        
+        ! input:
+        real x,q
+        integer iso ! 2=HDO, 1=O18
+        character*(*) err_msg ! message d''erreur à afficher
+
+        ! locals
+        real qmin,deltaD
+        real deltaDmax,deltaDmin
+        parameter (qmin=1e-11)
+        parameter (deltaDmax=200.0,deltaDmin=-999.9)
+
+        ! output
+        integer iso_verif_aberrant_nostop
+
+        iso_verif_aberrant_nostop=0
+
+        ! verifier que HDO est raisonable
+         if (q.gt.qmin) then
+             deltaD=(x/q/tnat(iso)-1)*1000
+             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
+                  write(*,*) 'erreur detectee par iso_verif_aberrant:'
+                  write(*,*) err_msg
+                  write(*,*) 'q=',q
+                  write(*,*) 'deltaD=',deltaD
+                  write(*,*) 'iso=',iso
+                  iso_verif_aberrant_nostop=1
+             endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
+          endif !if (q(i,k,iq).gt.qmin) then
+
+       
+        return
+        end        
+
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/misc_mod.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/misc_mod.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/misc_mod.F90	(revision 1508)
@@ -0,0 +1,6 @@
+module misc_mod
+  integer,save :: itaumax
+  logical,save :: adjust
+  integer,save :: ItCount
+  logical,save :: debug
+end module misc_mod 
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/pression.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/pression.F	(revision 1507)
+++ 	(revision )
@@ -1,32 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE pression( ngrid, ap, bp, ps, p )
-c
-
-c      Auteurs : P. Le Van , Fr.Hourdin  .
-
-c  ************************************************************************
-c     Calcule la pression p(l) aux differents niveaux l = 1 ( niveau du
-c     sol) a l = llm +1 ,ces niveaux correspondant aux interfaces des (llm) 
-c     couches , avec  p(ij,llm +1) = 0.  et p(ij,1) = ps(ij)  .      
-c  ************************************************************************
-c
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-c
-      INTEGER ngrid
-      INTEGER l,ij
- 
-      REAL ap( llmp1 ), bp( llmp1 ), ps( ngrid ), p( ngrid,llmp1 ) 
-      
-      DO    l    = 1, llmp1
-        DO  ij   = 1, ngrid
-         p(ij,l) = ap(l) + bp(l) * ps(ij)
-        ENDDO
-      ENDDO
-   
-      RETURN
-      END
Index: trunk/LMDZ.COMMON/libf/dyn3d_common/pression.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3d_common/pression.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3d_common/pression.F90	(revision 1508)
@@ -0,0 +1,27 @@
+SUBROUTINE pression( ngrid, ap, bp, ps, p )
+!
+!-------------------------------------------------------------------------------
+! Authors: P. Le Van , Fr.Hourdin 
+!-------------------------------------------------------------------------------
+! Purpose: Compute pressure p(l) at different levels from l = 1 (ground level)
+!          to l = llm +1. Those levels correspond to the llm layers interfaces,
+!          with p(ij,llm+1) = 0. and  p(ij,1) = ps(ij)  .   
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+!===============================================================================
+! Arguments:
+  INTEGER, INTENT(IN)  :: ngrid                 !--- NUMBER OF GRID POINTS
+  REAL,    INTENT(IN)  :: ap(llmp1), bp(llmp1)  !--- HYBRID COEFFICIENTS
+  REAL,    INTENT(IN)  :: ps(ngrid)             !--- SURFACE PRESSURE
+  REAL,    INTENT(OUT) :: p(ngrid,llmp1)        !--- 3D PRESSURE FIELD 
+!===============================================================================
+! Local variables:
+  INTEGER :: l
+!===============================================================================
+  DO l=1,llmp1;  p(:,l) = ap(l) + bp(l) * ps(:);  END DO
+
+END SUBROUTINE pression
+
+
Index: trunk/LMDZ.COMMON/libf/dyn3dpar/dynredem_p.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3dpar/dynredem_p.F	(revision 1507)
+++ 	(revision )
@@ -1,808 +1,0 @@
-!
-! $Id: dynredem_p.F 1635 2012-07-12 11:37:16Z lguez $
-!
-c
-      SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#endif
-      USE parallel_lmdz
-      USE infotrac
-      use netcdf95, only: NF95_PUT_VAR
-      use control_mod, only : planet_type
-      USE comvert_mod, ONLY: ap,bp,aps,bps,pa,preff,nivsig,nivsigs,
-     .			presnivs,pseudoalt
-      USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
-      USE logic_mod, ONLY: fxyhypb,ysinus
-      USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy,
-     .			taux,tauy
-      USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin,
-     .			start_time,hour_ini
-      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
-
-      IMPLICIT NONE
-c=======================================================================
-c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
-c=======================================================================
-c   Declarations:
-c   -------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "netcdf.inc"
-#include "iniprint.h"
-
-c   Arguments:
-c   ----------
-      INTEGER iday_end
-      REAL phis(iip1, jjp1)
-      CHARACTER*(*) fichnom
-
-c   Local:
-c   ------
-      INTEGER iq,l
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr
-      character*20 modname
-      character*80 abort_message
-
-c   Variables locales pour NetCDF:
-c
-      INTEGER dims2(2), dims3(3), dims4(4)
-      INTEGER idim_index
-      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
-      INTEGER idim_s, idim_sig
-      INTEGER idim_tim
-      INTEGER nid,nvarid
-
-      REAL zan0,zjulian,hours
-      INTEGER yyears0,jjour0, mmois0
-      character*30 unites
-
-      character(len=12) :: start_file_type="earth" ! default start file type
-      INTEGER idecal
-
-c-----------------------------------------------------------------------
-      if (mpi_rank==0) then
-      
-      modname='dynredem0_p'
-
-#ifdef CPP_IOIPSL
-      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
-      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
-#else
-! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
-      yyears0=0
-      mmois0=1
-      jjour0=1
-#endif        
-
-      !!! AS: idecal is a hack to be able to read planeto starts...
-      !!!     .... while keeping everything OK for LMDZ EARTH
-      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
-          write(lunout,*) trim(modname),' : Planeto-like start file'
-          start_file_type="planeto"
-          idecal = 4
-      else
-          write(lunout,*) trim(modname),' : Earth-like start file'
-          idecal = 5
-      endif
-
-      DO l=1,length
-       tab_cntrl(l) = 0.
-      ENDDO
-       tab_cntrl(1)  = REAL(iim)
-       tab_cntrl(2)  = REAL(jjm)
-       tab_cntrl(3)  = REAL(llm)
-       if (start_file_type.eq."earth") then
-         tab_cntrl(4)=REAL(day_ref)
-       else
-         !tab_cntrl(4)=REAL(day_end)
-         tab_cntrl(4)=REAL(iday_end)
-       endif
-       tab_cntrl(5)  = REAL(annee_ref)
-       tab_cntrl(idecal+1)  = rad
-       tab_cntrl(idecal+2)  = omeg
-       tab_cntrl(idecal+3)  = g
-       tab_cntrl(idecal+4)  = cpp
-       tab_cntrl(idecal+5) = kappa
-       tab_cntrl(idecal+6) = daysec
-       tab_cntrl(idecal+7) = dtvr
-       tab_cntrl(idecal+8) = etot0
-       tab_cntrl(idecal+9) = ptot0
-       tab_cntrl(idecal+10) = ztot0
-       tab_cntrl(idecal+11) = stot0
-       tab_cntrl(idecal+12) = ang0
-       tab_cntrl(idecal+13) = pa
-       tab_cntrl(idecal+14) = preff
-c
-c    .....    parametres  pour le zoom      ......   
-
-       tab_cntrl(idecal+15)  = clon
-       tab_cntrl(idecal+16)  = clat
-       tab_cntrl(idecal+17)  = grossismx
-       tab_cntrl(idecal+18)  = grossismy
-c
-      IF ( fxyhypb )   THEN
-       tab_cntrl(idecal+19) = 1.
-       tab_cntrl(idecal+20) = dzoomx
-       tab_cntrl(idecal+21) = dzoomy
-       tab_cntrl(idecal+22) = 0.
-       tab_cntrl(idecal+23) = taux
-       tab_cntrl(idecal+24) = tauy
-      ELSE
-       tab_cntrl(idecal+19) = 0.
-       tab_cntrl(idecal+20) = dzoomx
-       tab_cntrl(idecal+21) = dzoomy
-       tab_cntrl(idecal+22) = 0.
-       tab_cntrl(idecal+23) = 0.
-       tab_cntrl(idecal+24) = 0.
-       IF( ysinus )  tab_cntrl(idecal+22) = 1.
-      ENDIF
-
-      if (start_file_type.eq."earth") then
-       tab_cntrl(idecal+25) = REAL(iday_end)
-       tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
-c start_time: start_time of simulation (not necessarily 0.)
-       tab_cntrl(idecal+27) = start_time
-      endif
-
-      if (planet_type=="mars") then ! For Mars only
-        tab_cntrl(29)=hour_ini
-      endif
-c
-c    .........................................................
-c
-c Creation du fichier:
-c
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
-         WRITE(6,*)' ierr = ', ierr
-         CALL ABORT
-      ENDIF
-c
-c Preciser quelques attributs globaux:
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
-     .                       "Fichier demmarage dynamique")
-c
-c Definir les dimensions du fichiers:
-c
-      if (start_file_type.eq."earth") then
-        ierr = NF_DEF_DIM (nid, "index", length, idim_index)
-        ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
-        ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
-        ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
-        ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
-        ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
-        ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
-        ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
-      else
-        ierr = NF_DEF_DIM (nid, "index", length, idim_index)
-        ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
-        ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
-        ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
-        ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
-        ierr = NF_DEF_DIM (nid, "altitude", llm, idim_s)
-        ierr = NF_DEF_DIM (nid, "interlayer", llmp1, idim_sig)
-        ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_tim)
-      endif
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-c
-c Definir et enregistrer certains champs invariants:
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points U")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,rlonu)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points U")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR (nid,nvarid,rlatu)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points V")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,rlonv)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points V")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,rlatv)
-c
-      if (start_file_type.eq."earth") then
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
-     .                       "Numero naturel des couches s")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,nivsigs)
-c
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
-     .                       "Numero naturel des couches sigma")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,nivsig)
-      endif ! of if (start_file_type.eq."earth")
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient A pour hybride")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,ap)
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient B pour hybride")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,bp)
-c
-      if (start_file_type.ne."earth") then
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 37,
-     .                       "Coef AS: hybrid pressure at midlayers")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,aps)
-c
-        ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-        ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 34,
-     .                       "Coef BS: hybrid sigma at midlayers")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,bps)
-      endif ! of if (start_file_type.ne."earth")
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,presnivs)
-c
-      if (start_file_type.ne."earth") then
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-        ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-        ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .        "North latitude")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,rlatu*180/pi)
-c
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,idim_rlonv,nvarid)
-#else
-        ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,idim_rlonv,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .        "East longitude")
-        ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,rlonv*180/pi)
-c
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
-     .       idim_s,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
-     .       idim_s,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"pseudo-alt")
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
-        ierr = NF_ENDDEF(nid)
-        call NF95_PUT_VAR(nid,nvarid,pseudoalt)
-      endif ! of if (start_file_type.ne."earth")
-c
-c Coefficients de passage cov. <-> contra. <--> naturel
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonu
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour U")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,cu)
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatv
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour V")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,cv)
-c
-c Aire de chaque maille:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Aires de chaque maille")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,aire)
-c
-c Geopentiel au sol:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Geopotentiel au sol")
-      ierr = NF_ENDDEF(nid)
-      call NF95_PUT_VAR(nid,nvarid,phis)
-c
-c Definir les variables pour pouvoir les enregistrer plus tard:
-c
-      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
-c
-      if (start_file_type.eq."earth") then
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
-#endif
-cIM 220306 END
-      else ! start_file_type=="planeto"
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"Time",NF_DOUBLE,1,idim_tim,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"Time",NF_FLOAT,1,idim_tim,nvarid)
-#endif
-      endif ! of if (start_file_type.eq."earth")
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Temps de simulation")
-      write(unites,200)yyears0,mmois0,jjour0
-200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
-     .                         unites)
-
-c
-      dims4(1) = idim_rlonu
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse U")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatv
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse V")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
-     .                       "Temperature")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-
-      DO iq=1,nqtot
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
-      ENDDO
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
-     .                       "C est quoi ?")
-c
-      dims3(1) = idim_rlonv
-      dims3(2) = idim_rlatu
-      dims3(3) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
-     .                       "Pression au sol")
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-      ierr = NF_CLOSE(nid) ! fermer le fichier
-
-      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
-      PRINT*,'rad,omeg,g,cpp,kappa',
-     ,        rad,omeg,g,cpp,kappa
-
-      endif  ! mpi_rank==0
-      RETURN
-      END
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      SUBROUTINE dynredem1_p(fichnom,time,
-     .                     vcov,ucov,teta,q,masse,ps)
-      USE parallel_lmdz
-      USE infotrac
-      USE control_mod, only : planet_type
-      use netcdf, only: NF90_get_VAR
-      use netcdf95, only: NF95_PUT_VAR
-      USE temps_mod, ONLY: itau_dyn,itaufin
-
-      IMPLICIT NONE
-c=================================================================
-c  Ecriture du fichier de redemarrage sous format NetCDF
-c=================================================================
-#include "dimensions.h"
-#include "paramet.h"
-#include "netcdf.inc"
-#include "comgeom.h"
-#include "iniprint.h"
-
-      INTEGER l
-      REAL vcov(iip1,jjm,llm),ucov(iip1, jjp1,llm) 
-      REAL teta(iip1, jjp1,llm)                   
-      REAL ps(iip1, jjp1),masse(iip1, jjp1,llm)                   
-      REAL q(iip1, jjp1, llm, nqtot)
-      CHARACTER*(*) fichnom
-     
-      REAL time
-      INTEGER nid, nvarid, nid_trac, nvarid_trac
-      REAL trac_tmp(ip1jmp1,llm)      
-      INTEGER ierr, ierr_file 
-      INTEGER iq
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      character(len=*),parameter :: modname='dynredem1'
-      character*80 abort_message
-c
-      INTEGER nb
-      SAVE nb
-      DATA nb / 0 /
-
-      logical exist_file
-      character(len=12) :: start_file_type="earth" ! default start file type
-
-      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
-          write(lunout,*) trim(modname),' : Planeto-like start file'
-          start_file_type="planeto"
-      else
-          write(lunout,*) trim(modname),' : Earth-like start file'
-      endif 
-
-      call Gather_Field(ucov,ip1jmp1,llm,0)
-      call Gather_Field(vcov,ip1jm,llm,0)
-      call Gather_Field(teta,ip1jmp1,llm,0)
-      call Gather_Field(masse,ip1jmp1,llm,0)
-      call Gather_Field(ps,ip1jmp1,1,0)
-      
-      do iq=1,nqtot
-        call Gather_Field(q(:,:,:,iq),ip1jmp1,llm,0)
-      enddo
-      
-      
-      if (mpi_rank==0) then
-      
-      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynredem1: Pb. d ouverture "//trim(fichnom)
-         CALL abort
-      ENDIF
-
-c  Ecriture/extension de la coordonnee temps
-
-      nb = nb + 1
-      if (start_file_type.eq."earth") then
-        ierr = NF_INQ_VARID(nid, "temps", nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-          write(lunout,*) NF_STRERROR(ierr)
-          abort_message='Variable temps n est pas definie'
-          CALL abort_gcm(modname,abort_message,ierr)
-        ENDIF
-      else
-        ierr = NF_INQ_VARID(nid,"Time", nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-          write(lunout,*) NF_STRERROR(ierr)
-          abort_message='Variable Time not found'
-          CALL abort_gcm(modname,abort_message,ierr)
-        ENDIF
-      endif ! of if (start_file_type.eq."earth") 
-      call NF95_PUT_VAR(nid,nvarid,time,start=(/nb/))
-      PRINT*, "Enregistrement pour ", nb, time
-
-c
-c  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
-c  on passe dans dynredem0
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="dynredem1: Le champ <controle> est absent"
-         ierr = 1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-      ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl)
-      if (start_file_type=="earth") then
-        tab_cntrl(31) = REAL(itau_dyn + itaufin)
-      else
-        tab_cntrl(31) = 0
-      endif
-      call NF95_PUT_VAR(nid,nvarid,tab_cntrl)
-
-c  Ecriture des champs
-c
-      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ucov n est pas definie"
-         CALL abort
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,ucov,start=(/1,1,1,nb/))
-
-      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable vcov n est pas definie"
-         CALL abort
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,vcov,start=(/1,1,1,nb/))
-
-      ierr = NF_INQ_VARID(nid, "teta", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable teta n est pas definie"
-         CALL abort
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,teta,start=(/1,1,1,nb/))
-
-      IF (type_trac == 'inca') THEN
-! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
-         inquire(FILE="start_trac.nc", EXIST=exist_file) 
-         print *, "EXIST", exist_file
-         if (exist_file) then 
-            ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
-            IF (ierr_file .NE.NF_NOERR) THEN
-               write(6,*)' Pb d''ouverture du fichier start_trac.nc'
-               write(6,*)' ierr = ', ierr_file 
-            ENDIF
-         else
-            ierr_file = 2
-         endif
-      END IF
-
-      do iq=1,nqtot 
-
-         IF (type_trac /= 'inca') THEN
-            ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-            IF (ierr .NE. NF_NOERR) THEN
-               PRINT*, "Variable  tname(iq) n est pas definie"
-               CALL abort
-            ENDIF
-            call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq),start=(/1,1,1,nb/))
-        ELSE ! type_trac = inca
-! lecture de la valeur du traceur dans start_trac.nc
-           IF (ierr_file .ne. 2) THEN
-             ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
-             IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, tname(iq),"est absent de start_trac.nc"
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
-                ENDIF
-                call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq))
-                
-             ELSE
-                PRINT*, tname(iq), "est present dans start_trac.nc"
-               ierr = NF90_GET_VAR(nid_trac, nvarid_trac, trac_tmp)
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Lecture echouee pour", tname(iq)
-                   CALL abort
-                ENDIF
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
-                ENDIF
-                call NF95_PUT_VAR(nid, nvarid, trac_tmp)
-               
-             ENDIF ! IF (ierr .NE. NF_NOERR)
-! fin lecture du traceur
-          ELSE                  ! si il n'y a pas de fichier start_trac.nc
-!             print *, 'il n y a pas de fichier start_trac'
-             ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-             IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, "Variable  tname(iq) n est pas definie"
-                CALL abort
-             ENDIF
-             call NF95_PUT_VAR(nid,nvarid,q(:,:,:,iq),
-     &                  start=(/1,1,1,nb/))
-          ENDIF ! (ierr_file .ne. 2)
-       END IF   !type_trac
-      
-      ENDDO
-
-
-
-c
-      ierr = NF_INQ_VARID(nid, "masse", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable masse n est pas definie"
-         CALL abort
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,masse,start=(/1,1,1,nb/))
-c
-      ierr = NF_INQ_VARID(nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ps n est pas definie"
-         CALL abort
-      ENDIF
-      call NF95_PUT_VAR(nid,nvarid,ps,start=(/1,1,nb/))
-
-      ierr = NF_CLOSE(nid)
-c
-      endif ! mpi_rank==0
-      
-      RETURN
-      END
-
Index: trunk/LMDZ.COMMON/libf/dyn3dpar/dynredem_p.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3dpar/dynredem_p.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dyn3dpar/dynredem_p.F90	(revision 1508)
@@ -0,0 +1,408 @@
+!
+! $Id: dynredem_p.F 1635 2012-07-12 11:37:16Z lguez $
+!
+SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#endif
+  USE parallel_lmdz, ONLY: mpi_rank
+  USE infotrac, ONLY: nqtot, tname, ttext
+  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
+                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
+  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
+  use netcdf95, only: NF95_PUT_VAR
+  use control_mod, only : planet_type
+  USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, &
+      			nivsig,nivsigs
+  USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
+  USE logic_mod, ONLY: fxyhypb,ysinus
+  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
+      			taux,tauy
+  USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin, &
+      			start_time,hour_ini
+  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
+
+  IMPLICIT NONE
+!=======================================================================
+! Writting the NetCDF restart file (initialisation)
+!=======================================================================
+!   Declarations:
+!   -------------
+  include "dimensions.h"
+  include "paramet.h"
+  include "comgeom2.h"
+  include "netcdf.inc"
+  include "iniprint.h"
+
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
+  INTEGER,          INTENT(IN) :: iday_end         !--- 
+  REAL,             INTENT(IN) :: phis(iip1, jjp1) !--- GROUND GEOPOTENTIAL
+!===============================================================================
+! Local variables:
+  INTEGER :: iq,l
+  INTEGER, PARAMETER :: length=100
+  REAL :: tab_cntrl(length) ! run parameters
+  INTEGER :: ierr
+  CHARACTER(LEN=80) :: abort_message
+
+!   For NetCDF:
+  CHARACTER(LEN=30) :: unites
+  INTEGER :: indexID
+  INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
+  INTEGER :: sID, sigID, nID, vID, timID
+  INTEGER :: yyears0, jjour0, mmois0
+  REAL    :: zan0, zjulian, hours
+
+  CHARACTER(len=12) :: start_file_type="earth" ! default start file type
+  INTEGER :: idecal
+
+!===============================================================================
+  if (mpi_rank==0) then ! only the master reads input file
+  ! fill dynredem_mod module variables
+  modname='dynredem0_p'; fil=fichnom
+
+#ifdef CPP_IOIPSL
+  call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
+  call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
+#else
+! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
+  yyears0=0
+  mmois0=1
+  jjour0=1
+#endif        
+
+  !!! AS: idecal is a hack to be able to read planeto starts...
+  !!!     .... while keeping everything OK for LMDZ EARTH
+  if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
+    write(lunout,*) trim(modname),' : Planeto-like start file'
+    start_file_type="planeto"
+    idecal = 4
+  else
+    write(lunout,*) trim(modname),' : Earth-like start file'
+    idecal = 5
+  endif
+
+  tab_cntrl(:)  = 0.
+  tab_cntrl(1)  = REAL(iim)
+  tab_cntrl(2)  = REAL(jjm)
+  tab_cntrl(3)  = REAL(llm)
+  if (start_file_type.eq."earth") then
+    tab_cntrl(4)=REAL(day_ref)
+  else
+    !tab_cntrl(4)=REAL(day_end)
+    tab_cntrl(4)=REAL(iday_end)
+  endif
+  tab_cntrl(5)  = REAL(annee_ref)
+  tab_cntrl(idecal+1)  = rad
+  tab_cntrl(idecal+2)  = omeg
+  tab_cntrl(idecal+3)  = g
+  tab_cntrl(idecal+4)  = cpp
+  tab_cntrl(idecal+5) = kappa
+  tab_cntrl(idecal+6) = daysec
+  tab_cntrl(idecal+7) = dtvr
+  tab_cntrl(idecal+8) = etot0
+  tab_cntrl(idecal+9) = ptot0
+  tab_cntrl(idecal+10) = ztot0
+  tab_cntrl(idecal+11) = stot0
+  tab_cntrl(idecal+12) = ang0
+  tab_cntrl(idecal+13) = pa
+  tab_cntrl(idecal+14) = preff
+
+!    .....    parameters for the zoom      ......   
+  tab_cntrl(idecal+15)  = clon
+  tab_cntrl(idecal+16)  = clat
+  tab_cntrl(idecal+17)  = grossismx
+  tab_cntrl(idecal+18)  = grossismy
+!
+  IF ( fxyhypb )   THEN
+    tab_cntrl(idecal+19) = 1.
+    tab_cntrl(idecal+20) = dzoomx
+    tab_cntrl(idecal+21) = dzoomy
+    tab_cntrl(idecal+22) = 0.
+    tab_cntrl(idecal+23) = taux
+    tab_cntrl(idecal+24) = tauy
+  ELSE
+    tab_cntrl(idecal+19) = 0.
+    tab_cntrl(idecal+20) = dzoomx
+    tab_cntrl(idecal+21) = dzoomy
+    tab_cntrl(idecal+22) = 0.
+    tab_cntrl(idecal+23) = 0.
+    tab_cntrl(idecal+24) = 0.
+    IF( ysinus )  tab_cntrl(idecal+22) = 1.
+  ENDIF
+
+  if (start_file_type.eq."earth") then
+    tab_cntrl(idecal+25) = REAL(iday_end)
+    tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
+! start_time: start_time of simulation (not necessarily 0.)
+    tab_cntrl(idecal+27) = start_time
+  endif
+
+  if (planet_type=="mars") then ! For Mars only
+    tab_cntrl(29)=hour_ini
+  endif
+
+!--- File creation
+  CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid))
+
+!--- Some global attributes
+  CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))
+
+!--- Dimensions
+  if (start_file_type.eq."earth") then
+    CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
+    CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
+    CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1,   rlatuID))
+    CALL err(NF90_DEF_DIM(nid,"rlonv", iip1,   rlonvID))
+    CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
+    CALL err(NF90_DEF_DIM(nid,"sigs",  llm,        sID))
+    CALL err(NF90_DEF_DIM(nid,"sig",   llmp1,    sigID))
+    CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))
+  else
+    CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
+    CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
+    CALL err(NF90_DEF_DIM(nid,"latitude", jjp1,   rlatuID))
+    CALL err(NF90_DEF_DIM(nid,"longitude", iip1,   rlonvID))
+    CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
+    CALL err(NF90_DEF_DIM(nid,"altitude",  llm,        sID))
+    CALL err(NF90_DEF_DIM(nid,"interlayer",   llmp1,    sigID))
+    CALL err(NF90_DEF_DIM(nid,"Time", NF90_UNLIMITED, timID))
+  endif
+
+!--- Define and save invariant fields
+  CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
+  CALL put_var1(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
+  CALL put_var1(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
+  CALL put_var1(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
+  CALL put_var1(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
+  if (start_file_type.eq."earth") then
+    CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
+    CALL put_var1(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
+  endif ! of if (start_file_type.eq."earth")
+  CALL put_var1(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
+  CALL put_var1(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
+  if (start_file_type.ne."earth") then
+    CALL put_var1(nid,"aps","Coef AS: hybrid pressure at midlayers",[sID],aps)
+    CALL put_var1(nid,"bps","Coef BS: hybrid sigma at midlayers",[sID],bps)
+  endif ! of if (start_file_type.eq."earth")
+  CALL put_var1(nid,"presnivs",""                                ,[sID]  ,presnivs)
+  if (start_file_type.ne."earth") then
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,rlatuID,vID)
+#else
+        ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,rlatuID,vID)
+#endif
+        ierr =NF_PUT_ATT_TEXT(nid,vID,'units',13,"degrees_north")
+        ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
+              "North latitude")
+        ierr = NF_ENDDEF(nid)
+        call NF95_PUT_VAR(nid,vID,rlatu*180/pi)
+!
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,rlonvID,vID)
+#else
+        ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,rlonvID,vID)
+#endif
+        ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
+              "East longitude")
+        ierr = NF_PUT_ATT_TEXT(nid,vID,'units',12,"degrees_east")
+        ierr = NF_ENDDEF(nid)
+        call NF95_PUT_VAR(nid,vID,rlonv*180/pi)
+!
+        ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+        ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, &
+             sID,vID)
+#else
+        ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, &
+             sID,vID)
+#endif
+        ierr = NF_PUT_ATT_TEXT(nid,vID,"long_name",10,"pseudo-alt")
+        ierr = NF_PUT_ATT_TEXT (nid,vID,'units',2,"km")
+        ierr = NF_PUT_ATT_TEXT (nid,vID,'positive',2,"up")
+        ierr = NF_ENDDEF(nid)
+        call NF95_PUT_VAR(nid,vID,pseudoalt)
+        CALL err(NF_REDEF(nid))
+  endif ! of if (start_file_type.ne."earth")
+
+! covariant <-> contravariant <-> natural conversion coefficients
+  CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
+  CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
+  CALL put_var2(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
+  CALL put_var2(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
+
+
+! Define variables that will be stored later:
+  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
+               yyears0,mmois0,jjour0
+  IF (planet_type.eq."earth") THEN
+    CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
+  ELSE
+    CALL cre_var(nid,"Time","Temps de simulation",[timID],unites)
+  ENDIF
+
+  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
+  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
+  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
+
+  IF(nqtot.GE.1) THEN
+    DO iq=1,nqtot
+      CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
+    END DO
+  ENDIF
+
+  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
+  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
+
+  CALL err(NF90_CLOSE (nid)) ! close file
+
+  WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
+  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+
+  endif ! of if (mpi_rank==0)
+
+END SUBROUTINE dynredem0_p
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE dynredem1_p(fichnom,time,vcov,ucov,teta,q,masse,ps)
+!
+!-------------------------------------------------------------------------------
+! Purpose: Write the NetCDF restart file (append).
+!-------------------------------------------------------------------------------
+  USE parallel_lmdz, ONLY: mpi_rank, gather_field
+  USE infotrac, ONLY: nqtot, tname, type_trac
+  USE control_mod, only : planet_type
+  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
+                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
+  use netcdf95, only: NF95_PUT_VAR
+  USE temps_mod, ONLY: itaufin,itau_dyn
+  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
+                          err, modname, fil, msg
+ 
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "netcdf.inc"
+  include "comgeom.h"
+  include "iniprint.h"
+!===============================================================================
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
+  REAL, INTENT(IN)    ::  time                         !-- TIME
+  REAL, INTENT(IN)    ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
+  REAL, INTENT(IN)    ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
+  REAL, INTENT(IN)    ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
+  REAL, INTENT(INOUT) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
+  REAL, INTENT(IN)    :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
+  REAL, INTENT(IN)    ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
+!===============================================================================
+! Local variables:
+  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
+  INTEGER,SAVE :: nb=0
+  INTEGER, PARAMETER :: length=100
+  REAL               :: tab_cntrl(length) ! tableau des parametres du run
+  CHARACTER(LEN=256) :: var, dum
+  LOGICAL            :: lread_inca
+  CHARACTER(LEN=80) :: abort_message
+  CHARACTER(len=12) :: start_file_type="earth" ! default start file type
+
+  ! fill dynredem_mod module variables
+  modname='dynredem1_p'; fil=fichnom
+
+  ! Gather datasets
+  call Gather_Field(ucov,ip1jmp1,llm,0)
+  call Gather_Field(vcov,ip1jm,llm,0)
+  call Gather_Field(teta,ip1jmp1,llm,0)
+  call Gather_Field(masse,ip1jmp1,llm,0)
+  call Gather_Field(ps,ip1jmp1,1,0)
+      
+  do iq=1,nqtot
+    call Gather_Field(q(:,:,:,iq),ip1jmp1,llm,0)
+  enddo
+
+  IF (mpi_rank==0) THEN ! only the master writes restart file
+
+  if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
+      write(lunout,*) trim(modname),' : Planeto-like start file'
+      start_file_type="planeto"
+  else
+      write(lunout,*) trim(modname),' : Earth-like start file'
+  endif 
+
+  CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
+
+!--- Write/extend time coordinate
+  nb = nb + 1
+  if (start_file_type.eq."earth") then
+        ierr = NF_INQ_VARID(nid, "temps", vID)
+        IF (ierr .NE. NF_NOERR) THEN
+          write(lunout,*) NF_STRERROR(ierr)
+          abort_message='Variable temps n est pas definie'
+          CALL abort_gcm(modname,abort_message,ierr)
+        ENDIF
+ else
+        ierr = NF_INQ_VARID(nid,"Time", vID)
+        IF (ierr .NE. NF_NOERR) THEN
+          write(lunout,*) NF_STRERROR(ierr)
+          abort_message='Variable Time not found'
+          CALL abort_gcm(modname,abort_message,ierr)
+        ENDIF
+  endif ! of if (start_file_type.eq."earth") 
+  call NF95_PUT_VAR(nid,vID,time,start=(/nb/))
+  WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
+
+!--- Rewrite control table (itaufin undefined in dynredem0)
+  var="controle"
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
+  if (start_file_type=="earth") then
+    tab_cntrl(31) = REAL(itau_dyn + itaufin)
+  else
+    tab_cntrl(31) = 0
+  endif
+  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
+  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
+
+!--- Save fields
+  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm, nb)
+  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm, nb)
+  CALL dynredem_write_u(nid,"teta" ,teta ,llm, nb)
+  CALL dynredem_write_u(nid,"masse",masse,llm, nb)
+  CALL dynredem_write_u(nid,"ps"   ,ps   ,1, nb)
+
+!--- Tracers in file "start_trac.nc" (added by Anne)
+  lread_inca=.FALSE.; fil="start_trac.nc"
+  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
+  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
+
+!--- Save tracers
+  IF(nqtot.GE.1) THEN
+    DO iq=1,nqtot
+      var=tname(iq); ierr=-1
+      IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
+        fil="start_trac.nc"
+        ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
+        dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
+        WRITE(lunout,*)msg(dum,var)
+
+
+        IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
+      END IF ! of IF(lread_inca)
+      fil=fichnom
+      CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm,nb)
+    END DO ! of DO iq=1,nqtot
+  ENDIF ! of IF(nqtot.GE.1)
+
+  CALL err(NF90_CLOSE(nid),"close")
+  fil="start_trac.nc"
+  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
+
+  ENDIF ! of IF (mpi_rank==0)
+
+END SUBROUTINE dynredem1_p
+
Index: trunk/LMDZ.COMMON/libf/dyn3dpar/integrd_p.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3dpar/integrd_p.F	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3dpar/integrd_p.F	(revision 1508)
@@ -5,5 +5,5 @@
      $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
      $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis) !,finvmaold)
-      USE parallel_lmdz
+      USE parallel_lmdz, ONLY: ij_begin, ij_end, pole_nord, pole_sud
       USE control_mod, only : planet_type
       USE comvert_mod, ONLY: ap,bp
Index: trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F
===================================================================
--- trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F	(revision 1508)
@@ -771,5 +771,5 @@
 !       CALL FTRACE_REGION_BEGIN("integrd")
 
-       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
+       CALL integrd_p (nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 ,
      $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis )
 !     $              finvmaold                                    )
@@ -886,10 +886,8 @@
       IF (ip_ebil_dyn.ge.1 ) THEN 
           ztit='bil dyn'
-! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
+! Ehouarn: be careful, diagedyn is Earth-specific!
            IF (planet_type.eq."earth") THEN
-#ifdef CPP_EARTH
             CALL diagedyn(ztit,2,1,1,dtphys
      &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
-#endif
            ENDIF
       ENDIF 
Index: trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/grid_atob_m.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/grid_atob_m.F90	(revision 1508)
+++ trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/grid_atob_m.F90	(revision 1508)
@@ -0,0 +1,292 @@
+!*******************************************************************************
+!
+MODULE grid_atob_m
+!
+!*******************************************************************************
+
+  USE assert_eq_m, ONLY: assert_eq
+  REAL, SAVE :: pi, deg2rad
+
+  PRIVATE
+  PUBLIC :: grille_m, rugosite, sea_ice, rugsoro
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE fine2coarse(x_i, y_i, x_o, y_o, d_o1, d_i, msk, d_o2)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL,              INTENT(IN)  :: x_i(:), y_i(:) !-- INPUT  X&Y COOR. (mi)(ni)
+  REAL,              INTENT(IN)  :: x_o(:), y_o(:) !-- OUTPUT X&Y COOR. (mi)(ni)
+  REAL,              INTENT(OUT) :: d_o1(:,:)      !-- OUTPUT FIELD     (mo,no)
+  REAL,    OPTIONAL, INTENT(IN)  :: d_i (:,:)      !-- INPUT FIELD      (mi,ni)
+  LOGICAL, OPTIONAL, INTENT(IN)  :: msk (:,:)      !-- MASK             (mi,ni)
+  REAL,    OPTIONAL, INTENT(OUT) :: d_o2(:,:)      !-- OUTPUT FOR d_i^2 (mo,no)
+!-------------------------------------------------------------------------------
+! Local variables:
+  CHARACTER(LEN=256) :: modname="fine2coarse"
+  INTEGER :: mi, ni, ii, ji, mo, no, io, jo, nr(2), m1, n1, m2, n2, nn
+  INTEGER :: num_tot(SIZE(x_o),SIZE(y_o))
+  LOGICAL :: found(SIZE(x_o),SIZE(y_o)), li
+  LOGICAL :: mask (SIZE(x_i),SIZE(y_i)), lo
+  REAL    :: dist (SIZE(x_o),SIZE(y_o))
+  REAL    :: a(SIZE(x_o)), b(SIZE(x_o)), c(SIZE(y_o)), d(SIZE(y_o)), inc
+  REAL, PARAMETER :: thresh=1.E-5
+!-------------------------------------------------------------------------------
+  mask(:,:)=.TRUE.; IF(PRESENT(msk)) mask(:,:)=msk(:,:)
+  mi=SIZE(x_i); m1=mi; ni=SIZE(y_i); n1=ni
+  mo=SIZE(x_o); m2=mo; no=SIZE(y_o); n2=no
+  li=PRESENT(d_i ); IF(li) THEN; m1=SIZE(d_i ,1); n1=SIZE(d_i ,2); END IF
+  lo=PRESENT(d_o2); IF(lo) THEN; m2=SIZE(d_o2,1); n2=SIZE(d_o2,2); END IF
+  mi=assert_eq(mi,m1,SIZE(mask,1),TRIM(modname)//" mi")
+  ni=assert_eq(ni,n1,SIZE(mask,2),TRIM(modname)//" ni")
+  mo=assert_eq(mo,m2,SIZE(d_o1,1),TRIM(modname)//" mo")
+  no=assert_eq(no,n2,SIZE(d_o1,2),TRIM(modname)//" no")
+
+!--- COMPUTE CELLS INTERFACES COORDINATES OF OUTPUT GRID
+  b(mo)=x_o(mo)+(x_o(mo)-x_o(mo-1))/2.0; b(1:mo-1)=(x_o(1:mo-1)+x_o(2:mo))/2.0
+  d(no)=y_o(no)+(y_o(no)-y_o(no-1))/2.0; d(1:no-1)=(y_o(1:no-1)+y_o(2:no))/2.0
+  a(1 )=x_o(1 )-(x_o(2 )-x_o(1   ))/2.0; a(2:mo  )=   b(1:mo-1)
+  c(1 )=y_o(1 )-(y_o(2 )-y_o(1   ))/2.0; c(2:no  )=   d(1:no-1)
+
+!--- ACCUMULATE INPUT POINTS ON OUTPUT GRID
+  d_o1(:,:)=0.; num_tot(:,:)=0; inc=1.0
+  IF(lo) d_o2(:,:)=0.
+  DO ji = 1, ni
+    DO ii = 1, mi
+      IF(li) inc=d_i(ii,ji)
+      DO jo = 1, no
+        IF((y_i(ji)-c(jo)<thresh.OR.y_i(ji)-d(jo)>thresh).AND.   &
+           (y_i(ji)-c(jo)>thresh.OR.y_i(ji)-d(jo)<thresh)) CYCLE
+        DO io = 1, mo
+          IF((x_i(ii)-a(io)<thresh.OR.x_i(ii)-b(io)>thresh).AND. &
+             (x_i(ii)-a(io)>thresh.OR.x_i(ii)-b(io)<thresh)) CYCLE
+          num_tot(io,jo)=num_tot(io,jo)+1
+          IF(mask(ii,ji)) d_o1(io,jo)=d_o1(io,jo)+inc
+          IF(.NOT.lo) CYCLE
+          IF(mask(ii,ji)) d_o2(io,jo)=d_o2(io,jo)+inc*inc
+        END DO
+      END DO
+    END DO
+  END DO
+
+!--- CHECK INPUT POINTS HAVE BEEN FOUND IN EACH OUTPUT CELL
+  found(:,:)=num_tot(:,:)/=0
+  WHERE(found.AND.mask) d_o1(:,:)=d_o1(:,:)/REAL(num_tot(:,:))
+  IF(PRESENT(d_o2)) THEN
+    WHERE(found.AND.mask) d_o2(:,:)=d_o2(:,:)/REAL(num_tot(:,:))
+    RETURN
+  END IF
+  nn=COUNT(found); IF(nn==0) RETURN
+
+!--- MISSING POINTS ; USE DISTANCE ON THE SPHERE TO FIND NEAREST POINT nr(2)
+  DO io = 1, mo
+    DO jo = 1, no
+      IF(found(io,jo)) CYCLE
+!      IF(prt_level>=1) PRINT*, "Problem: point out of domain (i,j)=", io,jo
+      CALL dist_sphe(x_o(io),y_o(jo),x_i,y_i,dist(:,:))
+      nr=MINLOC(dist(:,:))!; IF(prt_level>=1) PRINT*, "Solution: ", nr
+      inc=1.0; IF(li) inc=d_i(nr(1),nr(2))
+      IF(mask(nr(1),nr(2))) d_o1(io,jo)=inc
+    END DO
+  END DO
+
+END SUBROUTINE fine2coarse
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE grille_m(xdata, ydata, entree, x, y, sortie)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994) (see also A. Harzallah and L. Fairhead)
+!-------------------------------------------------------------------------------
+! Purpose: Naive method to regrid on a coarser grid.
+!   Value at a new point is an average of the old points lcoated in a zone
+!   surrounding the considered new point.
+!   No ponderation is used (see grille_p)
+!
+!           (c)
+!        ----d-----
+!        | . . . .|
+!        |        |
+!     (b)a . * . .b(a)
+!        |        |
+!        | . . . .|
+!        ----c-----
+!           (d)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xdata(:), ydata(:)       !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: entree(SIZE(xdata),SIZE(ydata)) !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: x(:), y(:)               !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y))  !--- OUTPUT FIELD 
+!-------------------------------------------------------------------------------
+  CALL fine2coarse(xdata,ydata,x,y,sortie,entree)
+
+END SUBROUTINE grille_m
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE rugosite(xdata, ydata, entree, x, y, sortie, mask)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994)
+!-------------------------------------------------------------------------------
+! Purpose: Remap rugosity length ; constant value (0.001) on oceans.
+! Naive method  (see grille_m)
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xdata(:), ydata(:)      !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: entree(SIZE(xdata),SIZE(ydata)) !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: x(:), y(:)              !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y)) !--- OUTPUT FIELD 
+  REAL, INTENT(IN)  :: mask  (SIZE(x),SIZE(y)) !--- MASK
+!-------------------------------------------------------------------------------
+  CALL fine2coarse(xdata,ydata,x,y,sortie,LOG(entree))
+  WHERE(NINT(mask)==1)
+    sortie(:,:)=EXP(sortie(:,:))
+  ELSE WHERE
+    sortie(:,:)=0.001
+  END WHERE
+
+END SUBROUTINE rugosite
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE sea_ice(xdata, ydata, glace01, x, y, frac_ice)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994)
+! Purpose: Regrid ice indicator (0 or 1) on a coarser grid to get an ice fract.
+! field (between 0 and 1).
+! Naive method  (see grille_m)
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xdata(:), ydata(:)      !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: glace01(:,:)            !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: x(:), y(:)              !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: frac_ice(SIZE(x),SIZE(y)) !--- OUTPUT FIELD 
+!-------------------------------------------------------------------------------
+  CALL fine2coarse(xdata,ydata,x,y,frac_ice,msk=NINT(glace01)==1)
+
+END SUBROUTINE sea_ice
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE rugsoro(xrel, yrel, relief, xmod, ymod, rugs)
+!
+!-------------------------------------------------------------------------------
+! Author:  Z.X. Li (april 1st 1994) ; Modifications: august 23rd 1995.
+! Purpose: Compute rugosity due to orography by using standard dev in a 1x1 cell
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: xrel(:), yrel(:)        !--- INPUT  FIELD X AND Y COORD.
+  REAL, INTENT(IN)  :: relief(:,:)             !--- INPUT  FIELD
+  REAL, INTENT(IN)  :: xmod(:), ymod(:)        !--- OUTPUT FIELD X AND Y COORD.
+  REAL, INTENT(OUT) :: rugs(SIZE(xmod),SIZE(ymod)) !--- OUTPUT FIELD 
+!-------------------------------------------------------------------------------
+! Local variable:
+  INTEGER           :: k, nn
+  INTEGER, PARAMETER:: itmp=360, jtmp=180
+  REAL  :: out(SIZE(xmod),SIZE(xmod)), amin, amax
+  REAL  :: cham1tmp(itmp,jtmp), cham2tmp(itmp,jtmp), xtmp(itmp), ytmp(jtmp)
+!-------------------------------------------------------------------------------
+
+!--- TEST INPUT FILE FITS FOR ONE DEGREE RESOLUTION
+  xtmp(:)=4.0*ATAN(1.0)*[(-1.0+REAL(2*k-1)/REAL(itmp),k=1,itmp)]
+  ytmp(:)=2.0*ATAN(1.0)*[(-1.0+REAL(2*k-1)/REAL(jtmp),k=1,jtmp)]
+  CALL fine2coarse(xrel,yrel,xtmp,ytmp,cham1tmp,relief,d_o2=cham2tmp)
+  cham2tmp(:,:)=cham2tmp(:,:)-cham1tmp(:,:)**2
+  nn=COUNT(cham2tmp<=-7.5)
+  IF(nn/=0) THEN
+    PRINT*,'Problem for rugsoro ; std**2 < -7.5 for several points: ',nn
+    CALL ABORT_GCM("", "", 1)
+  END IF
+  nn=COUNT(cham2tmp<0)
+  IF(nn/=0) PRINT*,'Problem for rugsoro ; std**2 < 0. for several points: ',nn
+  WHERE(cham2tmp<0.0) cham2tmp=0.0
+  cham2tmp(:,:)=SQRT(cham2tmp(:,:))
+  amin=MINVAL(cham2tmp); amax=MAXVAL(cham2tmp)
+  PRINT*, 'Ecart-type 1x1:', amin, amax
+
+!--- COMPUTE RUGOSITY AT REQUIRED SCALE
+  WHERE(cham2tmp<0.001) cham2tmp=0.001
+  CALL fine2coarse(xtmp,ytmp,xmod,ymod,out,REAL(LOG(cham2tmp)))
+  out=EXP(out)
+  amin=MINVAL(out); amax=MAXVAL(out)
+  PRINT*, 'Ecart-type du modele:', amin, amax
+  out=out/amax*20.0
+  amin=MINVAL(out); amax=MAXVAL(out)
+  PRINT*, 'Longueur de rugosite du modele:', amin, amax
+  rugs=REAL(out)
+
+END SUBROUTINE rugsoro
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,distance)
+!
+!-------------------------------------------------------------------------------
+! Author:  Laurent Li (december 30th 1996).
+! Purpose: Compute min. distance (along big circle) between 2 points in degrees.
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN) :: rf_lon, rf_lat  !--- Reference point coordinates (degrees)
+  REAL, INTENT(IN) :: rlon(:), rlat(:)!--- Points longitudes/latitudes (degrees)
+  REAL, INTENT(OUT):: distance(SIZE(rlon),SIZE(rlat)) !--- Distance    (degrees)
+!-------------------------------------------------------------------------------
+! Local variables:
+  LOGICAL, SAVE :: first=.TRUE.
+  REAL    :: pa, pb, cpa, cpab, spa, spab, crlo(SIZE(rlon))
+  INTEGER :: i, j
+!-------------------------------------------------------------------------------
+  IF(first) THEN
+    pi=4.0*ATAN(1.0); deg2rad=pi/180.0; first=.FALSE.
+  END IF
+  crlo(:)=COS((rf_lon-rlon(:))*deg2rad)     !--- COS of points 1 and 2 angle
+  pa=(90.0-rf_lat)*deg2rad                  !--- North Pole - Point 1 distance
+  cpa=COS(pa); spa=SIN(pa)
+  DO j=1,SIZE(rlat)
+    pb=(90.0-rlat(j))*deg2rad               !--- North Pole - Point 2 distance
+    cpab=cpa*COS(pb); spab=spa*SIN(pb)
+    distance(:,j)=ACOS(cpab+spab*crlo(:))/deg2rad
+  END DO
+
+END SUBROUTINE dist_sphe
+!
+!-------------------------------------------------------------------------------
+
+END MODULE grid_atob_m
+!
+!*******************************************************************************
+
Index: trunk/LMDZ.COMMON/libf/misc/misc_mod.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/misc/misc_mod.F90	(revision 1507)
+++ 	(revision )
@@ -1,6 +1,0 @@
-module misc_mod
-  integer,save :: itaumax
-  logical,save :: adjust
-  integer,save :: ItCount
-  logical,save :: debug
-end module misc_mod 
Index: trunk/LMDZ.COMMON/libf/misc/wxios.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/misc/wxios.F90	(revision 1507)
+++ trunk/LMDZ.COMMON/libf/misc/wxios.F90	(revision 1508)
@@ -21,5 +21,7 @@
     CHARACTER(len=100) :: g_field_name = "nofield"
 !$OMP THREADPRIVATE(g_flag_xml,g_field_name)
-
+    REAL :: missing_val_omp
+    REAL :: missing_val
+!$OMP THREADPRIVATE(missing_val)
 
     CONTAINS
