Index: trunk/libf/dyn3d/caladvtrac.F
===================================================================
--- trunk/libf/dyn3d/caladvtrac.F	(revision 53)
+++ trunk/libf/dyn3d/caladvtrac.F	(revision 66)
@@ -8,5 +8,5 @@
      *                   flxw, pk)
 c
-      USE infotrac
+      USE infotrac, ONLY : nqtot
       USE control_mod, ONLY : iapp_tracvl,planet_type
  
Index: trunk/libf/dyn3d/disvert.F
===================================================================
--- trunk/libf/dyn3d/disvert.F	(revision 53)
+++ 	(revision )
@@ -1,194 +1,0 @@
-!
-! $Id: disvert.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
-
-c    Auteur :  P. Le Van .
-c
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
-#include "logic.h"
-c
-c=======================================================================
-c
-c
-c    s = sigma ** kappa   :  coordonnee  verticale
-c    dsig(l)            : epaisseur de la couche l ds la coord.  s
-c    sig(l)             : sigma a l'interface des couches l et l-1
-c    ds(l)              : distance entre les couches l et l-1 en coord.s
-c
-c=======================================================================
-c
-      REAL pa,preff
-      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
-      REAL presnivs(llm)
-c
-c   declarations:
-c   -------------
-c
-      REAL sig(llm+1),dsig(llm)
-       real zzz(1:llm+1)
-       real dzz(1:llm)
-      real zk,zkm1,dzk1,dzk2,k0,k1
-c
-      INTEGER l
-      REAL snorm,dsigmin
-      REAL alpha,beta,gama,delta,deltaz,h
-      INTEGER np,ierr
-      REAL pi,x
-
-      REAL SSUM
-c
-c-----------------------------------------------------------------------
-c
-      pi=2.*ASIN(1.)
-
-      OPEN(99,file='sigma.def',status='old',form='formatted',
-     s   iostat=ierr)
-
-c-----------------------------------------------------------------------
-c   cas 1 on lit les options dans sigma.def:
-c   ----------------------------------------
-
-      IF (ierr.eq.0) THEN
-
-      READ(99,*) h           ! hauteur d'echelle 8.
-      READ(99,*) deltaz      ! epaiseur de la premiere couche 0.04
-      READ(99,*) beta        ! facteur d'acroissement en haut 1.3
-      READ(99,*) k0          ! nombre de couches dans la transition surf
-      READ(99,*) k1          ! nombre de couches dans la transition haute
-      CLOSE(99)
-      alpha=deltaz/(llm*h)
-      write(lunout,*)'h,alpha,k0,k1,beta'
-
-c     read(*,*) h,deltaz,beta,k0,k1 ! 8 0.04 4 20 1.2
-
-      alpha=deltaz/tanh(1./k0)*2.
-      zkm1=0.
-      sig(1)=1.
-      do l=1,llm
-        sig(l+1)=(cosh(l/k0))**(-alpha*k0/h)
-     + *exp(-alpha/h*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta))
-        zk=-h*log(sig(l+1))
-
-        dzk1=alpha*tanh(l/k0)
-        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
-        write(lunout,*)l,sig(l+1),zk,zk-zkm1,dzk1,dzk2
-        zkm1=zk
-      enddo
-
-      sig(llm+1)=0.
-
-c
-       DO 2  l = 1, llm
-       dsig(l) = sig(l)-sig(l+1)
-   2   CONTINUE
-c
-
-      ELSE
-c-----------------------------------------------------------------------
-c   cas 2 ancienne discretisation (LMD5...):
-c   ----------------------------------------
-
-      WRITE(LUNOUT,*)'WARNING!!! Ancienne discretisation verticale'
-
-      if (ok_strato) then
-         if (llm==39) then
-            dsigmin=0.3
-         else if (llm==50) then
-            dsigmin=1.
-         else
-            WRITE(LUNOUT,*) 'ATTENTION discretisation z a ajuster'
-            dsigmin=1.
-         endif
-         WRITE(LUNOUT,*) 'Discretisation verticale DSIGMIN=',dsigmin
-      endif
-
-      h=7.
-      snorm  = 0.
-      DO l = 1, llm
-         x = 2.*asin(1.) * (REAL(l)-0.5) / REAL(llm+1)
-
-         IF (ok_strato) THEN
-           dsig(l) =(dsigmin + 7.0 * SIN(x)**2)
-     &            *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2        
-         ELSE
-           dsig(l) = 1.0 + 7.0 * SIN(x)**2
-         ENDIF
-
-         snorm = snorm + dsig(l)
-      ENDDO
-      snorm = 1./snorm
-      DO l = 1, llm
-         dsig(l) = dsig(l)*snorm
-      ENDDO
-      sig(llm+1) = 0.
-      DO l = llm, 1, -1
-         sig(l) = sig(l+1) + dsig(l)
-      ENDDO
-
-      ENDIF
-
-
-      DO l=1,llm
-        nivsigs(l) = REAL(l)
-      ENDDO
-
-      DO l=1,llmp1
-        nivsig(l)= REAL(l)
-      ENDDO
-
-c
-c    ....  Calculs  de ap(l) et de bp(l)  ....
-c    .........................................
-c
-c
-c   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
-c
-
-      bp(llmp1) =   0.
-
-      DO l = 1, llm
-cc
-ccc    ap(l) = 0.
-ccc    bp(l) = sig(l)
-
-      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
-      ap(l) = pa * ( sig(l) - bp(l) )
-c
-      ENDDO
-
-      bp(1)=1.
-      ap(1)=0.
-
-      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
-
-      write(lunout,*)' BP '
-      write(lunout,*)  bp
-      write(lunout,*)' AP '
-      write(lunout,*)  ap
-
-      write(lunout,*)
-     .'Niveaux de pressions approximatifs aux centres des'
-      write(lunout,*)'couches calcules pour une pression de surface =',
-     .                 preff
-      write(lunout,*)
-     .     'et altitudes equivalentes pour une hauteur d echelle de'
-      write(lunout,*)'8km'
-      DO l = 1, llm
-       dpres(l) = bp(l) - bp(l+1)
-       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
-       write(lunout,*)'PRESNIVS(',l,')=',presnivs(l),'    Z ~ ',
-     .        log(preff/presnivs(l))*8.
-     .  ,'   DZ ~ ',8.*log((ap(l)+bp(l)*preff)/
-     .       max(ap(l+1)+bp(l+1)*preff,1.e-10))
-      ENDDO
-
-      write(lunout,*)' PRESNIVS '
-      write(lunout,*)presnivs
-
-      RETURN
-      END
Index: trunk/libf/dyn3d/disvert.F90
===================================================================
--- trunk/libf/dyn3d/disvert.F90	(revision 66)
+++ trunk/libf/dyn3d/disvert.F90	(revision 66)
@@ -0,0 +1,142 @@
+! $Id: disvert.F90 1480 2011-01-31 21:29:58Z jghattas $
+
+SUBROUTINE disvert(pa, preff, ap, bp, dpres, presnivs, nivsigs, nivsig)
+
+  ! Auteur : P. Le Van
+
+  IMPLICIT NONE
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "iniprint.h"
+  include "logic.h"
+
+  ! s = sigma ** kappa : coordonnee verticale
+  ! dsig(l) : epaisseur de la couche l ds la coord. s
+  ! sig(l) : sigma a l'interface des couches l et l-1
+  ! ds(l) : distance entre les couches l et l-1 en coord.s
+
+  REAL pa, preff
+  REAL ap(llmp1), bp(llmp1), dpres(llm), nivsigs(llm), nivsig(llmp1)
+  REAL presnivs(llm)
+
+  REAL sig(llm+1), dsig(llm)
+  real zk, zkm1, dzk1, dzk2, k0, k1
+
+  INTEGER l
+  REAL dsigmin
+  REAL alpha, beta, deltaz, h
+  INTEGER iostat
+  REAL pi, x
+
+  !-----------------------------------------------------------------------
+
+  pi = 2 * ASIN(1.)
+
+  OPEN(99, file='sigma.def', status='old', form='formatted', iostat=iostat)
+
+  IF (iostat == 0) THEN
+     ! cas 1 on lit les options dans sigma.def:
+     READ(99, *) h ! hauteur d'echelle 8.
+     READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
+     READ(99, *) beta ! facteur d'acroissement en haut 1.3
+     READ(99, *) k0 ! nombre de couches dans la transition surf
+     READ(99, *) k1 ! nombre de couches dans la transition haute
+     CLOSE(99)
+     alpha=deltaz/(llm*h)
+     write(lunout, *)'disvert: h, alpha, k0, k1, beta'
+
+     alpha=deltaz/tanh(1./k0)*2.
+     zkm1=0.
+     sig(1)=1.
+     do l=1, llm
+        sig(l+1)=(cosh(l/k0))**(-alpha*k0/h) &
+             *exp(-alpha/h*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta))
+        zk=-h*log(sig(l+1))
+
+        dzk1=alpha*tanh(l/k0)
+        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
+        write(lunout, *)l, sig(l+1), zk, zk-zkm1, dzk1, dzk2
+        zkm1=zk
+     enddo
+
+     sig(llm+1)=0.
+
+     DO l = 1, llm
+        dsig(l) = sig(l)-sig(l+1)
+     end DO
+  ELSE
+     if (ok_strato) then
+        if (llm==39) then
+           dsigmin=0.3
+        else if (llm==50) then
+           dsigmin=1.
+        else
+           WRITE(LUNOUT,*)'disvert: ATTENTION discretisation z a ajuster'
+           dsigmin=1.
+        endif
+        WRITE(LUNOUT,*) 'disvert: Discretisation verticale DSIGMIN=',dsigmin
+     endif
+
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+
+        IF (ok_strato) THEN
+           dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+                *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+        ELSE
+           dsig(l) = 1.0 + 7.0 * SIN(x)**2
+        ENDIF
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+  ENDIF
+
+  DO l=1, llm
+     nivsigs(l) = REAL(l)
+  ENDDO
+
+  DO l=1, llmp1
+     nivsig(l)= REAL(l)
+  ENDDO
+
+  ! .... Calculs de ap(l) et de bp(l) ....
+  ! ..... pa et preff sont lus sur les fichiers start par lectba .....
+
+  bp(llmp1) = 0.
+
+  DO l = 1, llm
+     bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
+     ap(l) = pa * ( sig(l) - bp(l) )
+  ENDDO
+
+  bp(1)=1.
+  ap(1)=0.
+
+  ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
+
+  write(lunout, *)'disvert: BP '
+  write(lunout, *) bp
+  write(lunout, *)'disvert: AP '
+  write(lunout, *) ap
+
+  write(lunout, *) 'Niveaux de pressions approximatifs aux centres des'
+  write(lunout, *)'couches calcules pour une pression de surface =', preff
+  write(lunout, *) 'et altitudes equivalentes pour une hauteur d echelle de'
+  write(lunout, *)'8km'
+  DO l = 1, llm
+     dpres(l) = bp(l) - bp(l+1)
+     presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+     write(lunout, *)'PRESNIVS(', l, ')=', presnivs(l), ' Z ~ ', &
+          log(preff/presnivs(l))*8. &
+          , ' DZ ~ ', 8.*log((ap(l)+bp(l)*preff)/ &
+          max(ap(l+1)+bp(l+1)*preff, 1.e-10))
+  ENDDO
+
+  write(lunout, *) 'disvert: PRESNIVS '
+  write(lunout, *) presnivs
+
+END SUBROUTINE disvert
Index: trunk/libf/dyn3d/etat0_netcdf.F90
===================================================================
--- trunk/libf/dyn3d/etat0_netcdf.F90	(revision 53)
+++ trunk/libf/dyn3d/etat0_netcdf.F90	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: etat0_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
+! $Id: etat0_netcdf.F90 1486 2011-02-11 12:07:39Z fairhead $
 !
 !-------------------------------------------------------------------------------
@@ -98,5 +98,5 @@
   REAL    :: dummy
   LOGICAL :: ok_newmicro, ok_journe, ok_mensuel, ok_instan, ok_hf
-  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod
+  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod, callstats
   INTEGER :: iflag_radia, flag_aerosol
   REAL    :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut
@@ -130,4 +130,5 @@
 !--- CONSTRUCT A GRID
   CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
+                   callstats,                                           &
                    solarlong0,seuil_inversion,                          &
                    fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
Index: trunk/libf/dyn3d/infotrac.F90
===================================================================
--- trunk/libf/dyn3d/infotrac.F90	(revision 53)
+++ trunk/libf/dyn3d/infotrac.F90	(revision 66)
@@ -177,5 +177,5 @@
           ! Continue to read tracer.def
           DO iq=1,nqtrue
-             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
+             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
           END DO
           CLOSE(90)  
@@ -234,5 +234,5 @@
           ! Continue to read tracer.def
           DO iq=1,nqtrue
-             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
+             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
           END DO
           CLOSE(90)  
@@ -316,7 +316,7 @@
        tname(new_iq)= tnom_0(iq)
        IF (iadv(new_iq)==0) THEN
-          ttext(new_iq)=str1(1:len_trim(str1))
+          ttext(new_iq)=trim(str1)
        ELSE
-          ttext(new_iq)=str1(1:len_trim(str1))//descrq(iadv(new_iq))
+          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
        END IF
 
@@ -381,6 +381,4 @@
     DEALLOCATE(tracnam)
 
-999 FORMAT (i2,1x,i2,1x,a15)
-
   END SUBROUTINE infotrac_init
 
Index: trunk/libf/dyn3d/iniacademic.F
===================================================================
--- trunk/libf/dyn3d/iniacademic.F	(revision 53)
+++ 	(revision )
@@ -1,301 +1,0 @@
-!
-! $Id: iniacademic.F 1446 2010-10-22 09:27:25Z emillour $
-!
-c
-c
-      SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
-
-      USE filtreg_mod
-      USE infotrac, ONLY : nqtot
-      USE control_mod, ONLY: day_step,planet_type
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#else
-! if not using IOIPSL, we still need to use (a local version of) getin
-      USE ioipsl_getincom
-#endif
-      USE Write_Field
- 
-
-c%W%    %G%
-c=======================================================================
-c
-c   Author:    Frederic Hourdin      original: 15/01/93
-c   -------
-c
-c   Subject:
-c   ------
-c
-c   Method:
-c   --------
-c
-c   Interface:
-c   ----------
-c
-c      Input:
-c      ------
-c
-c      Output:
-c      -------
-c
-c=======================================================================
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c   Declararations:
-c   ---------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "academic.h"
-#include "ener.h"
-#include "temps.h"
-#include "iniprint.h"
-#include "logic.h"
-
-c   Arguments:
-c   ----------
-
-      real time_0
-
-c   variables dynamiques
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
-      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
-      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
-      REAL ps(ip1jmp1)                       ! pression  au sol
-      REAL masse(ip1jmp1,llm)                ! masse d'air
-      REAL phis(ip1jmp1)                     ! geopotentiel au sol
-
-c   Local:
-c   ------
-
-      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
-      REAL pks(ip1jmp1)                      ! exner au  sol
-      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
-      REAL phi(ip1jmp1,llm)                  ! geopotentiel
-      REAL ddsin,tetastrat,zsig,tetapv,w_pv  ! variables auxiliaires
-      real tetajl(jjp1,llm)
-      INTEGER i,j,l,lsup,ij
-
-      REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
-      REAL k_f,k_c_a,k_c_s         ! Constantes de rappel
-      LOGICAL ok_geost             ! Initialisation vent geost. ou nul
-      LOGICAL ok_pv                ! Polar Vortex
-      REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex 
-      
-      real zz,ran1
-      integer idum
-
-      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
-
-c-----------------------------------------------------------------------
-! 1. Initializations for Earth-like case
-! --------------------------------------
-c
-
-        print *, 'This is iniacademic' 
-
-        ! initialize planet radius, rotation rate,...
-        call conf_planete
-
-        time_0=0.
-        day_ref=1
-        annee_ref=0
-
-        im         = iim
-        jm         = jjm
-        day_ini    = 1
-        dtvr    = daysec/REAL(day_step)
-        zdtvr=dtvr
-        etot0      = 0.
-        ptot0      = 0.
-        ztot0      = 0.
-        stot0      = 0.
-        ang0       = 0.
-
-        if (llm.eq.1) then
-          ! specific initializations for the shallow water case
-          kappa=1
-        endif
-        
-        CALL iniconst
-        CALL inigeom
-        CALL inifilr
-
-        if (llm.eq.1) then
-          ! initialize fields for the shallow water case, if required
-          if (.not.read_start) then
-            phis(:)=0.
-            q(:,:,:)=0
-            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
-          endif
-        endif
-
-        if (iflag_phys.eq.2) then
-          ! initializations for the academic case
-          
-!         if (planet_type=="earth") then
-
-          ! 1. local parameters
-          ! by convention, winter is in the southern hemisphere
-          ! Geostrophic wind or no wind?
-          ok_geost=.TRUE.
-          CALL getin('ok_geost',ok_geost)
-          ! Constants for Newtonian relaxation and friction
-          k_f=1.                !friction 
-          CALL getin('k_j',k_f)
-          k_f=1./(daysec*k_f)
-          k_c_s=4.  !cooling surface
-          CALL getin('k_c_s',k_c_s)
-          k_c_s=1./(daysec*k_c_s)
-          k_c_a=40. !cooling free atm
-          CALL getin('k_c_a',k_c_a)
-          k_c_a=1./(daysec*k_c_a)
-          ! Constants for Teta equilibrium profile
-          teta0=315.     ! mean Teta (S.H. 315K)
-          CALL getin('teta0',teta0)
-          print *, 'iniacademic - teta0 ', teta0
-          print *, 'iniacademic - rad ', rad
-          ttp=200.       ! Tropopause temperature (S.H. 200K)
-          CALL getin('ttp',ttp)
-          eps=0.         ! Deviation to N-S symmetry(~0-20K)
-          CALL getin('eps',eps)
-          delt_y=60.     ! Merid Temp. Gradient (S.H. 60K)
-          CALL getin('delt_y',delt_y)
-          delt_z=10.     ! Vertical Gradient (S.H. 10K)
-          CALL getin('delt_z',delt_z)
-          ! Polar vortex
-          ok_pv=.false.
-          CALL getin('ok_pv',ok_pv)
-          phi_pv=-50.            ! Latitude of edge of vortex
-          CALL getin('phi_pv',phi_pv)
-          phi_pv=phi_pv*pi/180.
-          dphi_pv=5.             ! Width of the edge
-          CALL getin('dphi_pv',dphi_pv)
-          dphi_pv=dphi_pv*pi/180.
-          gam_pv=4.              ! -dT/dz vortex (in K/km)
-          CALL getin('gam_pv',gam_pv)
-          
-          ! 2. Initialize fields towards which to relax
-          ! Friction
-          knewt_g=k_c_a
-          DO l=1,llm
-           zsig=presnivs(l)/preff
-           knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)
-           kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)
-          ENDDO
-          DO j=1,jjp1
-            clat4((j-1)*iip1+1:j*iip1)=cos(rlatu(j))**4
-          ENDDO
-          
-          ! Potential temperature 
-          DO l=1,llm
-           zsig=presnivs(l)/preff
-           tetastrat=ttp*zsig**(-kappa)
-           tetapv=tetastrat
-           IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
-               tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
-           ENDIF
-           DO j=1,jjp1
-             ! Troposphere
-             ddsin=sin(rlatu(j))
-             tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin
-     &           -delt_z*(1.-ddsin*ddsin)*log(zsig)
-             !! Aymeric -- tests particuliers
-             if (planet_type=="giant") then
-             tetajl(j,l)=teta0+(delt_y*
-     &          ((sin(rlatu(j)*3.14159*eps+0.0001))**2)
-     &          / ((rlatu(j)*3.14159*eps+0.0001)**2))
-     &          -delt_z*log(zsig)
-!!!             ddsin=sin(2.5*3.14159*rlatu(j))
-!!!             tetajl(j,l)=teta0-delt_y*ddsin*ddsin
-!!!!     &           -delt_z*(1.-ddsin*ddsin)*log(zsig)
-             endif
-             ! Profil stratospherique isotherme (+vortex)
-             w_pv=(1.-tanh((rlatu(j)-phi_pv)/dphi_pv))/2.
-             tetastrat=tetastrat*(1.-w_pv)+tetapv*w_pv             
-             tetajl(j,l)=MAX(tetajl(j,l),tetastrat)  
-           ENDDO
-          ENDDO ! of DO l=1,llm
- 
-!          CALL writefield('theta_eq',tetajl)
-
-          do l=1,llm
-            do j=1,jjp1
-              do i=1,iip1
-                 ij=(j-1)*iip1+i
-                 tetarappel(ij,l)=tetajl(j,l)
-              enddo
-            enddo
-          enddo
-          PRINT *, 'iniacademic - check',tetajl(:,int(llm/2)),rlatu(:)
-
-
-!         else
-!          write(lunout,*)"iniacademic: planet types other than earth",
-!     &                   " not implemented (yet)."
-!          stop
-!         endif ! of if (planet_type=="earth")
-
-          ! 3. Initialize fields (if necessary)
-          IF (.NOT. read_start) THEN
-            ! surface pressure
-            ps(:)=preff
-            ! ground geopotential
-            phis(:)=0.
-            
-            CALL pression ( ip1jmp1, ap, bp, ps, p       )
-            CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-            CALL massdair(p,masse)
-
-            ! bulk initialization of temperature
-            teta(:,:)=tetarappel(:,:)
-            
-            ! geopotential
-            CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
-            
-            ! winds
-            if (ok_geost) then
-              call ugeostr(phi,ucov)
-            else
-              ucov(:,:)=0.
-            endif
-            vcov(:,:)=0.
-            
-            ! bulk initialization of tracers
-            if (planet_type=="earth") then
-              ! Earth: first two tracers will be water
-              do i=1,nqtot
-                if (i.eq.1) q(:,:,i)=1.e-10
-                if (i.eq.2) q(:,:,i)=1.e-15
-                if (i.gt.2) q(:,:,i)=0.
-              enddo
-            else
-              q(:,:,:)=0
-            endif ! of if (planet_type=="earth")
-
-            ! add random perturbation to temperature
-            idum  = -1
-            zz = ran1(idum)
-            idum  = 0
-            do l=1,llm
-              do ij=iip2,ip1jm
-                teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
-              enddo
-            enddo
-
-            ! maintain periodicity in longitude
-            do l=1,llm
-              do ij=1,ip1jmp1,iip1
-                teta(ij+iim,l)=teta(ij,l)
-              enddo
-            enddo
-
-          ENDIF ! of IF (.NOT. read_start)
-        endif ! of if (iflag_phys.eq.2)
-        
-      END
-c-----------------------------------------------------------------------
Index: trunk/libf/dyn3d/iniacademic.F90
===================================================================
--- trunk/libf/dyn3d/iniacademic.F90	(revision 66)
+++ trunk/libf/dyn3d/iniacademic.F90	(revision 66)
@@ -0,0 +1,268 @@
+!
+! $Id: iniacademic.F90 1474 2011-01-14 11:04:45Z lguez $
+!
+SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
+
+  USE filtreg_mod
+  USE infotrac, ONLY : nqtot
+  USE control_mod, ONLY: day_step,planet_type
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  USE ioipsl_getincom
+#endif
+  USE Write_Field
+
+  !   Author:    Frederic Hourdin      original: 15/01/93
+  ! The forcing defined here is from Held and Suarez, 1994, Bulletin
+  ! of the American Meteorological Society, 75, 1825.
+
+  IMPLICIT NONE
+
+  !   Declararations:
+  !   ---------------
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comvert.h"
+  include "comconst.h"
+  include "comgeom.h"
+  include "academic.h"
+  include "ener.h"
+  include "temps.h"
+  include "iniprint.h"
+  include "logic.h"
+
+  !   Arguments:
+  !   ----------
+
+  real time_0
+
+  !   variables dynamiques
+  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+  REAL teta(ip1jmp1,llm)                 ! temperature potentielle
+  REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
+  REAL ps(ip1jmp1)                       ! pression  au sol
+  REAL masse(ip1jmp1,llm)                ! masse d'air
+  REAL phis(ip1jmp1)                     ! geopotentiel au sol
+
+  !   Local:
+  !   ------
+
+  REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
+  REAL pks(ip1jmp1)                      ! exner au  sol
+  REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
+  REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
+  REAL phi(ip1jmp1,llm)                  ! geopotentiel
+  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
+  real tetastrat ! potential temperature in the stratosphere, in K
+  real tetajl(jjp1,llm)
+  INTEGER i,j,l,lsup,ij
+
+  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
+  REAL k_f,k_c_a,k_c_s         ! Constantes de rappel
+  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
+  LOGICAL ok_pv                ! Polar Vortex
+  REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex 
+
+  real zz,ran1
+  integer idum
+
+  REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
+
+  !-----------------------------------------------------------------------
+  ! 1. Initializations for Earth-like case
+  ! --------------------------------------
+  !
+  
+  write(lunout,*) 'Iniacademic'
+  
+  ! initialize planet radius, rotation rate,...
+  call conf_planete
+
+  time_0=0.
+  day_ref=1
+  annee_ref=0
+
+  im         = iim
+  jm         = jjm
+  day_ini    = 1
+  dtvr    = daysec/REAL(day_step)
+  zdtvr=dtvr
+  etot0      = 0.
+  ptot0      = 0.
+  ztot0      = 0.
+  stot0      = 0.
+  ang0       = 0.
+
+  if (llm == 1) then
+     ! specific initializations for the shallow water case
+     kappa=1
+  endif
+
+  CALL iniconst
+  CALL inigeom
+  CALL inifilr
+
+  if (llm == 1) then
+     ! initialize fields for the shallow water case, if required
+     if (.not.read_start) then
+        phis(:)=0.
+        q(:,:,:)=0
+        CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
+     endif
+  endif
+
+  academic_case: if (iflag_phys == 2) then
+     ! initializations
+
+     ! 1. local parameters
+     ! by convention, winter is in the southern hemisphere
+     ! Geostrophic wind or no wind?
+     ok_geost=.TRUE.
+     CALL getin('ok_geost',ok_geost)
+     ! Constants for Newtonian relaxation and friction
+     k_f=1.                !friction 
+     CALL getin('k_j',k_f)
+     k_f=1./(daysec*k_f)
+     k_c_s=4.  !cooling surface
+     CALL getin('k_c_s',k_c_s)
+     k_c_s=1./(daysec*k_c_s)
+     k_c_a=40. !cooling free atm
+     CALL getin('k_c_a',k_c_a)
+     k_c_a=1./(daysec*k_c_a)
+     ! Constants for Teta equilibrium profile
+     teta0=315.     ! mean Teta (S.H. 315K)
+     CALL getin('teta0',teta0)
+     write(lunout,*) 'Iniacademic - teta0 ',teta0
+     write(lunout,*) 'Iniacademic - rad ',rad
+     ttp=200.       ! Tropopause temperature (S.H. 200K)
+     CALL getin('ttp',ttp)
+     eps=0.         ! Deviation to N-S symmetry(~0-20K)
+     CALL getin('eps',eps)
+     delt_y=60.     ! Merid Temp. Gradient (S.H. 60K)
+     CALL getin('delt_y',delt_y)
+     delt_z=10.     ! Vertical Gradient (S.H. 10K)
+     CALL getin('delt_z',delt_z)
+     ! Polar vortex
+     ok_pv=.false.
+     CALL getin('ok_pv',ok_pv)
+     phi_pv=-50.            ! Latitude of edge of vortex
+     CALL getin('phi_pv',phi_pv)
+     phi_pv=phi_pv*pi/180.
+     dphi_pv=5.             ! Width of the edge
+     CALL getin('dphi_pv',dphi_pv)
+     dphi_pv=dphi_pv*pi/180.
+     gam_pv=4.              ! -dT/dz vortex (in K/km)
+     CALL getin('gam_pv',gam_pv)
+
+     ! 2. Initialize fields towards which to relax
+     ! Friction
+     knewt_g=k_c_a
+     DO l=1,llm
+        zsig=presnivs(l)/preff
+        knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)
+        kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)
+     ENDDO
+     DO j=1,jjp1
+        clat4((j-1)*iip1+1:j*iip1)=cos(rlatu(j))**4
+     ENDDO
+
+     ! Potential temperature 
+     DO l=1,llm
+        zsig=presnivs(l)/preff
+        tetastrat=ttp*zsig**(-kappa)
+        tetapv=tetastrat
+        IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
+           tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
+        ENDIF
+        DO j=1,jjp1
+           ! Troposphere
+           ddsin=sin(rlatu(j))
+           tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
+                -delt_z*(1.-ddsin*ddsin)*log(zsig)
+           !! Aymeric -- tests particuliers
+           if (planet_type=="giant") then
+             tetajl(j,l)=teta0+(delt_y*                   &
+                ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
+                / ((rlatu(j)*3.14159*eps+0.0001)**2))     &
+                -delt_z*log(zsig)
+           endif
+           ! Profil stratospherique isotherme (+vortex)
+           w_pv=(1.-tanh((rlatu(j)-phi_pv)/dphi_pv))/2.
+           tetastrat=tetastrat*(1.-w_pv)+tetapv*w_pv             
+           tetajl(j,l)=MAX(tetajl(j,l),tetastrat)  
+        ENDDO
+     ENDDO
+
+     !          CALL writefield('theta_eq',tetajl)
+
+     do l=1,llm
+        do j=1,jjp1
+           do i=1,iip1
+              ij=(j-1)*iip1+i
+              tetarappel(ij,l)=tetajl(j,l)
+           enddo
+        enddo
+     enddo
+     write(lunout,*) 'Iniacademic - check',tetajl(:,int(llm/2)),rlatu(:)
+
+     ! 3. Initialize fields (if necessary)
+     IF (.NOT. read_start) THEN
+        ! surface pressure
+        ps(:)=preff
+        ! ground geopotential
+        phis(:)=0.
+
+        CALL pression ( ip1jmp1, ap, bp, ps, p       )
+        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        CALL massdair(p,masse)
+
+        ! bulk initialization of temperature
+        teta(:,:)=tetarappel(:,:)
+
+        ! geopotential
+        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
+
+        ! winds
+        if (ok_geost) then
+           call ugeostr(phi,ucov)
+        else
+           ucov(:,:)=0.
+        endif
+        vcov(:,:)=0.
+
+        ! bulk initialization of tracers
+        if (planet_type=="earth") then
+           ! Earth: first two tracers will be water
+           do i=1,nqtot
+              if (i == 1) q(:,:,i)=1.e-10
+              if (i == 2) q(:,:,i)=1.e-15
+              if (i.gt.2) q(:,:,i)=0.
+           enddo
+        else
+           q(:,:,:)=0
+        endif ! of if (planet_type=="earth")
+
+        ! add random perturbation to temperature
+        idum  = -1
+        zz = ran1(idum)
+        idum  = 0
+        do l=1,llm
+           do ij=iip2,ip1jm
+              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
+           enddo
+        enddo
+
+        ! maintain periodicity in longitude
+        do l=1,llm
+           do ij=1,ip1jmp1,iip1
+              teta(ij+iim,l)=teta(ij,l)
+           enddo
+        enddo
+
+     ENDIF ! of IF (.NOT. read_start)
+  endif academic_case
+
+END SUBROUTINE iniacademic
Index: trunk/libf/dyn3d/ugeostr.F
===================================================================
--- trunk/libf/dyn3d/ugeostr.F	(revision 53)
+++ 	(revision )
@@ -1,69 +1,0 @@
-!
-! $Id: ugeostr.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      subroutine ugeostr(phi,ucov)
-
-
-c  Calcul du vent covariant geostrophique a partir du champs de
-c  geopotentiel en supposant que le vent au sol est nul.
-
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom2.h"
-
-      real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
-      real um(jjm,llm),fact,u(iip1,jjm,llm)
-      integer i,j,l
-
-      real zlat
-
-      um(:,:)=0 ! initialize um()
-
-      DO j=1,jjm
-
-         if (abs(sin(rlatv(j))).lt.1.e-4) then
-             zlat=1.e-4
-         else
-             zlat=rlatv(j)
-         endif
-         fact=cos(zlat)
-         fact=fact*fact
-         fact=fact*fact
-         fact=fact*fact
-         fact=(1.-fact)/
-     s    (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
-         fact=-fact/rad
-         DO l=1,llm
-            DO i=1,iim
-               u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
-               um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
-            ENDDO
-         ENDDO
-      ENDDO
-      call dump2d(jjm,llm,um,'Vent-u geostrophique')
-
-c
-c-----------------------------------------------------------------------
-c   calcul des champ de vent:
-c   -------------------------
-
-      DO 301 l=1,llm
-         DO 302 i=1,iip1
-            ucov(i,1,l)=0.
-            ucov(i,jjp1,l)=0.
-302      CONTINUE
-         DO 304 j=2,jjm
-            DO 305 i=1,iim
-               ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
-305         CONTINUE
-            ucov(iip1,j,l)=ucov(1,j,l)
-304      CONTINUE
-301   CONTINUE
-
-      print*,301
-
-      return
-      end
Index: trunk/libf/dyn3d/ugeostr.F90
===================================================================
--- trunk/libf/dyn3d/ugeostr.F90	(revision 66)
+++ trunk/libf/dyn3d/ugeostr.F90	(revision 66)
@@ -0,0 +1,68 @@
+!
+! $Id: ugeostr.F90 1474 2011-01-14 11:04:45Z lguez $
+!
+subroutine ugeostr(phi,ucov)
+
+  ! Calcul du vent covariant geostrophique a partir du champ de
+  ! geopotentiel.
+  ! We actually compute: (1 - cos^8 \phi) u_g
+  ! to have a wind going smoothly to 0 at the equator.
+  ! We assume that the surface pressure is uniform so that model
+  ! levels are pressure levels.
+
+  implicit none
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "comgeom2.h"
+
+  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+  real um(jjm,llm),fact,u(iip1,jjm,llm)
+  integer i,j,l
+
+  real zlat
+
+  um(:,:)=0 ! initialize um()
+
+  DO j=1,jjm
+
+     if (abs(sin(rlatv(j))).lt.1.e-4) then
+        zlat=1.e-4
+     else
+        zlat=rlatv(j)
+     endif
+     fact=cos(zlat)
+     fact=fact*fact
+     fact=fact*fact
+     fact=fact*fact
+     fact=(1.-fact)/ &
+          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
+     fact=-fact/rad
+     DO l=1,llm
+        DO i=1,iim
+           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
+           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
+        ENDDO
+     ENDDO
+  ENDDO
+  call dump2d(jjm,llm,um,'Vent-u geostrophique')
+
+  !   calcul des champ de vent:
+
+  DO l=1,llm
+     DO i=1,iip1
+        ucov(i,1,l)=0.
+        ucov(i,jjp1,l)=0.
+     end DO
+     DO  j=2,jjm
+        DO  i=1,iim
+           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
+        end DO
+        ucov(iip1,j,l)=ucov(1,j,l)
+     end DO
+  end DO
+
+  print *, 301
+
+end subroutine ugeostr
Index: trunk/libf/dyn3dpar/abort_gcm.F
===================================================================
--- trunk/libf/dyn3dpar/abort_gcm.F	(revision 53)
+++ trunk/libf/dyn3dpar/abort_gcm.F	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: abort_gcm.F 1425 2010-09-02 13:45:23Z lguez $
+! $Id: abort_gcm.F 1475 2011-01-21 14:41:03Z emillour $
 !
 c
@@ -45,5 +45,4 @@
       if (ierr .eq. 0) then
         write(lunout,*) 'Everything is cool'
-        stop
       else
         write(lunout,*) 'Houston, we have a problem ', ierr
Index: trunk/libf/dyn3dpar/ce0l.F90
===================================================================
--- trunk/libf/dyn3dpar/ce0l.F90	(revision 53)
+++ trunk/libf/dyn3dpar/ce0l.F90	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: ce0l.F90 1425 2010-09-02 13:45:23Z lguez $
+! $Id: ce0l.F90 1482 2011-02-09 15:03:09Z jghattas $
 !
 !-------------------------------------------------------------------------------
@@ -22,4 +22,5 @@
   USE mod_const_mpi
   USE infotrac
+  USE parallel, ONLY: finalize_parallel
 
 #ifdef CPP_IOIPSL
@@ -55,5 +56,5 @@
        CALL abort_gcm('ce0l','In parallel mode,                         &
  &                 ce0l must be called only                             &
- &                 for 1 process and 1 task')
+ &                 for 1 process and 1 task',1)
   ENDIF
 
@@ -101,4 +102,8 @@
   END IF
 
+!$OMP MASTER
+  CALL finalize_parallel
+!$OMP END MASTER
+
 #endif
 ! of #ifndef CPP_EARTH #else
Index: trunk/libf/dyn3dpar/disvert.F
===================================================================
--- trunk/libf/dyn3dpar/disvert.F	(revision 53)
+++ 	(revision )
@@ -1,194 +1,0 @@
-!
-! $Id: disvert.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
-
-c    Auteur :  P. Le Van .
-c
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
-#include "logic.h"
-c
-c=======================================================================
-c
-c
-c    s = sigma ** kappa   :  coordonnee  verticale
-c    dsig(l)            : epaisseur de la couche l ds la coord.  s
-c    sig(l)             : sigma a l'interface des couches l et l-1
-c    ds(l)              : distance entre les couches l et l-1 en coord.s
-c
-c=======================================================================
-c
-      REAL pa,preff
-      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
-      REAL presnivs(llm)
-c
-c   declarations:
-c   -------------
-c
-      REAL sig(llm+1),dsig(llm)
-       real zzz(1:llm+1)
-       real dzz(1:llm)
-      real zk,zkm1,dzk1,dzk2,k0,k1
-c
-      INTEGER l
-      REAL snorm,dsigmin
-      REAL alpha,beta,gama,delta,deltaz,h
-      INTEGER np,ierr
-      REAL pi,x
-
-      REAL SSUM
-c
-c-----------------------------------------------------------------------
-c
-      pi=2.*ASIN(1.)
-
-      OPEN(99,file='sigma.def',status='old',form='formatted',
-     s   iostat=ierr)
-
-c-----------------------------------------------------------------------
-c   cas 1 on lit les options dans sigma.def:
-c   ----------------------------------------
-
-      IF (ierr.eq.0) THEN
-
-      READ(99,*) h           ! hauteur d'echelle 8.
-      READ(99,*) deltaz      ! epaiseur de la premiere couche 0.04
-      READ(99,*) beta        ! facteur d'acroissement en haut 1.3
-      READ(99,*) k0          ! nombre de couches dans la transition surf
-      READ(99,*) k1          ! nombre de couches dans la transition haute
-      CLOSE(99)
-      alpha=deltaz/(llm*h)
-      write(lunout,*)'h,alpha,k0,k1,beta'
-
-c     read(*,*) h,deltaz,beta,k0,k1 ! 8 0.04 4 20 1.2
-
-      alpha=deltaz/tanh(1./k0)*2.
-      zkm1=0.
-      sig(1)=1.
-      do l=1,llm
-        sig(l+1)=(cosh(l/k0))**(-alpha*k0/h)
-     + *exp(-alpha/h*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta))
-        zk=-h*log(sig(l+1))
-
-        dzk1=alpha*tanh(l/k0)
-        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
-        write(lunout,*)l,sig(l+1),zk,zk-zkm1,dzk1,dzk2
-        zkm1=zk
-      enddo
-
-      sig(llm+1)=0.
-
-c
-       DO 2  l = 1, llm
-       dsig(l) = sig(l)-sig(l+1)
-   2   CONTINUE
-c
-
-      ELSE
-c-----------------------------------------------------------------------
-c   cas 2 ancienne discretisation (LMD5...):
-c   ----------------------------------------
-
-      WRITE(LUNOUT,*)'WARNING!!! Ancienne discretisation verticale'
-
-      if (ok_strato) then
-         if (llm==39) then
-            dsigmin=0.3
-         else if (llm==50) then
-            dsigmin=1.
-         else
-            WRITE(LUNOUT,*) 'ATTENTION discretisation z a ajuster'
-            dsigmin=1.
-         endif
-         WRITE(LUNOUT,*) 'Discretisation verticale DSIGMIN=',dsigmin
-      endif
-
-      h=7.
-      snorm  = 0.
-      DO l = 1, llm
-         x = 2.*asin(1.) * (REAL(l)-0.5) / REAL(llm+1)
-
-         IF (ok_strato) THEN
-           dsig(l) =(dsigmin + 7.0 * SIN(x)**2)
-     &            *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2        
-         ELSE
-           dsig(l) = 1.0 + 7.0 * SIN(x)**2
-         ENDIF
-
-         snorm = snorm + dsig(l)
-      ENDDO
-      snorm = 1./snorm
-      DO l = 1, llm
-         dsig(l) = dsig(l)*snorm
-      ENDDO
-      sig(llm+1) = 0.
-      DO l = llm, 1, -1
-         sig(l) = sig(l+1) + dsig(l)
-      ENDDO
-
-      ENDIF
-
-
-      DO l=1,llm
-        nivsigs(l) = REAL(l)
-      ENDDO
-
-      DO l=1,llmp1
-        nivsig(l)= REAL(l)
-      ENDDO
-
-c
-c    ....  Calculs  de ap(l) et de bp(l)  ....
-c    .........................................
-c
-c
-c   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
-c
-
-      bp(llmp1) =   0.
-
-      DO l = 1, llm
-cc
-ccc    ap(l) = 0.
-ccc    bp(l) = sig(l)
-
-      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
-      ap(l) = pa * ( sig(l) - bp(l) )
-c
-      ENDDO
-
-      bp(1)=1.
-      ap(1)=0.
-
-      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
-
-      write(lunout,*)' BP '
-      write(lunout,*)  bp
-      write(lunout,*)' AP '
-      write(lunout,*)  ap
-
-      write(lunout,*)
-     .'Niveaux de pressions approximatifs aux centres des'
-      write(lunout,*)'couches calcules pour une pression de surface =',
-     .                 preff
-      write(lunout,*)
-     .     'et altitudes equivalentes pour une hauteur d echelle de'
-      write(lunout,*)'8km'
-      DO l = 1, llm
-       dpres(l) = bp(l) - bp(l+1)
-       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
-       write(lunout,*)'PRESNIVS(',l,')=',presnivs(l),'    Z ~ ',
-     .        log(preff/presnivs(l))*8.
-     .  ,'   DZ ~ ',8.*log((ap(l)+bp(l)*preff)/
-     .       max(ap(l+1)+bp(l+1)*preff,1.e-10))
-      ENDDO
-
-      write(lunout,*)' PRESNIVS '
-      write(lunout,*)presnivs
-
-      RETURN
-      END
Index: trunk/libf/dyn3dpar/disvert.F90
===================================================================
--- trunk/libf/dyn3dpar/disvert.F90	(revision 66)
+++ trunk/libf/dyn3dpar/disvert.F90	(revision 66)
@@ -0,0 +1,142 @@
+! $Id: disvert.F90 1480 2011-01-31 21:29:58Z jghattas $
+
+SUBROUTINE disvert(pa, preff, ap, bp, dpres, presnivs, nivsigs, nivsig)
+
+  ! Auteur : P. Le Van
+
+  IMPLICIT NONE
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "iniprint.h"
+  include "logic.h"
+
+  ! s = sigma ** kappa : coordonnee verticale
+  ! dsig(l) : epaisseur de la couche l ds la coord. s
+  ! sig(l) : sigma a l'interface des couches l et l-1
+  ! ds(l) : distance entre les couches l et l-1 en coord.s
+
+  REAL pa, preff
+  REAL ap(llmp1), bp(llmp1), dpres(llm), nivsigs(llm), nivsig(llmp1)
+  REAL presnivs(llm)
+
+  REAL sig(llm+1), dsig(llm)
+  real zk, zkm1, dzk1, dzk2, k0, k1
+
+  INTEGER l
+  REAL dsigmin
+  REAL alpha, beta, deltaz, h
+  INTEGER iostat
+  REAL pi, x
+
+  !-----------------------------------------------------------------------
+
+  pi = 2 * ASIN(1.)
+
+  OPEN(99, file='sigma.def', status='old', form='formatted', iostat=iostat)
+
+  IF (iostat == 0) THEN
+     ! cas 1 on lit les options dans sigma.def:
+     READ(99, *) h ! hauteur d'echelle 8.
+     READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
+     READ(99, *) beta ! facteur d'acroissement en haut 1.3
+     READ(99, *) k0 ! nombre de couches dans la transition surf
+     READ(99, *) k1 ! nombre de couches dans la transition haute
+     CLOSE(99)
+     alpha=deltaz/(llm*h)
+     write(lunout, *)'disvert: h, alpha, k0, k1, beta'
+
+     alpha=deltaz/tanh(1./k0)*2.
+     zkm1=0.
+     sig(1)=1.
+     do l=1, llm
+        sig(l+1)=(cosh(l/k0))**(-alpha*k0/h) &
+             *exp(-alpha/h*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta))
+        zk=-h*log(sig(l+1))
+
+        dzk1=alpha*tanh(l/k0)
+        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
+        write(lunout, *)l, sig(l+1), zk, zk-zkm1, dzk1, dzk2
+        zkm1=zk
+     enddo
+
+     sig(llm+1)=0.
+
+     DO l = 1, llm
+        dsig(l) = sig(l)-sig(l+1)
+     end DO
+  ELSE
+     if (ok_strato) then
+        if (llm==39) then
+           dsigmin=0.3
+        else if (llm==50) then
+           dsigmin=1.
+        else
+           WRITE(LUNOUT,*)'disvert: ATTENTION discretisation z a ajuster'
+           dsigmin=1.
+        endif
+        WRITE(LUNOUT,*) 'disvert: Discretisation verticale DSIGMIN=',dsigmin
+     endif
+
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+
+        IF (ok_strato) THEN
+           dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+                *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+        ELSE
+           dsig(l) = 1.0 + 7.0 * SIN(x)**2
+        ENDIF
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+  ENDIF
+
+  DO l=1, llm
+     nivsigs(l) = REAL(l)
+  ENDDO
+
+  DO l=1, llmp1
+     nivsig(l)= REAL(l)
+  ENDDO
+
+  ! .... Calculs de ap(l) et de bp(l) ....
+  ! ..... pa et preff sont lus sur les fichiers start par lectba .....
+
+  bp(llmp1) = 0.
+
+  DO l = 1, llm
+     bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
+     ap(l) = pa * ( sig(l) - bp(l) )
+  ENDDO
+
+  bp(1)=1.
+  ap(1)=0.
+
+  ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
+
+  write(lunout, *)'disvert: BP '
+  write(lunout, *) bp
+  write(lunout, *)'disvert: AP '
+  write(lunout, *) ap
+
+  write(lunout, *) 'Niveaux de pressions approximatifs aux centres des'
+  write(lunout, *)'couches calcules pour une pression de surface =', preff
+  write(lunout, *) 'et altitudes equivalentes pour une hauteur d echelle de'
+  write(lunout, *)'8km'
+  DO l = 1, llm
+     dpres(l) = bp(l) - bp(l+1)
+     presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+     write(lunout, *)'PRESNIVS(', l, ')=', presnivs(l), ' Z ~ ', &
+          log(preff/presnivs(l))*8. &
+          , ' DZ ~ ', 8.*log((ap(l)+bp(l)*preff)/ &
+          max(ap(l+1)+bp(l+1)*preff, 1.e-10))
+  ENDDO
+
+  write(lunout, *) 'disvert: PRESNIVS '
+  write(lunout, *) presnivs
+
+END SUBROUTINE disvert
Index: trunk/libf/dyn3dpar/etat0_netcdf.F90
===================================================================
--- trunk/libf/dyn3dpar/etat0_netcdf.F90	(revision 53)
+++ trunk/libf/dyn3dpar/etat0_netcdf.F90	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: etat0_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
+! $Id: etat0_netcdf.F90 1486 2011-02-11 12:07:39Z fairhead $
 !
 !-------------------------------------------------------------------------------
@@ -98,5 +98,5 @@
   REAL    :: dummy
   LOGICAL :: ok_newmicro, ok_journe, ok_mensuel, ok_instan, ok_hf
-  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod
+  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod, callstats
   INTEGER :: iflag_radia, flag_aerosol
   REAL    :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut
@@ -130,4 +130,5 @@
 !--- CONSTRUCT A GRID
   CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
+                   callstats,                                           &
                    solarlong0,seuil_inversion,                          &
                    fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
Index: trunk/libf/dyn3dpar/fluxstokenc_p.F
===================================================================
--- trunk/libf/dyn3dpar/fluxstokenc_p.F	(revision 53)
+++ trunk/libf/dyn3dpar/fluxstokenc_p.F	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: fluxstokenc_p.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id: fluxstokenc_p.F 1454 2010-11-18 12:01:24Z fairhead $
 !
       SUBROUTINE fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis,
@@ -57,5 +57,5 @@
 
 c AC initialisations
-cym      pbarug(:,:)   = 0.
+      pbarug(:,:)   = 0.
 cym      pbarvg(:,:,:) = 0.
 cym      wg(:,:)       = 0.
Index: trunk/libf/dyn3dpar/friction_p.F
===================================================================
--- trunk/libf/dyn3dpar/friction_p.F	(revision 53)
+++ trunk/libf/dyn3dpar/friction_p.F	(revision 66)
@@ -34,6 +34,6 @@
 
 ! arguments:
-      REAL,INTENT(out) :: ucov( iip1,jjp1,llm )
-      REAL,INTENT(out) :: vcov( iip1,jjm,llm )
+      REAL,INTENT(inout) :: ucov( iip1,jjp1,llm )
+      REAL,INTENT(inout) :: vcov( iip1,jjm,llm )
       REAL,INTENT(in) :: pdt ! time step
 
Index: trunk/libf/dyn3dpar/infotrac.F90
===================================================================
--- trunk/libf/dyn3dpar/infotrac.F90	(revision 53)
+++ trunk/libf/dyn3dpar/infotrac.F90	(revision 66)
@@ -177,5 +177,5 @@
           ! Continue to read tracer.def
           DO iq=1,nqtrue
-             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
+             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
           END DO
           CLOSE(90)  
@@ -234,5 +234,5 @@
           ! Continue to read tracer.def
           DO iq=1,nqtrue
-             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
+             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
           END DO
           CLOSE(90)  
@@ -316,7 +316,7 @@
        tname(new_iq)= tnom_0(iq)
        IF (iadv(new_iq)==0) THEN
-          ttext(new_iq)=str1(1:len_trim(str1))
+          ttext(new_iq)=trim(str1)
        ELSE
-          ttext(new_iq)=str1(1:len_trim(str1))//descrq(iadv(new_iq))
+          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
        END IF
 
@@ -381,6 +381,4 @@
     DEALLOCATE(tracnam)
 
-999 FORMAT (i2,1x,i2,1x,a15)
-
   END SUBROUTINE infotrac_init
 
Index: trunk/libf/dyn3dpar/iniacademic.F
===================================================================
--- trunk/libf/dyn3dpar/iniacademic.F	(revision 53)
+++ 	(revision )
@@ -1,301 +1,0 @@
-!
-! $Id: iniacademic.F 1446 2010-10-22 09:27:25Z emillour $
-!
-c
-c
-      SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
-
-      USE filtreg_mod
-      USE infotrac, ONLY : nqtot
-      USE control_mod, ONLY: day_step,planet_type
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#else
-! if not using IOIPSL, we still need to use (a local version of) getin
-      USE ioipsl_getincom
-#endif
-      USE Write_Field
- 
-
-c%W%    %G%
-c=======================================================================
-c
-c   Author:    Frederic Hourdin      original: 15/01/93
-c   -------
-c
-c   Subject:
-c   ------
-c
-c   Method:
-c   --------
-c
-c   Interface:
-c   ----------
-c
-c      Input:
-c      ------
-c
-c      Output:
-c      -------
-c
-c=======================================================================
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c   Declararations:
-c   ---------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "academic.h"
-#include "ener.h"
-#include "temps.h"
-#include "iniprint.h"
-#include "logic.h"
-
-c   Arguments:
-c   ----------
-
-      real time_0
-
-c   variables dynamiques
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
-      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
-      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
-      REAL ps(ip1jmp1)                       ! pression  au sol
-      REAL masse(ip1jmp1,llm)                ! masse d'air
-      REAL phis(ip1jmp1)                     ! geopotentiel au sol
-
-c   Local:
-c   ------
-
-      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
-      REAL pks(ip1jmp1)                      ! exner au  sol
-      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
-      REAL phi(ip1jmp1,llm)                  ! geopotentiel
-      REAL ddsin,tetastrat,zsig,tetapv,w_pv  ! variables auxiliaires
-      real tetajl(jjp1,llm)
-      INTEGER i,j,l,lsup,ij
-
-      REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
-      REAL k_f,k_c_a,k_c_s         ! Constantes de rappel
-      LOGICAL ok_geost             ! Initialisation vent geost. ou nul
-      LOGICAL ok_pv                ! Polar Vortex
-      REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex 
-      
-      real zz,ran1
-      integer idum
-
-      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
-
-c-----------------------------------------------------------------------
-! 1. Initializations for Earth-like case
-! --------------------------------------
-c
-
-        print *, 'This is iniacademic' 
-
-        ! initialize planet radius, rotation rate,...
-        call conf_planete
-
-        time_0=0.
-        day_ref=1
-        annee_ref=0
-
-        im         = iim
-        jm         = jjm
-        day_ini    = 1
-        dtvr    = daysec/REAL(day_step)
-        zdtvr=dtvr
-        etot0      = 0.
-        ptot0      = 0.
-        ztot0      = 0.
-        stot0      = 0.
-        ang0       = 0.
-
-        if (llm.eq.1) then
-          ! specific initializations for the shallow water case
-          kappa=1
-        endif
-        
-        CALL iniconst
-        CALL inigeom
-        CALL inifilr
-
-        if (llm.eq.1) then
-          ! initialize fields for the shallow water case, if required
-          if (.not.read_start) then
-            phis(:)=0.
-            q(:,:,:)=0
-            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
-          endif
-        endif
-
-        if (iflag_phys.eq.2) then
-          ! initializations for the academic case
-          
-!         if (planet_type=="earth") then
-
-          ! 1. local parameters
-          ! by convention, winter is in the southern hemisphere
-          ! Geostrophic wind or no wind?
-          ok_geost=.TRUE.
-          CALL getin('ok_geost',ok_geost)
-          ! Constants for Newtonian relaxation and friction
-          k_f=1.                !friction 
-          CALL getin('k_j',k_f)
-          k_f=1./(daysec*k_f)
-          k_c_s=4.  !cooling surface
-          CALL getin('k_c_s',k_c_s)
-          k_c_s=1./(daysec*k_c_s)
-          k_c_a=40. !cooling free atm
-          CALL getin('k_c_a',k_c_a)
-          k_c_a=1./(daysec*k_c_a)
-          ! Constants for Teta equilibrium profile
-          teta0=315.     ! mean Teta (S.H. 315K)
-          CALL getin('teta0',teta0)
-          print *, 'iniacademic - teta0 ', teta0
-          print *, 'iniacademic - rad ', rad
-          ttp=200.       ! Tropopause temperature (S.H. 200K)
-          CALL getin('ttp',ttp)
-          eps=0.         ! Deviation to N-S symmetry(~0-20K)
-          CALL getin('eps',eps)
-          delt_y=60.     ! Merid Temp. Gradient (S.H. 60K)
-          CALL getin('delt_y',delt_y)
-          delt_z=10.     ! Vertical Gradient (S.H. 10K)
-          CALL getin('delt_z',delt_z)
-          ! Polar vortex
-          ok_pv=.false.
-          CALL getin('ok_pv',ok_pv)
-          phi_pv=-50.            ! Latitude of edge of vortex
-          CALL getin('phi_pv',phi_pv)
-          phi_pv=phi_pv*pi/180.
-          dphi_pv=5.             ! Width of the edge
-          CALL getin('dphi_pv',dphi_pv)
-          dphi_pv=dphi_pv*pi/180.
-          gam_pv=4.              ! -dT/dz vortex (in K/km)
-          CALL getin('gam_pv',gam_pv)
-          
-          ! 2. Initialize fields towards which to relax
-          ! Friction
-          knewt_g=k_c_a
-          DO l=1,llm
-           zsig=presnivs(l)/preff
-           knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)
-           kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)
-          ENDDO
-          DO j=1,jjp1
-            clat4((j-1)*iip1+1:j*iip1)=cos(rlatu(j))**4
-          ENDDO
-          
-          ! Potential temperature 
-          DO l=1,llm
-           zsig=presnivs(l)/preff
-           tetastrat=ttp*zsig**(-kappa)
-           tetapv=tetastrat
-           IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
-               tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
-           ENDIF
-           DO j=1,jjp1
-             ! Troposphere
-             ddsin=sin(rlatu(j))
-             tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin
-     &           -delt_z*(1.-ddsin*ddsin)*log(zsig)
-             !! Aymeric -- tests particuliers
-             if (planet_type=="giant") then
-             tetajl(j,l)=teta0+(delt_y*
-     &          ((sin(rlatu(j)*3.14159*eps+0.0001))**2)
-     &          / ((rlatu(j)*3.14159*eps+0.0001)**2))
-     &          -delt_z*log(zsig)
-!!!             ddsin=sin(2.5*3.14159*rlatu(j))
-!!!             tetajl(j,l)=teta0-delt_y*ddsin*ddsin
-!!!!     &           -delt_z*(1.-ddsin*ddsin)*log(zsig)
-             endif
-             ! Profil stratospherique isotherme (+vortex)
-             w_pv=(1.-tanh((rlatu(j)-phi_pv)/dphi_pv))/2.
-             tetastrat=tetastrat*(1.-w_pv)+tetapv*w_pv             
-             tetajl(j,l)=MAX(tetajl(j,l),tetastrat)  
-           ENDDO
-          ENDDO ! of DO l=1,llm
- 
-!          CALL writefield('theta_eq',tetajl)
-
-          do l=1,llm
-            do j=1,jjp1
-              do i=1,iip1
-                 ij=(j-1)*iip1+i
-                 tetarappel(ij,l)=tetajl(j,l)
-              enddo
-            enddo
-          enddo
-          PRINT *, 'iniacademic - check',tetajl(:,int(llm/2)),rlatu(:)
-
-
-!         else
-!          write(lunout,*)"iniacademic: planet types other than earth",
-!     &                   " not implemented (yet)."
-!          stop
-!         endif ! of if (planet_type=="earth")
-
-          ! 3. Initialize fields (if necessary)
-          IF (.NOT. read_start) THEN
-            ! surface pressure
-            ps(:)=preff
-            ! ground geopotential
-            phis(:)=0.
-            
-            CALL pression ( ip1jmp1, ap, bp, ps, p       )
-            CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-            CALL massdair(p,masse)
-
-            ! bulk initialization of temperature
-            teta(:,:)=tetarappel(:,:)
-            
-            ! geopotential
-            CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
-            
-            ! winds
-            if (ok_geost) then
-              call ugeostr(phi,ucov)
-            else
-              ucov(:,:)=0.
-            endif
-            vcov(:,:)=0.
-            
-            ! bulk initialization of tracers
-            if (planet_type=="earth") then
-              ! Earth: first two tracers will be water
-              do i=1,nqtot
-                if (i.eq.1) q(:,:,i)=1.e-10
-                if (i.eq.2) q(:,:,i)=1.e-15
-                if (i.gt.2) q(:,:,i)=0.
-              enddo
-            else
-              q(:,:,:)=0
-            endif ! of if (planet_type=="earth")
-
-            ! add random perturbation to temperature
-            idum  = -1
-            zz = ran1(idum)
-            idum  = 0
-            do l=1,llm
-              do ij=iip2,ip1jm
-                teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
-              enddo
-            enddo
-
-            ! maintain periodicity in longitude
-            do l=1,llm
-              do ij=1,ip1jmp1,iip1
-                teta(ij+iim,l)=teta(ij,l)
-              enddo
-            enddo
-
-          ENDIF ! of IF (.NOT. read_start)
-        endif ! of if (iflag_phys.eq.2)
-        
-      END
-c-----------------------------------------------------------------------
Index: trunk/libf/dyn3dpar/iniacademic.F90
===================================================================
--- trunk/libf/dyn3dpar/iniacademic.F90	(revision 66)
+++ trunk/libf/dyn3dpar/iniacademic.F90	(revision 66)
@@ -0,0 +1,268 @@
+!
+! $Id: iniacademic.F90 1474 2011-01-14 11:04:45Z lguez $
+!
+SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
+
+  USE filtreg_mod
+  USE infotrac, ONLY : nqtot
+  USE control_mod, ONLY: day_step,planet_type
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  USE ioipsl_getincom
+#endif
+  USE Write_Field
+
+  !   Author:    Frederic Hourdin      original: 15/01/93
+  ! The forcing defined here is from Held and Suarez, 1994, Bulletin
+  ! of the American Meteorological Society, 75, 1825.
+
+  IMPLICIT NONE
+
+  !   Declararations:
+  !   ---------------
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comvert.h"
+  include "comconst.h"
+  include "comgeom.h"
+  include "academic.h"
+  include "ener.h"
+  include "temps.h"
+  include "iniprint.h"
+  include "logic.h"
+
+  !   Arguments:
+  !   ----------
+
+  real time_0
+
+  !   variables dynamiques
+  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+  REAL teta(ip1jmp1,llm)                 ! temperature potentielle
+  REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
+  REAL ps(ip1jmp1)                       ! pression  au sol
+  REAL masse(ip1jmp1,llm)                ! masse d'air
+  REAL phis(ip1jmp1)                     ! geopotentiel au sol
+
+  !   Local:
+  !   ------
+
+  REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
+  REAL pks(ip1jmp1)                      ! exner au  sol
+  REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
+  REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
+  REAL phi(ip1jmp1,llm)                  ! geopotentiel
+  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
+  real tetastrat ! potential temperature in the stratosphere, in K
+  real tetajl(jjp1,llm)
+  INTEGER i,j,l,lsup,ij
+
+  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
+  REAL k_f,k_c_a,k_c_s         ! Constantes de rappel
+  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
+  LOGICAL ok_pv                ! Polar Vortex
+  REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex 
+
+  real zz,ran1
+  integer idum
+
+  REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
+
+  !-----------------------------------------------------------------------
+  ! 1. Initializations for Earth-like case
+  ! --------------------------------------
+  !
+  
+  write(lunout,*) 'Iniacademic'
+  
+  ! initialize planet radius, rotation rate,...
+  call conf_planete
+
+  time_0=0.
+  day_ref=1
+  annee_ref=0
+
+  im         = iim
+  jm         = jjm
+  day_ini    = 1
+  dtvr    = daysec/REAL(day_step)
+  zdtvr=dtvr
+  etot0      = 0.
+  ptot0      = 0.
+  ztot0      = 0.
+  stot0      = 0.
+  ang0       = 0.
+
+  if (llm == 1) then
+     ! specific initializations for the shallow water case
+     kappa=1
+  endif
+
+  CALL iniconst
+  CALL inigeom
+  CALL inifilr
+
+  if (llm == 1) then
+     ! initialize fields for the shallow water case, if required
+     if (.not.read_start) then
+        phis(:)=0.
+        q(:,:,:)=0
+        CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
+     endif
+  endif
+
+  academic_case: if (iflag_phys == 2) then
+     ! initializations
+
+     ! 1. local parameters
+     ! by convention, winter is in the southern hemisphere
+     ! Geostrophic wind or no wind?
+     ok_geost=.TRUE.
+     CALL getin('ok_geost',ok_geost)
+     ! Constants for Newtonian relaxation and friction
+     k_f=1.                !friction 
+     CALL getin('k_j',k_f)
+     k_f=1./(daysec*k_f)
+     k_c_s=4.  !cooling surface
+     CALL getin('k_c_s',k_c_s)
+     k_c_s=1./(daysec*k_c_s)
+     k_c_a=40. !cooling free atm
+     CALL getin('k_c_a',k_c_a)
+     k_c_a=1./(daysec*k_c_a)
+     ! Constants for Teta equilibrium profile
+     teta0=315.     ! mean Teta (S.H. 315K)
+     CALL getin('teta0',teta0)
+     write(lunout,*) 'Iniacademic - teta0 ',teta0
+     write(lunout,*) 'Iniacademic - rad ',rad
+     ttp=200.       ! Tropopause temperature (S.H. 200K)
+     CALL getin('ttp',ttp)
+     eps=0.         ! Deviation to N-S symmetry(~0-20K)
+     CALL getin('eps',eps)
+     delt_y=60.     ! Merid Temp. Gradient (S.H. 60K)
+     CALL getin('delt_y',delt_y)
+     delt_z=10.     ! Vertical Gradient (S.H. 10K)
+     CALL getin('delt_z',delt_z)
+     ! Polar vortex
+     ok_pv=.false.
+     CALL getin('ok_pv',ok_pv)
+     phi_pv=-50.            ! Latitude of edge of vortex
+     CALL getin('phi_pv',phi_pv)
+     phi_pv=phi_pv*pi/180.
+     dphi_pv=5.             ! Width of the edge
+     CALL getin('dphi_pv',dphi_pv)
+     dphi_pv=dphi_pv*pi/180.
+     gam_pv=4.              ! -dT/dz vortex (in K/km)
+     CALL getin('gam_pv',gam_pv)
+
+     ! 2. Initialize fields towards which to relax
+     ! Friction
+     knewt_g=k_c_a
+     DO l=1,llm
+        zsig=presnivs(l)/preff
+        knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)
+        kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)
+     ENDDO
+     DO j=1,jjp1
+        clat4((j-1)*iip1+1:j*iip1)=cos(rlatu(j))**4
+     ENDDO
+
+     ! Potential temperature 
+     DO l=1,llm
+        zsig=presnivs(l)/preff
+        tetastrat=ttp*zsig**(-kappa)
+        tetapv=tetastrat
+        IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
+           tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
+        ENDIF
+        DO j=1,jjp1
+           ! Troposphere
+           ddsin=sin(rlatu(j))
+           tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
+                -delt_z*(1.-ddsin*ddsin)*log(zsig)
+           !! Aymeric -- tests particuliers
+           if (planet_type=="giant") then
+             tetajl(j,l)=teta0+(delt_y*                   &
+                ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
+                / ((rlatu(j)*3.14159*eps+0.0001)**2))     &
+                -delt_z*log(zsig)
+           endif
+           ! Profil stratospherique isotherme (+vortex)
+           w_pv=(1.-tanh((rlatu(j)-phi_pv)/dphi_pv))/2.
+           tetastrat=tetastrat*(1.-w_pv)+tetapv*w_pv             
+           tetajl(j,l)=MAX(tetajl(j,l),tetastrat)  
+        ENDDO
+     ENDDO
+
+     !          CALL writefield('theta_eq',tetajl)
+
+     do l=1,llm
+        do j=1,jjp1
+           do i=1,iip1
+              ij=(j-1)*iip1+i
+              tetarappel(ij,l)=tetajl(j,l)
+           enddo
+        enddo
+     enddo
+     write(lunout,*) 'Iniacademic - check',tetajl(:,int(llm/2)),rlatu(:)
+
+     ! 3. Initialize fields (if necessary)
+     IF (.NOT. read_start) THEN
+        ! surface pressure
+        ps(:)=preff
+        ! ground geopotential
+        phis(:)=0.
+
+        CALL pression ( ip1jmp1, ap, bp, ps, p       )
+        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        CALL massdair(p,masse)
+
+        ! bulk initialization of temperature
+        teta(:,:)=tetarappel(:,:)
+
+        ! geopotential
+        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
+
+        ! winds
+        if (ok_geost) then
+           call ugeostr(phi,ucov)
+        else
+           ucov(:,:)=0.
+        endif
+        vcov(:,:)=0.
+
+        ! bulk initialization of tracers
+        if (planet_type=="earth") then
+           ! Earth: first two tracers will be water
+           do i=1,nqtot
+              if (i == 1) q(:,:,i)=1.e-10
+              if (i == 2) q(:,:,i)=1.e-15
+              if (i.gt.2) q(:,:,i)=0.
+           enddo
+        else
+           q(:,:,:)=0
+        endif ! of if (planet_type=="earth")
+
+        ! add random perturbation to temperature
+        idum  = -1
+        zz = ran1(idum)
+        idum  = 0
+        do l=1,llm
+           do ij=iip2,ip1jm
+              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
+           enddo
+        enddo
+
+        ! maintain periodicity in longitude
+        do l=1,llm
+           do ij=1,ip1jmp1,iip1
+              teta(ij+iim,l)=teta(ij,l)
+           enddo
+        enddo
+
+     ENDIF ! of IF (.NOT. read_start)
+  endif academic_case
+
+END SUBROUTINE iniacademic
Index: trunk/libf/dyn3dpar/parallel.F90
===================================================================
--- trunk/libf/dyn3dpar/parallel.F90	(revision 53)
+++ trunk/libf/dyn3dpar/parallel.F90	(revision 66)
@@ -1,9 +1,9 @@
 ! 
-! $Id: parallel.F90 1279 2009-12-10 09:02:56Z fairhead $
+! $Id: parallel.F90 1487 2011-02-11 15:07:54Z jghattas $
 !
   module parallel
   USE mod_const_mpi
     
-    LOGICAL,SAVE :: using_mpi
+    LOGICAL,SAVE :: using_mpi=.TRUE.
     LOGICAL,SAVE :: using_omp
     
@@ -208,7 +208,8 @@
       integer :: ierr
       integer :: i
-      deallocate(jj_begin_para)
-      deallocate(jj_end_para)
-      deallocate(jj_nb_para)
+
+      if (allocated(jj_begin_para)) deallocate(jj_begin_para)
+      if (allocated(jj_end_para))   deallocate(jj_end_para)
+      if (allocated(jj_nb_para))    deallocate(jj_nb_para)
 
       if (type_ocean == 'couple') then
@@ -549,23 +550,22 @@
         
    
-    /*  
-  Subroutine verif_hallo(Field,ij,ll,up,down)
-    implicit none
-#include "dimensions.h"
-#include "paramet.h"    
-    include 'mpif.h'
-    
-      INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
-      INTEGER :: up,down 
-      
-      REAL,dimension(ij,ll): NewField
-      
-      NewField=0
-      
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) 
-      NewField(ij_be       
-*/
+!  Subroutine verif_hallo(Field,ij,ll,up,down)
+!    implicit none
+!#include "dimensions.h"
+!#include "paramet.h"    
+!    include 'mpif.h'
+!    
+!      INTEGER :: ij,ll
+!      REAL, dimension(ij,ll) :: Field
+!      INTEGER :: up,down 
+!      
+!      REAL,dimension(ij,ll): NewField
+!      
+!      NewField=0
+!      
+!      ijb=ij_begin
+!      ije=ij_end
+!      if (pole_nord) 
+!      NewField(ij_be       
+
   end module parallel
Index: trunk/libf/dyn3dpar/ugeostr.F
===================================================================
--- trunk/libf/dyn3dpar/ugeostr.F	(revision 53)
+++ 	(revision )
@@ -1,69 +1,0 @@
-!
-! $Id: ugeostr.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      subroutine ugeostr(phi,ucov)
-
-
-c  Calcul du vent covariant geostrophique a partir du champs de
-c  geopotentiel en supposant que le vent au sol est nul.
-
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom2.h"
-
-      real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
-      real um(jjm,llm),fact,u(iip1,jjm,llm)
-      integer i,j,l
-
-      real zlat
-
-      um(:,:)=0 ! initialize um()
-
-      DO j=1,jjm
-
-         if (abs(sin(rlatv(j))).lt.1.e-4) then
-             zlat=1.e-4
-         else
-             zlat=rlatv(j)
-         endif
-         fact=cos(zlat)
-         fact=fact*fact
-         fact=fact*fact
-         fact=fact*fact
-         fact=(1.-fact)/
-     s    (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
-         fact=-fact/rad
-         DO l=1,llm
-            DO i=1,iim
-               u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
-               um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
-            ENDDO
-         ENDDO
-      ENDDO
-      call dump2d(jjm,llm,um,'Vent-u geostrophique')
-
-c
-c-----------------------------------------------------------------------
-c   calcul des champ de vent:
-c   -------------------------
-
-      DO 301 l=1,llm
-         DO 302 i=1,iip1
-            ucov(i,1,l)=0.
-            ucov(i,jjp1,l)=0.
-302      CONTINUE
-         DO 304 j=2,jjm
-            DO 305 i=1,iim
-               ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
-305         CONTINUE
-            ucov(iip1,j,l)=ucov(1,j,l)
-304      CONTINUE
-301   CONTINUE
-
-      print*,301
-
-      return
-      end
Index: trunk/libf/dyn3dpar/ugeostr.F90
===================================================================
--- trunk/libf/dyn3dpar/ugeostr.F90	(revision 66)
+++ trunk/libf/dyn3dpar/ugeostr.F90	(revision 66)
@@ -0,0 +1,68 @@
+!
+! $Id: ugeostr.F90 1474 2011-01-14 11:04:45Z lguez $
+!
+subroutine ugeostr(phi,ucov)
+
+  ! Calcul du vent covariant geostrophique a partir du champ de
+  ! geopotentiel.
+  ! We actually compute: (1 - cos^8 \phi) u_g
+  ! to have a wind going smoothly to 0 at the equator.
+  ! We assume that the surface pressure is uniform so that model
+  ! levels are pressure levels.
+
+  implicit none
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "comgeom2.h"
+
+  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+  real um(jjm,llm),fact,u(iip1,jjm,llm)
+  integer i,j,l
+
+  real zlat
+
+  um(:,:)=0 ! initialize um()
+
+  DO j=1,jjm
+
+     if (abs(sin(rlatv(j))).lt.1.e-4) then
+        zlat=1.e-4
+     else
+        zlat=rlatv(j)
+     endif
+     fact=cos(zlat)
+     fact=fact*fact
+     fact=fact*fact
+     fact=fact*fact
+     fact=(1.-fact)/ &
+          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
+     fact=-fact/rad
+     DO l=1,llm
+        DO i=1,iim
+           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
+           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
+        ENDDO
+     ENDDO
+  ENDDO
+  call dump2d(jjm,llm,um,'Vent-u geostrophique')
+
+  !   calcul des champ de vent:
+
+  DO l=1,llm
+     DO i=1,iip1
+        ucov(i,1,l)=0.
+        ucov(i,jjp1,l)=0.
+     end DO
+     DO  j=2,jjm
+        DO  i=1,iim
+           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
+        end DO
+        ucov(iip1,j,l)=ucov(1,j,l)
+     end DO
+  end DO
+
+  print *, 301
+
+end subroutine ugeostr
Index: trunk/libf/phylmd/aeropt_5wv.F90
===================================================================
--- trunk/libf/phylmd/aeropt_5wv.F90	(revision 53)
+++ trunk/libf/phylmd/aeropt_5wv.F90	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: aeropt_5wv.F90 1418 2010-07-19 15:11:24Z jghattas $
+! $Id: aeropt_5wv.F90 1470 2010-12-21 15:51:32Z idelkadi $
 !
 
@@ -756,5 +756,12 @@
     ENDIF
 
-    used_tau(spsol)=.TRUE.
+!Bug 21 12 10 AI
+!    used_tau(spsol)=.TRUE.
+    IF (soluble) then
+      used_tau(spsol)=.TRUE.
+       ELSE
+      used_tau(naero_soluble+spinsol)=.TRUE.
+    ENDIF
+
     DO la=1,las
 
Index: trunk/libf/phylmd/calcul_divers.h
===================================================================
--- trunk/libf/phylmd/calcul_divers.h	(revision 53)
+++ trunk/libf/phylmd/calcul_divers.h	(revision 66)
@@ -2,28 +2,23 @@
 c $Header$
 c
-c
-c initialisations diverses au "debut" du mois
-c
-      IF(MOD(itap,INT(ecrit_mth/dtime)).EQ.1) THEN
+
+c     Initialisations diverses au "debut" du mois
+      IF(debut) THEN
+         nday_rain(:)=0.
+
+c        surface terre
+         paire_ter(:)=0.
          DO i=1, klon
-          nday_rain(i)=0.
-         ENDDO !i
-c
-c surface terre
-       DO i=1, klon
-         IF(pctsrf(i,is_ter).GT.0.) THEN
-            paire_ter(i)=airephy(i)*pctsrf(i,is_ter)
-         ENDIF 
-       ENDDO
-c
-      ENDIF !MOD(itap,INT(ecrit_mth)).EQ.1
-c
-      IF(MOD(itap,INT(ecrit_day/dtime)).EQ.0) THEN
-c
-cIM calcul total_rain, nday_rain
-c
-       DO i = 1, klon
-        total_rain(i)=rain_fall(i)+snow_fall(i)  
-        IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.
-       ENDDO
-      ENDIF !itap.EQ.ecrit_mth
+            IF(pctsrf(i,is_ter).GT.0.) THEN
+               paire_ter(i)=airephy(i)*pctsrf(i,is_ter)
+            ENDIF 
+         ENDDO
+      ENDIF
+
+cIM   Calcul une fois par jour : total_rain, nday_rain
+      IF(MOD(itap,INT(un_jour/dtime)).EQ.0) THEN
+         DO i = 1, klon
+            total_rain(i)=rain_fall(i)+snow_fall(i)  
+            IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.
+         ENDDO
+      ENDIF
Index: trunk/libf/phylmd/carbon_cycle_mod.F90
===================================================================
--- trunk/libf/phylmd/carbon_cycle_mod.F90	(revision 53)
+++ trunk/libf/phylmd/carbon_cycle_mod.F90	(revision 66)
@@ -1,4 +1,9 @@
 MODULE carbon_cycle_mod
-
+! Controle module for the carbon CO2 tracers :
+!   - Identification
+!   - Get concentrations comming from coupled model or read from file to tracers
+!   - Calculate new RCO2 for radiation scheme
+!   - Calculate new carbon flux for sending to coupled models (PISCES and ORCHIDEE)
+!
 ! Author : Josefine GHATTAS, Patricia CADULE
 
@@ -13,5 +18,10 @@
   LOGICAL, PUBLIC :: carbon_cycle_cpl       ! Coupling of CO2 fluxes between LMDZ/ORCHIDEE and LMDZ/OCEAN(PISCES) 
 !$OMP THREADPRIVATE(carbon_cycle_cpl)
+
   LOGICAL :: carbon_cycle_emis_comp=.FALSE. ! Calculation of emission compatible
+!$OMP THREADPRIVATE(carbon_cycle_emis_comp)
+
+  LOGICAL :: RCO2_inter  ! RCO2 interactive : if true calculate new value RCO2 for the radiation scheme
+!$OMP THREADPRIVATE(RCO2_inter)
 
 ! Scalare values when no transport, from physiq.def
@@ -21,16 +31,14 @@
 !$OMP THREADPRIVATE(emis_land_s)
 
-  INTEGER :: ntr_co2                ! Number of tracers concerning the carbon cycle
-  INTEGER :: id_fco2_tot            ! Tracer index
-  INTEGER :: id_fco2_ocn            !  - " -
-  INTEGER :: id_fco2_land           !  - " -
-  INTEGER :: id_fco2_land_use       !  - " -
-  INTEGER :: id_fco2_fos_fuel       !  - " -
-!$OMP THREADPRIVATE(ntr_co2, id_fco2_tot, id_fco2_ocn, id_fco2_land, id_fco2_land_use, id_fco2_fos_fuel)  
-
-  REAL, DIMENSION(:), ALLOCATABLE :: fos_fuel        ! CO2 fossil fuel emission from file [gC/m2/d]
-!$OMP THREADPRIVATE(fos_fuel)
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocn_day ! flux CO2 from ocean for 1 day (cumulated) [gC/m2/d]
+  REAL :: airetot     ! Total area of the earth surface
+!$OMP THREADPRIVATE(airetot)
+
+  INTEGER :: ntr_co2  ! Number of tracers concerning the carbon cycle
+!$OMP THREADPRIVATE(ntr_co2)
+
+! fco2_ocn_day : flux CO2 from ocean for 1 day (cumulated) [gC/m2/d]. Allocation and initalization done in cpl_mod
+  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocn_day 
 !$OMP THREADPRIVATE(fco2_ocn_day)
+
   REAL, DIMENSION(:), ALLOCATABLE :: fco2_land_day   ! flux CO2 from land for 1 day (cumulated)  [gC/m2/d]
 !$OMP THREADPRIVATE(fco2_land_day)
@@ -38,5 +46,8 @@
 !$OMP THREADPRIVATE(fco2_lu_day)
 
-! Following 2 fields will be initialized in surf_land_orchidee at each time step
+  REAL, DIMENSION(:,:), ALLOCATABLE :: dtr_add       ! Tracer concentration to be injected 
+!$OMP THREADPRIVATE(dtr_add)
+
+! Following 2 fields will be allocated and initialized in surf_land_orchidee
   REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_inst  ! flux CO2 from land at one time step
 !$OMP THREADPRIVATE(fco2_land_inst)
@@ -45,14 +56,37 @@
 
 ! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE 
-  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send 
+  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0
 !$OMP THREADPRIVATE(co2_send)
+
+
+  TYPE, PUBLIC ::   co2_trac_type
+     CHARACTER(len = 8) :: name       ! Tracer name in tracer.def
+     INTEGER            :: id         ! Index in total tracer list, tr_seri
+     CHARACTER(len=30)  :: file       ! File name
+     LOGICAL            :: cpl        ! True if this tracers is coupled from ORCHIDEE or PISCES. 
+                                      ! False if read from file.
+     INTEGER            :: updatefreq ! Frequence to inject in second
+     INTEGER            :: readstep   ! Actual time step to read in file
+     LOGICAL            :: updatenow  ! True if this tracer should be updated this time step
+  END TYPE co2_trac_type
+  INTEGER,PARAMETER :: maxco2trac=5  ! Maximum number of different CO2 fluxes
+  TYPE(co2_trac_type), DIMENSION(maxco2trac) :: co2trac
 
 CONTAINS
   
-  SUBROUTINE carbon_cycle_init(tr_seri, aerosol, radio)
+  SUBROUTINE carbon_cycle_init(tr_seri, pdtphys, aerosol, radio)
+! This subroutine is called from traclmdz_init, only at first timestep.
+! - Read controle parameters from .def input file
+! - Search for carbon tracers and set default values
+! - Allocate variables
+! - Test for compatibility
+
     USE dimphy
+    USE comgeomphy
+    USE mod_phys_lmdz_transfert_para
     USE infotrac
     USE IOIPSL
     USE surface_data, ONLY : ok_veget, type_ocean
+    USE phys_cal_mod, ONLY : mth_len
 
     IMPLICIT NONE
@@ -62,4 +96,5 @@
 ! Input argument
     REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri ! Concentration Traceur [U/KgA]  
+    REAL,INTENT(IN)                           :: pdtphys ! length of time step in physiq (sec)
 
 ! InOutput arguments
@@ -68,78 +103,13 @@
 
 ! Local variables
-    INTEGER               :: ierr, it, iiq
-    REAL, DIMENSION(klon) :: tr_seri_sum
-
-
-! 0) Test for compatibility
-    IF (carbon_cycle_cpl .AND. type_ocean/='couple') &
-         CALL abort_gcm('carbon_cycle_init', 'Coupling with ocean model is needed for carbon_cycle_cpl',1)
-    IF (carbon_cycle_cpl .AND..NOT. ok_veget) &
-         CALL abort_gcm('carbon_cycle_init', 'Coupling with surface land model ORCHDIEE is needed for carbon_cycle_cpl',1)
-
-
-! 1) Check if transport of one tracer flux CO2 or 4 separated tracers
-    IF (carbon_cycle_tr) THEN
-       id_fco2_tot=0
-       id_fco2_ocn=0
-       id_fco2_land=0
-       id_fco2_land_use=0
-       id_fco2_fos_fuel=0
-       
-       ! Search in tracer list
-       DO it=1,nbtr
-          iiq=niadv(it+2)
-          IF (tname(iiq) == "fCO2" ) THEN
-             id_fco2_tot=it
-          ELSE IF (tname(iiq) == "fCO2_ocn" ) THEN
-             id_fco2_ocn=it
-          ELSE IF (tname(iiq) == "fCO2_land" ) THEN
-             id_fco2_land=it
-          ELSE IF (tname(iiq) == "fCO2_land_use" ) THEN
-             id_fco2_land_use=it
-          ELSE IF (tname(iiq) == "fCO2_fos_fuel" ) THEN
-             id_fco2_fos_fuel=it
-          END IF
-       END DO
-
-       ! Count tracers found
-       IF (id_fco2_tot /= 0 .AND. &
-            id_fco2_ocn==0 .AND. id_fco2_land==0 .AND. id_fco2_land_use==0 .AND. id_fco2_fos_fuel==0) THEN
-          
-          ! transport  1 tracer flux CO2
-          ntr_co2 = 1
-          
-       ELSE IF (id_fco2_tot==0 .AND. &
-            id_fco2_ocn /=0 .AND. id_fco2_land/=0 .AND. id_fco2_land_use/=0 .AND. id_fco2_fos_fuel/=0) THEN
-          
-          ! transport 4 tracers seperatively
-          ntr_co2 = 4
-          
-       ELSE
-          CALL abort_gcm('carbon_cycle_init', 'error in coherence between traceur.def and gcm.def',1)
-       END IF
-
-       ! Definition of control varaiables for the tracers
-       DO it=1,nbtr
-          IF (it==id_fco2_tot .OR. it==id_fco2_ocn .OR. it==id_fco2_land .OR. &
-               it==id_fco2_land_use .OR. it==id_fco2_fos_fuel) THEN
-             aerosol(it) = .FALSE.
-             radio(it)   = .FALSE.
-          END IF
-       END DO
-
-    ELSE 
-       ! No transport of CO2
-       ntr_co2 = 0
-    END IF ! carbon_cycle_tr
-
-
-! 2) Allocate variable for CO2 fossil fuel emission
-    IF (carbon_cycle_tr) THEN
-       ! Allocate 2D variable
-       ALLOCATE(fos_fuel(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 1',1)
-    ELSE
-       ! No transport : read value from .def
+    INTEGER               :: ierr, it, iiq, itc
+    INTEGER               :: teststop
+
+
+
+! 1) Read controle parameters from .def input file
+! ------------------------------------------------
+    ! Read fosil fuel value if no transport
+    IF (.NOT. carbon_cycle_tr) THEN
        fos_fuel_s = 0.
        CALL getin ('carbon_cycle_fos_fuel',fos_fuel_s)
@@ -148,68 +118,177 @@
 
 
-! 3) Allocate and initialize fluxes
-    IF (carbon_cycle_cpl) THEN
-       IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 2',1)
-       ALLOCATE(fco2_land_day(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 3',1)
-       ALLOCATE(fco2_lu_day(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 4',1)
-
-       fco2_land_day(:) = 0.  ! JG : Doit prend valeur de restart
-       fco2_lu_day(:)   = 0.  ! JG : Doit prend valeur de restart
-
-       ! fco2_ocn_day is allocated in cpl_mod
-       ! fco2_land_inst and fco2_lu_inst are allocated in surf_land_orchidee
-       
-       ALLOCATE(co2_send(klon), stat=ierr)
-       IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 7',1)
-       
-       ! Calculate using restart tracer values
-       IF (carbon_cycle_tr) THEN
-          IF (ntr_co2==1) THEN
-             co2_send(:) = tr_seri(:,1,id_fco2_tot) + co2_ppm0
-          ELSE ! ntr_co2==4
-             ! Calculate the delta CO2 flux
-             tr_seri_sum(:) = tr_seri(:,1,id_fco2_fos_fuel) + tr_seri(:,1,id_fco2_land_use) + &
-                  tr_seri(:,1,id_fco2_land) + tr_seri(:,1,id_fco2_ocn)
-             co2_send(:) = tr_seri_sum(:) + co2_ppm0
-          END IF
-       ELSE
-          ! Send a scalare value in 2D variable to ocean and land model (PISCES and ORCHIDEE)
-          co2_send(:) = co2_ppm
-       END IF
-
-
-    ELSE 
-       IF (carbon_cycle_tr) THEN
-          ! No coupling of CO2 fields : 
-          ! corresponding fields will instead be read from files
-          ALLOCATE(fco2_ocn_day(klon), stat=ierr)
-          IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 8',1)
-          ALLOCATE(fco2_land_day(klon), stat=ierr)
-          IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 9',1)
-          ALLOCATE(fco2_lu_day(klon), stat=ierr)
-          IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 10',1)       
-       END IF
-    END IF
-
-! 4) Read parmeter for calculation of emission compatible
+    ! Read parmeter for calculation compatible emission
     IF (.NOT. carbon_cycle_tr) THEN
        carbon_cycle_emis_comp=.FALSE.
        CALL getin('carbon_cycle_emis_comp',carbon_cycle_emis_comp)
        WRITE(lunout,*) 'carbon_cycle_emis_comp = ',carbon_cycle_emis_comp
-    END IF
+       IF (carbon_cycle_emis_comp) THEN
+          CALL abort_gcm('carbon_cycle_init', 'carbon_cycle_emis_comp option not yet implemented!!',1)
+       END IF
+    END IF
+
+    ! Read parameter for interactive calculation of the CO2 value for the radiation scheme
+    RCO2_inter=.FALSE.
+    CALL getin('RCO2_inter',RCO2_inter)
+    WRITE(lunout,*) 'RCO2_inter = ', RCO2_inter
+    IF (RCO2_inter) THEN
+       WRITE(lunout,*) 'RCO2 will be recalculated once a day'
+       WRITE(lunout,*) 'RCO2 initial = ', RCO2
+    END IF
+
+
+! 2) Search for carbon tracers and set default values
+! ---------------------------------------------------
+    itc=0
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       
+       SELECT CASE(tname(iiq))
+       CASE("fCO2_ocn")
+          itc = itc + 1
+          co2trac(itc)%name='fCO2_ocn'
+          co2trac(itc)%id=it
+          co2trac(itc)%file='fl_co2_ocean.nc'
+          IF (carbon_cycle_cpl .AND. type_ocean=='couple') THEN 
+             co2trac(itc)%cpl=.TRUE.
+             co2trac(itc)%updatefreq = 86400 ! Once a day as the coupling with OASIS/PISCES
+          ELSE
+             co2trac(itc)%cpl=.FALSE.
+             co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
+          END IF
+       CASE("fCO2_land")
+          itc = itc + 1
+          co2trac(itc)%name='fCO2_land'
+          co2trac(itc)%id=it
+          co2trac(itc)%file='fl_co2_land.nc'
+          IF (carbon_cycle_cpl .AND. ok_veget) THEN 
+             co2trac(itc)%cpl=.TRUE.
+             co2trac(itc)%updatefreq = INT(pdtphys) ! Each timestep as the coupling with ORCHIDEE
+          ELSE
+             co2trac(itc)%cpl=.FALSE.
+!             co2trac(itc)%updatefreq = 10800   ! 10800sec = 3H
+             co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
+          END IF
+       CASE("fCO2_land_use")
+          itc = itc + 1
+          co2trac(itc)%name='fCO2_land_use'
+          co2trac(itc)%id=it
+          co2trac(itc)%file='fl_co2_land_use.nc'
+          IF (carbon_cycle_cpl .AND. ok_veget) THEN 
+             co2trac(it)%cpl=.TRUE.
+             co2trac(itc)%updatefreq = INT(pdtphys) ! Each timestep as the coupling with ORCHIDEE
+          ELSE
+             co2trac(itc)%cpl=.FALSE.
+             co2trac(itc)%updatefreq = 10800   ! 10800sec = 3H
+          END IF
+       CASE("fCO2_fos_fuel")
+          itc = itc + 1
+          co2trac(itc)%name='fCO2_fos_fuel'
+          co2trac(itc)%id=it
+          co2trac(itc)%file='fossil_fuel.nc'
+          co2trac(itc)%cpl=.FALSE.       ! This tracer always read from file
+!         co2trac(itc)%updatefreq = 86400  ! 86400sec = 24H Cadule case
+          co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
+       CASE("fCO2_bbg")
+          itc = itc + 1
+          co2trac(itc)%name='fCO2_bbg'
+          co2trac(itc)%id=it
+          co2trac(itc)%file='fl_co2_bbg.nc'
+          co2trac(itc)%cpl=.FALSE.       ! This tracer always read from file
+          co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
+       CASE("fCO2")
+          ! fCO2 : One tracer transporting the total CO2 flux
+          itc = itc + 1
+          co2trac(itc)%name='fCO2'
+          co2trac(itc)%id=it
+          co2trac(itc)%file='fl_co2.nc'
+          IF (carbon_cycle_cpl) THEN 
+             co2trac(itc)%cpl=.TRUE.
+          ELSE
+             co2trac(itc)%cpl=.FALSE.
+          END IF
+          co2trac(itc)%updatefreq = 86400
+          ! DOES THIS WORK ???? Problematic due to implementation of the coupled fluxes...
+          CALL abort_gcm('carbon_cycle_init','transport of total CO2 has to be implemented and tested',1)
+       END SELECT
+    END DO
+
+    ! Total number of carbon CO2 tracers
+    ntr_co2 = itc 
+    
+    ! Definition of control varaiables for the tracers
+    DO it=1,ntr_co2
+       aerosol(co2trac(it)%id) = .FALSE.
+       radio(co2trac(it)%id)   = .FALSE.
+    END DO
+    
+    ! Vector indicating which timestep to read for each tracer
+    ! Always start read in the beginning of the file
+    co2trac(:)%readstep = 0
+   
+
+! 3) Allocate variables
+! ---------------------
+    ! Allocate vector for storing fluxes to inject
+    ALLOCATE(dtr_add(klon,maxco2trac), stat=ierr)
+    IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 11',1)       
+    
+    ! Allocate variables for cumulating fluxes from ORCHIDEE
+    IF (RCO2_inter) THEN
+       IF (.NOT. carbon_cycle_tr .AND. carbon_cycle_cpl) THEN
+          ALLOCATE(fco2_land_day(klon), stat=ierr)
+          IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 2',1)
+          fco2_land_day(1:klon) = 0.
+          
+          ALLOCATE(fco2_lu_day(klon), stat=ierr)
+          IF (ierr /= 0) CALL abort_gcm('carbon_cycle_init', 'pb in allocation 3',1)
+          fco2_lu_day(1:klon)   = 0.
+       END IF
+    END IF
+
+
+! 4) Test for compatibility
+! -------------------------
+!    IF (carbon_cycle_cpl .AND. type_ocean/='couple') THEN
+!       WRITE(lunout,*) 'Coupling with ocean model is needed for carbon_cycle_cpl'
+!       CALL abort_gcm('carbon_cycle_init', 'coupled ocean is needed for carbon_cycle_cpl',1)
+!    END IF
+!
+!    IF (carbon_cycle_cpl .AND..NOT. ok_veget) THEN
+!       WRITE(lunout,*) 'Coupling with surface land model ORCHDIEE is needed for carbon_cycle_cpl'
+!       CALL abort_gcm('carbon_cycle_init', 'ok_veget is needed for carbon_cycle_cpl',1)
+!    END IF
+
+    ! Compiler test : following should never happen
+    teststop=0
+    DO it=1,teststop
+       CALL abort_gcm('carbon_cycle_init', 'Entering loop from 1 to 0',1)
+    END DO
+
+    IF (ntr_co2==0) THEN
+       ! No carbon tracers found in tracer.def. It is not possible to do carbon cycle 
+       WRITE(lunout,*) 'No carbon tracers found in tracer.def. Not ok with carbon_cycle_tr and/or carbon_cycle_cp'
+       CALL abort_gcm('carbon_cycle_init', 'No carbon tracers found in tracer.def',1)
+    END IF
+    
+! 5) Calculate total area of the earth surface
+! --------------------------------------------
+    CALL reduce_sum(SUM(airephy),airetot)
+    CALL bcast(airetot)
 
   END SUBROUTINE carbon_cycle_init
 
+
+  SUBROUTINE carbon_cycle(nstep, pdtphys, pctsrf, tr_seri, source)
+! Subroutine for injection of co2 in the tracers
 !
-!
-!
-
-  SUBROUTINE carbon_cycle(nstep, pdtphys, pctsrf, tr_seri)
-    
+! - Find out if it is time to update
+! - Get tracer from coupled model or from file
+! - Calculate new RCO2 value for the radiation scheme
+! - Calculate CO2 flux to send to ocean and land models (PISCES and ORCHIDEE)
+
     USE infotrac
     USE dimphy
-    USE mod_phys_lmdz_transfert_para, ONLY : reduce_sum
+    USE mod_phys_lmdz_transfert_para
     USE phys_cal_mod, ONLY : mth_cur, mth_len
     USE phys_cal_mod, ONLY : day_cur
@@ -220,12 +299,16 @@
     INCLUDE "clesphys.h"
     INCLUDE "indicesol.h"
+    INCLUDE "iniprint.h"
+    INCLUDE "YOMCST.h"
 
 ! In/Output arguments
     INTEGER,INTENT(IN) :: nstep      ! time step in physiq
     REAL,INTENT(IN)    :: pdtphys    ! length of time step in physiq (sec)
-    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
-    REAL, DIMENSION(klon,klev,nbtr), INTENT(INOUT)  :: tr_seri
+    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf            ! Surface fraction
+    REAL, DIMENSION(klon,klev,nbtr), INTENT(INOUT)  :: tr_seri ! All tracers
+    REAL, DIMENSION(klon,nbtr), INTENT(INOUT)       :: source  ! Source for all tracers
 
 ! Local variables
+    INTEGER :: it
     LOGICAL :: newmonth ! indicates if a new month just started
     LOGICAL :: newday   ! indicates if a new day just started
@@ -233,10 +316,11 @@
 
     REAL, PARAMETER :: fact=1.E-15/2.12  ! transformation factor from gC/m2/day => ppm/m2/day
-    REAL, DIMENSION(klon) :: fco2_tmp, tr_seri_sum
+    REAL, DIMENSION(klon) :: fco2_tmp
     REAL :: sumtmp
-    REAL :: airetot     ! Total area the earth
     REAL :: delta_co2_ppm
     
-! -) Calculate logicals indicating if it is a new month, new day or the last time step in a day (end day)
+
+! 1) Calculate logicals indicating if it is a new month, new day or the last time step in a day (end day)
+! -------------------------------------------------------------------------------------------------------
 
     newday = .FALSE.; endday = .FALSE.; newmonth = .FALSE.
@@ -245,152 +329,134 @@
     IF (MOD(nstep,INT(86400./pdtphys))==0) endday=.TRUE.
     IF (newday .AND. day_cur==1) newmonth=.TRUE.
-    
-! -) Read new maps if new month started
-    IF (newmonth .AND. carbon_cycle_tr) THEN
-       CALL read_map2D('fossil_fuel.nc','fos_fuel', mth_cur, .FALSE., fos_fuel)
-       
-       ! division by month lenght to get dayly value
-       fos_fuel(:) = fos_fuel(:)/mth_len
-       
-       IF (.NOT. carbon_cycle_cpl) THEN
-          ! Get dayly values from monthly fluxes
-          CALL read_map2D('fl_co2_ocean.nc','CO2_OCN',mth_cur,.FALSE.,fco2_ocn_day)
-          CALL read_map2D('fl_co2_land.nc','CO2_LAND', mth_cur,.FALSE.,fco2_land_day)
-          CALL read_map2D('fl_co2_land_use.nc','CO2_LAND_USE',mth_cur,.FALSE.,fco2_lu_day)
-       END IF
-    END IF
-    
-
-
-! -) Update tracers at beginning of a new day. Beginning of a new day correspond to a new coupling period in cpl_mod.
-    IF (newday) THEN
+
+! 2)  For each carbon tracer find out if it is time to inject (update)
+! --------------------------------------------------------------------
+    DO it = 1, ntr_co2
+       IF ( MOD(nstep,INT(co2trac(it)%updatefreq/pdtphys)) == 1 ) THEN
+          co2trac(it)%updatenow = .TRUE.
+       ELSE
+          co2trac(it)%updatenow = .FALSE.
+       END IF
+    END DO
+
+! 3) Get tracer update
+! --------------------------------------
+    DO it = 1, ntr_co2
+       IF ( co2trac(it)%updatenow ) THEN
+          IF ( co2trac(it)%cpl ) THEN
+             ! Get tracer from coupled model
+             SELECT CASE(co2trac(it)%name)
+             CASE('fCO2_land')     ! from ORCHIDEE
+                dtr_add(:,it) = fco2_land_inst(:)*pctsrf(:,is_ter)*fact ! [ppm/m2/day]
+             CASE('fCO2_land_use') ! from ORCHIDEE
+                dtr_add(:,it) = fco2_lu_inst(:)  *pctsrf(:,is_ter)*fact ! [ppm/m2/day]
+             CASE('fCO2_ocn')      ! from PISCES
+                dtr_add(:,it) = fco2_ocn_day(:)  *pctsrf(:,is_oce)*fact ! [ppm/m2/day]
+             CASE DEFAULT
+                WRITE(lunout,*) 'Error with tracer ',co2trac(it)%name
+                CALL abort_gcm('carbon_cycle', 'No coupling implemented for this tracer',1)
+             END SELECT
+          ELSE
+             ! Read tracer from file
+             co2trac(it)%readstep = co2trac(it)%readstep + 1 ! increment time step in file
+! Patricia   CALL read_map2D(co2trac(it)%file,'fco2',co2trac(it)%readstep,.FALSE.,dtr_add(:,it))
+             CALL read_map2D(co2trac(it)%file,'fco2',co2trac(it)%readstep,.TRUE.,dtr_add(:,it))
+
+             ! Converte from kgC/m2/h to kgC/m2/s
+             dtr_add(:,it) = dtr_add(:,it)/3600
+             ! Add individual treatment of values read from file
+             SELECT CASE(co2trac(it)%name)
+             CASE('fCO2_land')
+                dtr_add(:,it) = dtr_add(:,it) *pctsrf(:,is_ter)
+             CASE('fCO2_land_use')
+                dtr_add(:,it) = dtr_add(:,it) *pctsrf(:,is_ter)
+             CASE('fCO2_ocn')
+                dtr_add(:,it) = dtr_add(:,it) *pctsrf(:,is_oce)
+! Patricia :
+!             CASE('fCO2_fos_fuel')
+!                dtr_add(:,it) = dtr_add(:,it)/mth_len
+!                co2trac(it)%readstep = 0 ! Always read same value for fossil fuel(Cadule case)
+             END SELECT
+          END IF
+       END IF
+    END DO
+
+! 4) Update co2 tracers : 
+!    Loop over all carbon tracers and add source
+! ------------------------------------------------------------------
+    IF (carbon_cycle_tr) THEN
+       DO it = 1, ntr_co2
+          IF (.FALSE.) THEN
+             tr_seri(1:klon,1,co2trac(it)%id) = tr_seri(1:klon,1,co2trac(it)%id) + dtr_add(1:klon,it)
+             source(1:klon,co2trac(it)%id) = 0.
+          ELSE
+             source(1:klon,co2trac(it)%id) = dtr_add(1:klon,it)
+          END IF
+       END DO
+    END IF
+
+
+! 5) Calculations for new CO2 value for the radiation scheme(instead of reading value from .def)
+! ----------------------------------------------------------------------------------------------
+    IF (RCO2_inter) THEN
+       ! Cumulate fluxes from ORCHIDEE at each timestep
+       IF (.NOT. carbon_cycle_tr .AND. carbon_cycle_cpl) THEN
+          IF (newday) THEN ! Reset cumulative variables once a day 
+             fco2_land_day(1:klon) = 0.
+             fco2_lu_day(1:klon)   = 0.
+          END IF
+          fco2_land_day(1:klon) = fco2_land_day(1:klon) + fco2_land_inst(1:klon) ![gC/m2/day]
+          fco2_lu_day(1:klon)   = fco2_lu_day(1:klon)   + fco2_lu_inst(1:klon)   ![gC/m2/day]
+       END IF
+
+       ! At the end of a new day, calculate a mean scalare value of CO2
+       ! JG : Ici on utilise uniquement le traceur du premier couche du modele. Est-ce que c'est correcte ? 
+       IF (endday) THEN
+
+          IF (carbon_cycle_tr) THEN
+             ! Sum all co2 tracers to get the total delta CO2 flux
+             fco2_tmp(:) = 0.
+             DO it = 1, ntr_co2
+                fco2_tmp(1:klon) = fco2_tmp(1:klon) + tr_seri(1:klon,1,co2trac(it)%id)
+             END DO
+             
+          ELSE IF (carbon_cycle_cpl) THEN ! no carbon_cycle_tr
+             ! Sum co2 fluxes comming from coupled models and parameter for fossil fuel
+             fco2_tmp(1:klon) = fos_fuel_s + ((fco2_lu_day(1:klon) + fco2_land_day(1:klon))*pctsrf(1:klon,is_ter) &
+                  + fco2_ocn_day(:)*pctsrf(:,is_oce)) * fact
+          END IF
+
+          ! Calculate a global mean value of delta CO2 flux
+          fco2_tmp(1:klon) = fco2_tmp(1:klon) * airephy(1:klon)
+          CALL reduce_sum(SUM(fco2_tmp),sumtmp)
+          CALL bcast(sumtmp)
+          delta_co2_ppm = sumtmp/airetot
+          
+          ! Add initial value for co2_ppm and delta value
+          co2_ppm = co2_ppm0 + delta_co2_ppm
+          
+          ! Transformation of atmospheric CO2 concentration for the radiation code
+          RCO2 = co2_ppm * 1.0e-06  * 44.011/28.97 
+          
+          WRITE(lunout,*) 'RCO2 is now updated! RCO2 = ', RCO2
+       END IF ! endday
+
+    END IF ! RCO2_inter
+
+
+! 6) Calculate CO2 flux to send to ocean and land models : PISCES and ORCHIDEE         
+! ----------------------------------------------------------------------------
+    IF (carbon_cycle_cpl) THEN
 
        IF (carbon_cycle_tr) THEN
-
-          ! Update tracers
-          IF (ntr_co2 == 1) THEN
-             ! Calculate the new flux CO2
-             tr_seri(:,1,id_fco2_tot) = tr_seri(:,1,id_fco2_tot) + &
-                  (fos_fuel(:) + &
-                  fco2_lu_day(:)  * pctsrf(:,is_ter) + &
-                  fco2_land_day(:)* pctsrf(:,is_ter) + &
-                  fco2_ocn_day(:) * pctsrf(:,is_oce)) * fact
-
-          ELSE ! ntr_co2 == 4
-             tr_seri(:,1,id_fco2_fos_fuel)  = tr_seri(:,1,id_fco2_fos_fuel) + fos_fuel(:) * fact ! [ppm/m2/day]
-
-             tr_seri(:,1,id_fco2_land_use)  = tr_seri(:,1,id_fco2_land_use) + &
-                  fco2_lu_day(:)  *pctsrf(:,is_ter)*fact ! [ppm/m2/day]
-
-             tr_seri(:,1,id_fco2_land)      = tr_seri(:,1,id_fco2_land)     + &
-                  fco2_land_day(:)*pctsrf(:,is_ter)*fact ! [ppm/m2/day]
-
-             tr_seri(:,1,id_fco2_ocn)       = tr_seri(:,1,id_fco2_ocn)      + &
-                  fco2_ocn_day(:) *pctsrf(:,is_oce)*fact ! [ppm/m2/day]
-
-          END IF
-
-       ELSE ! no transport
-          IF (carbon_cycle_cpl) THEN
-             IF (carbon_cycle_emis_comp) THEN
-                ! Calcul emission compatible a partir des champs 2D et co2_ppm
-                !!! TO DO!!
-                CALL abort_gcm('carbon_cycle', ' Option carbon_cycle_emis_comp not yet implemented',1)
-             END IF
-          END IF
-
-       END IF ! carbon_cycle_tr
-    
-       ! Reset cumluative variables
-       IF (carbon_cycle_cpl) THEN
-          fco2_land_day(:) = 0.
-          fco2_lu_day(:)   = 0.
-       END IF
-    
-    END IF ! newday
-       
-
-
-! -) Cumulate fluxes from ORCHIDEE at each timestep
-    IF (carbon_cycle_cpl) THEN
-       fco2_land_day(:) = fco2_land_day(:) + fco2_land_inst(:)
-       fco2_lu_day(:)   = fco2_lu_day(:)   + fco2_lu_inst(:)
-    END IF
-
-
-
-! -)  At the end of a new day, calculate a mean scalare value of CO2 to be used by 
-!     the radiation scheme (instead of reading value from .def)
-
-! JG : Ici on utilise uniquement le traceur du premier couche du modele. Est-ce que c'est correcte ? 
-    IF (endday) THEN 
-       ! Calculte total area of the earth surface
-       CALL reduce_sum(SUM(airephy),airetot)
-       
-
-       IF (carbon_cycle_tr) THEN
-          IF (ntr_co2 == 1) THEN
-          
-             ! Calculate mean value of tracer CO2 to get an scalare value to be used in the 
-             ! radiation scheme (instead of reading value from .def)
-             ! Mean value weighted with the grid cell area
-             
-             ! Calculate mean value
-             fco2_tmp(:) = tr_seri(:,1,id_fco2_tot) * airephy(:) 
-             CALL reduce_sum(SUM(fco2_tmp),sumtmp)
-             co2_ppm = sumtmp/airetot + co2_ppm0
-             
-          ELSE ! ntr_co2 == 4
-             
-             ! Calculate the delta CO2 flux
-             tr_seri_sum(:) = tr_seri(:,1,id_fco2_fos_fuel) + tr_seri(:,1,id_fco2_land_use) + &
-                  tr_seri(:,1,id_fco2_land) + tr_seri(:,1,id_fco2_ocn)
-             
-             ! Calculate mean value of delta CO2 flux
-             fco2_tmp(:) = tr_seri_sum(:) * airephy(:)
-             CALL reduce_sum(SUM(fco2_tmp),sumtmp)
-             delta_co2_ppm = sumtmp/airetot
-             
-             ! Add initial value for co2_ppm to delta value
-             co2_ppm = delta_co2_ppm + co2_ppm0
-          END IF
-
-       ELSE IF (carbon_cycle_cpl) THEN ! no carbon_cycle_tr
-
-          ! Calculate the total CO2 flux and integrate to get scalare value for the radiation scheme
-          fco2_tmp(:) = (fos_fuel(:) + (fco2_lu_day(:) + fco2_land_day(:))*pctsrf(:,is_ter) &
-               + fco2_ocn_day(:)*pctsrf(:,is_oce)) * fact
-          
-          ! Calculate mean value
-          fco2_tmp(:) = fco2_tmp(:) * airephy(:)
-          CALL reduce_sum(SUM(fco2_tmp),sumtmp)
-          delta_co2_ppm = sumtmp/airetot
-
-          ! Update current value of the atmospheric co2_ppm
-          co2_ppm = co2_ppm + delta_co2_ppm
-          
-       END IF ! carbon_cycle_tr
-
-       ! transformation of the atmospheric CO2 concentration for the radiation code
-       RCO2 = co2_ppm * 1.0e-06  * 44.011/28.97 
-
-    END IF
-
-    ! Calculate CO2 flux to send to ocean and land models : PISCES and ORCHIDEE         
-    IF (endday .AND. carbon_cycle_cpl) THEN
-       
-       IF (carbon_cycle_tr) THEN
-          IF (ntr_co2==1) THEN
-
-             co2_send(:) = tr_seri(:,1,id_fco2_tot) + co2_ppm0
-
-          ELSE ! ntr_co2 == 4
-
-             co2_send(:) = tr_seri_sum(:) + co2_ppm0
-
-          END IF
+          ! Sum all co2 tracers to get the total delta CO2 flux at first model layer
+          fco2_tmp(:) = 0.
+          DO it = 1, ntr_co2
+             fco2_tmp(1:klon) = fco2_tmp(1:klon) + tr_seri(1:klon,1,co2trac(it)%id)
+          END DO
+          co2_send(1:klon) = fco2_tmp(1:klon) + co2_ppm0
        ELSE
           ! Send a scalare value in 2D variable to ocean and land model (PISCES and ORCHIDEE)
-          co2_send(:) = co2_ppm
+          co2_send(1:klon) = co2_ppm
        END IF
 
Index: trunk/libf/phylmd/change_srf_frac_mod.F90
===================================================================
--- trunk/libf/phylmd/change_srf_frac_mod.F90	(revision 53)
+++ trunk/libf/phylmd/change_srf_frac_mod.F90	(revision 66)
@@ -9,5 +9,6 @@
 ! 
 ! Change Surface Fractions
-!
+! Author J Ghattas 2008
+
   SUBROUTINE change_srf_frac(itime, dtime, jour, &
        pctsrf, alb1, alb2, tsurf, u10m, v10m, pbl_tke)
@@ -76,5 +77,5 @@
     END SELECT
 
-    IF (is_modified) THEN
+
 !****************************************************************************************
 ! 2) 
@@ -84,4 +85,5 @@
 !
 !****************************************************************************************
+    IF (is_modified) THEN
   
 ! Test and exit if a fraction is negative
@@ -150,4 +152,8 @@
        CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, u10m, v10m, pbl_tke)
 
+    ELSE
+       ! No modifcation should be done
+       pctsrf(:,:) = pctsrf_old(:,:)
+
     END IF ! is_modified
 
Index: trunk/libf/phylmd/conf_phys.F90
===================================================================
--- trunk/libf/phylmd/conf_phys.F90	(revision 53)
+++ trunk/libf/phylmd/conf_phys.F90	(revision 66)
@@ -1,5 +1,5 @@
 
 !
-! $Id: conf_phys.F90 1423 2010-08-02 14:52:29Z jghattas $
+! $Id: conf_phys.F90 1486 2011-02-11 12:07:39Z fairhead $
 !
 !
@@ -13,4 +13,5 @@
   subroutine conf_phys(ok_journe, ok_mensuel, ok_instan, ok_hf, &
                        ok_LES,&
+                       callstats,&
                        solarlong0,seuil_inversion, &
                        fact_cldcon, facttemps,ok_newmicro,iflag_radia,&
@@ -66,4 +67,5 @@
   logical              :: ok_journe, ok_mensuel, ok_instan, ok_hf
   logical              :: ok_LES
+  LOGICAL              :: callstats
   LOGICAL              :: ok_ade, ok_aie, aerosol_couple
   INTEGER              :: flag_aerosol
@@ -79,4 +81,5 @@
   logical,SAVE        :: ok_journe_omp, ok_mensuel_omp, ok_instan_omp, ok_hf_omp        
   logical,SAVE        :: ok_LES_omp   
+  LOGICAL,SAVE        :: callstats_omp
   LOGICAL,SAVE        :: ok_ade_omp, ok_aie_omp, aerosol_couple_omp
   INTEGER, SAVE       :: flag_aerosol_omp
@@ -1418,4 +1421,13 @@
   ok_LES_omp = .false.                                              
   call getin('OK_LES', ok_LES_omp)                                  
+
+!Config Key  = callstats                                               
+!Config Desc = Pour des sorties callstats                                 
+!Config Def  = .false.                                              
+!Config Help = Pour creer le fichier stats contenant les sorties  
+!              stats                                                  
+!                                                                   
+  callstats_omp = .false.                                              
+  call getin('callstats', callstats_omp)                                  
 !
 !Config Key  = ecrit_LES
@@ -1581,4 +1593,5 @@
     ok_hines = ok_hines_omp
     ok_LES = ok_LES_omp
+    callstats = callstats_omp
     ecrit_LES = ecrit_LES_omp
     carbon_cycle_tr = carbon_cycle_tr_omp
Index: trunk/libf/phylmd/cpl_mod.F90
===================================================================
--- trunk/libf/phylmd/cpl_mod.F90	(revision 53)
+++ trunk/libf/phylmd/cpl_mod.F90	(revision 66)
@@ -100,4 +100,5 @@
   SUBROUTINE cpl_init(dtime, rlon, rlat)
     USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
+    USE surface_data
 
     INCLUDE "dimensions.h"
@@ -270,4 +271,14 @@
     ENDIF    ! is_sequential
     
+
+!*************************************************************************************
+! compatibility test
+!
+!*************************************************************************************
+    IF (carbon_cycle_cpl .AND. version_ocean=='opa8') THEN
+       abort_message='carbon_cycle_cpl does not work with opa8'
+       CALL abort_gcm(modname,abort_message,1)
+    END IF
+
   END SUBROUTINE cpl_init
   
Index: trunk/libf/phylmd/cv3_routines.F
===================================================================
--- trunk/libf/phylmd/cv3_routines.F	(revision 53)
+++ trunk/libf/phylmd/cv3_routines.F	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: cv3_routines.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id: cv3_routines.F 1467 2010-12-17 11:17:22Z idelkadi $
 !
 c
@@ -89,4 +89,20 @@
 
       betad=10.0   ! original value (from convect 4.3)
+
+      OPEN(99,file='conv_param.data',status='old',
+     $          form='formatted',err=9999)
+      READ(99,*,end=9998) dpbase
+      READ(99,*,end=9998) pbcrit
+      READ(99,*,end=9998) ptcrit
+      READ(99,*,end=9998) sigdz
+      READ(99,*,end=9998) spfac
+9998  Continue
+      CLOSE(99)
+9999  Continue
+      WRITE(*,*)'dpbase=',dpbase
+      WRITE(*,*)'pbcrit=',pbcrit
+      WRITE(*,*)'ptcrit=',ptcrit
+      WRITE(*,*)'sigdz=',sigdz
+      WRITE(*,*)'spfac=',spfac
 
       return
Index: trunk/libf/phylmd/fisrtilp.F
===================================================================
--- trunk/libf/phylmd/fisrtilp.F	(revision 53)
+++ 	(revision )
@@ -1,612 +1,0 @@
-!
-! $Id: fisrtilp.F 1411 2010-07-09 11:06:15Z idelkadi $
-!
-c
-      SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs,
-     s                   d_t, d_q, d_ql, rneb, radliq, rain, snow,
-     s                   pfrac_impa, pfrac_nucl, pfrac_1nucl,
-     s                   frac_impa, frac_nucl,
-     s                   prfl, psfl, rhcl, zqta, fraca,
-     s                   ztv, zpspsk, ztla, zthl, iflag_cldcon)
-
-c
-      USE dimphy
-      IMPLICIT none
-c======================================================================
-c Auteur(s): Z.X. Li (LMD/CNRS)
-c Date: le 20 mars 1995
-c Objet: condensation et precipitation stratiforme.
-c        schema de nuage
-c======================================================================
-c======================================================================
-cym#include "dimensions.h"
-cym#include "dimphy.h"
-#include "YOMCST.h"
-#include "tracstoke.h"
-#include "fisrtilp.h"
-c
-c Arguments:
-c
-      REAL dtime ! intervalle du temps (s)
-      REAL paprs(klon,klev+1) ! pression a inter-couche
-      REAL pplay(klon,klev) ! pression au milieu de couche
-      REAL t(klon,klev) ! temperature (K)
-      REAL q(klon,klev) ! humidite specifique (kg/kg)
-      REAL d_t(klon,klev) ! incrementation de la temperature (K)
-      REAL d_q(klon,klev) ! incrementation de la vapeur d'eau
-      REAL d_ql(klon,klev) ! incrementation de l'eau liquide
-      REAL rneb(klon,klev) ! fraction nuageuse
-      REAL radliq(klon,klev) ! eau liquide utilisee dans rayonnements
-      REAL rhcl(klon,klev) ! humidite relative en ciel clair
-      REAL rain(klon) ! pluies (mm/s)
-      REAL snow(klon) ! neige (mm/s)
-      REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-      REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 
-      REAL ztv(klon,klev)
-      REAL zqta(klon,klev),fraca(klon,klev) 
-      REAL sigma1(klon,klev),sigma2(klon,klev)
-      REAL qltot(klon,klev),ctot(klon,klev)
-      REAL zpspsk(klon,klev),ztla(klon,klev)
-      REAL zthl(klon,klev)
-
-      logical lognormale(klon)
-
-cAA
-c Coeffients de fraction lessivee : pour OFF-LINE
-c
-      REAL pfrac_nucl(klon,klev)
-      REAL pfrac_1nucl(klon,klev)
-      REAL pfrac_impa(klon,klev)
-c
-c Fraction d'aerosols lessivee par impaction et par nucleation
-c POur ON-LINE
-c
-      REAL frac_impa(klon,klev)
-      REAL frac_nucl(klon,klev)
-      real zct      ,zcl
-cAA
-c
-c Options du programme:
-c
-      REAL seuil_neb ! un nuage existe vraiment au-dela
-      PARAMETER (seuil_neb=0.001)
-
-      INTEGER ninter ! sous-intervals pour la precipitation
-      INTEGER ncoreczq  
-      INTEGER iflag_cldcon
-      PARAMETER (ninter=5)
-      LOGICAL evap_prec ! evaporation de la pluie
-      PARAMETER (evap_prec=.TRUE.)
-      REAL ratqs(klon,klev) ! determine la largeur de distribution de vapeur
-      logical ptconv(klon,klev) ! determine la largeur de distribution de vapeur
-
-      real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
-      real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
-      real erf   
-      REAL qcloud(klon)
-c
-      LOGICAL cpartiel ! condensation partielle
-      PARAMETER (cpartiel=.TRUE.)
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
-c
-c Variables locales:
-c
-      INTEGER i, k, n, kk
-      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5   
-      REAL zrfl(klon), zrfln(klon), zqev, zqevt
-      REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
-      REAL ztglace, zt(klon)
-      INTEGER nexpo ! exponentiel pour glace/eau
-      REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
-      REAL zchau      ,zfroi      ,zfice(klon),zneb(klon)
-c
-      LOGICAL appel1er
-      SAVE appel1er
-c$OMP THREADPRIVATE(appel1er)
-c
-c---------------------------------------------------------------
-c
-cAA Variables traceurs:
-cAA  Provisoire !!! Parametres alpha du lessivage
-cAA  A priori on a 4 scavenging # possibles
-c
-      REAL a_tr_sca(4)
-      save a_tr_sca
-c$OMP THREADPRIVATE(a_tr_sca)
-c
-c Variables intermediaires
-c
-      REAL zalpha_tr
-      REAL zfrac_lessi
-      REAL zprec_cond(klon)
-cAA
-      REAL zmair, zcpair, zcpeau
-C     Pour la conversion eau-neige
-      REAL zlh_solid(klon), zm_solid
-cIM 
-cym      INTEGER klevm1
-c---------------------------------------------------------------
-c
-c Fonctions en ligne:
-c
-      REAL fallvs,fallvc ! vitesse de chute pour crystaux de glace
-      REAL zzz
-#include "YOETHF.h"
-#include "FCTTRE.h"
-      fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
-      fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
-c
-      DATA appel1er /.TRUE./
-cym
-      zdelq=0.0
-      
-      print*,'NUAGES4 A. JAM'
-      IF (appel1er) THEN
-c
-         PRINT*, 'fisrtilp, ninter:', ninter
-         PRINT*, 'fisrtilp, evap_prec:', evap_prec
-         PRINT*, 'fisrtilp, cpartiel:', cpartiel
-         IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
-          PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
-          PRINT*, 'Je prefere un sous-intervalle de 6 minutes'
-c         CALL abort
-         ENDIF
-         appel1er = .FALSE.
-c
-cAA initialiation provisoire
-       a_tr_sca(1) = -0.5
-       a_tr_sca(2) = -0.5
-       a_tr_sca(3) = -0.5
-       a_tr_sca(4) = -0.5
-c
-cAA Initialisation a 1 des coefs des fractions lessivees 
-c
-!cdir collapse
-      DO k = 1, klev
-       DO i = 1, klon
-          pfrac_nucl(i,k)=1.
-          pfrac_1nucl(i,k)=1.
-          pfrac_impa(i,k)=1.
-       ENDDO 
-      ENDDO 
-
-      ENDIF          !  test sur appel1er
-c
-cMAf Initialisation a 0 de zoliq
-c      DO i = 1, klon
-c         zoliq(i)=0.
-c      ENDDO 
-c Determiner les nuages froids par leur temperature
-c  nexpo regle la raideur de la transition eau liquide / eau glace.
-c
-      ztglace = RTT - 15.0
-      nexpo = 6
-ccc      nexpo = 1
-c
-c Initialiser les sorties:
-c
-!cdir collapse
-      DO k = 1, klev+1
-      DO i = 1, klon
-         prfl(i,k) = 0.0
-         psfl(i,k) = 0.0
-      ENDDO
-      ENDDO
-
-!cdir collapse
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_q(i,k) = 0.0
-         d_ql(i,k) = 0.0
-         rneb(i,k) = 0.0
-         radliq(i,k) = 0.0
-         frac_nucl(i,k) = 1. 
-         frac_impa(i,k) = 1. 
-      ENDDO
-      ENDDO
-      DO i = 1, klon
-         rain(i) = 0.0
-         snow(i) = 0.0
-         zoliq(i)=0.
-c     ENDDO
-c
-c Initialiser le flux de precipitation a zero
-c
-c     DO i = 1, klon
-         zrfl(i) = 0.0
-         zneb(i) = seuil_neb
-      ENDDO
-c
-c
-cAA Pour plus de securite 
-
-      zalpha_tr   = 0.
-      zfrac_lessi = 0.
-
-cAA----------------------------------------------------------
-c
-      ncoreczq=0
-c Boucle verticale (du haut vers le bas)
-c
-cIM : klevm1
-cym      klevm1=klev-1
-      DO 9999 k = klev, 1, -1
-c
-cAA----------------------------------------------------------
-c
-      DO i = 1, klon
-         zt(i)=t(i,k)
-         zq(i)=q(i,k)
-      ENDDO
-c
-c Calculer la varition de temp. de l'air du a la chaleur sensible
-C transporter par la pluie.
-C Il resterait a rajouter cet effet de la chaleur sensible sur les
-C flux de surface, du a la diff. de temp. entre le 1er niveau et la
-C surface.
-C
-      IF(k.LE.klevm1) THEN         
-         DO i = 1, klon
-cIM
-            zmair=(paprs(i,k)-paprs(i,k+1))/RG
-            zcpair=RCPD*(1.0+RVTMP2*zq(i))
-            zcpeau=RCPD*RVTMP2
-            zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau
-     $           + zmair*zcpair*zt(i) )
-     $           / (zmair*zcpair + zrfl(i)*dtime*zcpeau)
-C     C        WRITE (6,*) 'cppluie ', zt(i)-(t(i,k+1)+d_t(i,k+1))
-         ENDDO
-      ENDIF
-c
-c
-c Calculer l'evaporation de la precipitation
-c
-
-
-      IF (evap_prec) THEN
-      DO i = 1, klon
-      IF (zrfl(i) .GT.0.) THEN
-         IF (thermcep) THEN
-           zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
-           zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i)=MIN(0.5,zqs(i))
-           zcor=1./(1.-RETV*zqs(i))
-           zqs(i)=zqs(i)*zcor
-         ELSE
-           IF (zt(i) .LT. t_coup) THEN
-              zqs(i) = qsats(zt(i)) / pplay(i,k)
-           ELSE
-              zqs(i) = qsatl(zt(i)) / pplay(i,k)
-           ENDIF
-         ENDIF
-         zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
-         zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i))
-     .         * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
-         zqevt = MAX(0.0,MIN(zqevt,zrfl(i)))
-     .         * RG*dtime/(paprs(i,k)-paprs(i,k+1))
-         zqev = MIN (zqev, zqevt)
-         zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1))
-     .                            /RG/dtime
-
-c pour la glace, on rï¿½vapore toute la prï¿½ip dans la couche du dessous
-c la glace venant de la couche du dessus est simplement dans la couche
-c du dessous.
-
-         IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0.
-
-         zq(i) = zq(i) - (zrfln(i)-zrfl(i))
-     .             * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-         zt(i) = zt(i) + (zrfln(i)-zrfl(i))
-     .             * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
-     .             * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-         zrfl(i) = zrfln(i)
-      ENDIF
-      ENDDO
-      ENDIF
-c
-c Calculer Qs et L/Cp*dQs/dT:
-c
-      IF (thermcep) THEN
-         DO i = 1, klon
-           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
-           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
-           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
-           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
-           zqs(i) = MIN(0.5,zqs(i))
-           zcor = 1./(1.-RETV*zqs(i))
-           zqs(i) = zqs(i)*zcor
-           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
-         ENDDO
-      ELSE
-         DO i = 1, klon
-            IF (zt(i).LT.t_coup) THEN
-               zqs(i) = qsats(zt(i))/pplay(i,k)
-               zdqs(i) = dqsats(zt(i),zqs(i))
-            ELSE
-               zqs(i) = qsatl(zt(i))/pplay(i,k)
-               zdqs(i) = dqsatl(zt(i),zqs(i))
-            ENDIF
-         ENDDO
-      ENDIF
-c
-c Determiner la condensation partielle et calculer la quantite
-c de l'eau condensee:
-c
-
-      IF (cpartiel) THEN
-
-c        print*,'Dans partiel k=',k
-c
-c   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
-c   nuageuse a partir des PDF de Sandrine Bony.
-c   rneb  : fraction nuageuse
-c   zqn   : eau totale dans le nuage
-c   zcond : eau condensee moyenne dans la maille.
-c           on prend en compte le rï¿½hauffement qui diminue la partie condensee
-c
-c   Version avec les raqts
-
-         if (iflag_pdf.eq.0) then
-
-           do i=1,klon
-            zdelq = min(ratqs(i,k),0.99) * zq(i)
-            rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
-            zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
-           enddo
-
-         else
-c
-c   Version avec les nouvelles PDFs.
-           do i=1,klon
-              if(zq(i).lt.1.e-15) then
-                ncoreczq=ncoreczq+1
-                zq(i)=1.e-15
-              endif
-           enddo 
-
-              if (iflag_cldcon>=5) then
-
-                 call cloudth(klon,klev,k,ztv,
-     .           zq,zqta,fraca,
-     .           qcloud,ctot,zpspsk,paprs,ztla,zthl,
-     .           ratqs,zqs,t)
-
-                 do i=1,klon
-                 rneb(i,k)=ctot(i,k)
-                 zqn(i)=qcloud(i)
-                 enddo
-
-              endif
-
-! Pour iflag_cldcon<=4, on prend toujours la lognormale
-! Dans le cas iflag_cldcon=5, on prend systÃ©matiquement la bi-gaussienne
-! Dans le cas iflagÃ_cldcon=6, on prend la lognormale en absence des thermiques
-
-            lognormale(:)=
-     .      iflag_cldcon<=4.or.(iflag_cldcon==6.and.fraca(:,k)<1.e-10)
-            do i=1,klon
-            if (lognormale(i)) then
-            zpdf_sig(i)=ratqs(i,k)*zq(i)
-            zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
-            zpdf_delta(i)=log(zq(i)/zqs(i))
-            zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
-            zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
-            zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
-            zpdf_e1(i)=sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))
-            zpdf_e1(i)=1.-erf(zpdf_e1(i))
-            zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
-            zpdf_e2(i)=sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))
-            zpdf_e2(i)=1.-erf(zpdf_e2(i))
-            endif
-            enddo
-
-            do i=1,klon
-            if (lognormale(i)) then
-            if (zpdf_e1(i).lt.1.e-10) then
-               rneb(i,k)=0.
-               zqn(i)=zqs(i)
-            else
-               rneb(i,k)=0.5*zpdf_e1(i)
-               zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
-            endif
-            endif
-            
-           enddo 
-
-
-        endif ! iflag_pdf
-
-        DO i=1,klon
-           IF (rneb(i,k) .LE. 0.0) THEN
-              zqn(i) = 0.0
-              rneb(i,k) = 0.0
-              zcond(i) = 0.0
-              rhcl(i,k)=zq(i)/zqs(i)
-           ELSE IF (rneb(i,k) .GE. 1.0) THEN
-              zqn(i) = zq(i)
-              rneb(i,k) = 1.0                  
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
-              rhcl(i,k)=1.0
-           ELSE
-              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
-              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
-           ENDIF
-        ENDDO
-!         do i=1,klon
-!            IF (rneb(i,k) .LE. 0.0) zqn(i) = 0.0
-!            IF (rneb(i,k) .GE. 1.0) zqn(i) = zq(i)
-!            rneb(i,k) = MAX(0.0,MIN(1.0,rneb(i,k)))
-!c           zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i))
-!c  On ne divise pas par 1+zdqs pour forcer a avoir l'eau predite par
-!c  la convection.
-!c  ATTENTION !!! Il va falloir verifier tout ca.
-!            zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
-!c           print*,'ZDQS ',zdqs(i)
-!c--Olivier
-!            rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
-!            IF (rneb(i,k) .LE. 0.0) rhcl(i,k)=zq(i)/zqs(i)
-!            IF (rneb(i,k) .GE. 1.0) rhcl(i,k)=1.0
-!c--fin
-!           ENDDO
-      ELSE
-         DO i = 1, klon
-            IF (zq(i).GT.zqs(i)) THEN
-               rneb(i,k) = 1.0
-            ELSE
-               rneb(i,k) = 0.0
-            ENDIF
-            zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
-         ENDDO
-      ENDIF
-c
-      DO i = 1, klon
-         zq(i) = zq(i) - zcond(i)
-c         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
-         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
-      ENDDO
-c
-c Partager l'eau condensee en precipitation et eau liquide nuageuse
-c
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         zoliq(i) = zcond(i)
-         zrho(i) = pplay(i,k) / zt(i) / RD
-         zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
-         zfice(i) = 1.0 - (zt(i)-ztglace) / (273.13-ztglace)
-         zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
-         zfice(i) = zfice(i)**nexpo
-         zneb(i) = MAX(rneb(i,k), seuil_neb)
-         radliq(i,k) = zoliq(i)/REAL(ninter+1)
-      ENDIF
-      ENDDO
-c
-      DO n = 1, ninter
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
-
-         IF (zneb(i).EQ.seuil_neb) THEN
-             ztot = 0.0
-         ELSE
-c  quantite d'eau a eliminer: zchau
-c  meme chose pour la glace: zfroi
-             if (ptconv(i,k)) then
-                zcl   =cld_lc_con
-                zct   =1./cld_tau_con
-                zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i)
-     .              *fallvc(zrhol(i)) * zfice(i)
-             else
-                zcl   =cld_lc_lsc
-                zct   =1./cld_tau_lsc
-                zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i)
-     .              *fallvs(zrhol(i)) * zfice(i)
-             endif
-             zchau    = zct   *dtime/REAL(ninter) * zoliq(i)
-     .         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
-             ztot    = zchau    + zfroi
-             ztot    = MAX(ztot   ,0.0)
-         ENDIF
-         ztot    = MIN(ztot,zoliq(i))
-         zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
-         radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
-      ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1, klon
-      IF (rneb(i,k).GT.0.0) THEN
-         d_ql(i,k) = zoliq(i)
-         zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0)
-     .                    * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
-      ENDIF
-      IF (zt(i).LT.RTT) THEN
-        psfl(i,k)=zrfl(i)
-      ELSE
-        prfl(i,k)=zrfl(i)
-      ENDIF
-      ENDDO
-c
-c Calculer les tendances de q et de t:
-c
-      DO i = 1, klon
-         d_q(i,k) = zq(i) - q(i,k)
-         d_t(i,k) = zt(i) - t(i,k)
-      ENDDO
-c
-cAA--------------- Calcul du lessivage stratiforme  -------------
-
-      DO i = 1,klon
-c
-         zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0)
-     .                * (paprs(i,k)-paprs(i,k+1))/RG
-         IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-cAA lessivage nucleation LMD5 dans la couche elle-meme
-            if (t(i,k) .GE. ztglace) THEN
-               zalpha_tr = a_tr_sca(3)
-            else
-               zalpha_tr = a_tr_sca(4)
-            endif
-            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-            pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-            frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
-c
-c nucleation avec un facteur -1 au lieu de -0.5
-            zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
-            pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
-         ENDIF
-c
-      ENDDO      ! boucle sur i
-c
-cAA Lessivage par impaction dans les couches en-dessous
-      DO kk = k-1, 1, -1
-        DO i = 1, klon
-          IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
-            if (t(i,kk) .GE. ztglace) THEN
-              zalpha_tr = a_tr_sca(1)
-            else
-              zalpha_tr = a_tr_sca(2)
-            endif
-            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
-            pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
-            frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
-          ENDIF
-        ENDDO
-      ENDDO
-c
-cAA----------------------------------------------------------
-c                     FIN DE BOUCLE SUR K   
- 9999 CONTINUE
-c
-cAA-----------------------------------------------------------
-c
-c Pluie ou neige au sol selon la temperature de la 1ere couche
-c
-      DO i = 1, klon
-      IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
-         snow(i) = zrfl(i)
-         zlh_solid(i) = RLSTT-RLVTT
-      ELSE
-         rain(i) = zrfl(i)
-         zlh_solid(i) = 0.
-      ENDIF
-      ENDDO
-C
-C For energy conservation : when snow is present, the solification
-c latent heat is considered.
-      DO k = 1, klev
-        DO i = 1, klon
-          zcpair=RCPD*(1.0+RVTMP2*(q(i,k)+d_q(i,k)))
-          zmair=(paprs(i,k)-paprs(i,k+1))/RG
-          zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime
-          d_t(i,k) = d_t(i,k) + zlh_solid(i) *zm_solid / (zcpair*zmair)
-        END DO 
-      END DO
-c
-
-      if (ncoreczq>0) then
-         print*,'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
-      endif
-      RETURN
-      END
Index: trunk/libf/phylmd/fisrtilp.F90
===================================================================
--- trunk/libf/phylmd/fisrtilp.F90	(revision 66)
+++ trunk/libf/phylmd/fisrtilp.F90	(revision 66)
@@ -0,0 +1,619 @@
+!
+! $Id: fisrtilp.F90 1472 2010-12-23 16:38:42Z lguez $
+!
+!
+SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,ptconv,ratqs, &
+     d_t, d_q, d_ql, rneb, radliq, rain, snow, &
+     pfrac_impa, pfrac_nucl, pfrac_1nucl, &
+     frac_impa, frac_nucl, &
+     prfl, psfl, rhcl, zqta, fraca, &
+     ztv, zpspsk, ztla, zthl, iflag_cldcon)
+
+  !
+  USE dimphy
+  IMPLICIT none
+  !======================================================================
+  ! Auteur(s): Z.X. Li (LMD/CNRS)
+  ! Date: le 20 mars 1995
+  ! Objet: condensation et precipitation stratiforme.
+  !        schema de nuage
+  !======================================================================
+  !======================================================================
+  !ym include "dimensions.h"
+  !ym include "dimphy.h"
+  include "YOMCST.h"
+  include "tracstoke.h"
+  include "fisrtilp.h"
+  !
+  ! Arguments:
+  !
+  REAL dtime ! intervalle du temps (s)
+  REAL paprs(klon,klev+1) ! pression a inter-couche
+  REAL pplay(klon,klev) ! pression au milieu de couche
+  REAL t(klon,klev) ! temperature (K)
+  REAL q(klon,klev) ! humidite specifique (kg/kg)
+  REAL d_t(klon,klev) ! incrementation de la temperature (K)
+  REAL d_q(klon,klev) ! incrementation de la vapeur d'eau
+  REAL d_ql(klon,klev) ! incrementation de l'eau liquide
+  REAL rneb(klon,klev) ! fraction nuageuse
+  REAL radliq(klon,klev) ! eau liquide utilisee dans rayonnements
+  REAL rhcl(klon,klev) ! humidite relative en ciel clair
+  REAL rain(klon) ! pluies (mm/s)
+  REAL snow(klon) ! neige (mm/s)
+  REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
+  REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 
+  REAL ztv(klon,klev)
+  REAL zqta(klon,klev),fraca(klon,klev) 
+  REAL sigma1(klon,klev),sigma2(klon,klev)
+  REAL qltot(klon,klev),ctot(klon,klev)
+  REAL zpspsk(klon,klev),ztla(klon,klev)
+  REAL zthl(klon,klev)
+
+  logical lognormale(klon)
+
+  !AA
+  ! Coeffients de fraction lessivee : pour OFF-LINE
+  !
+  REAL pfrac_nucl(klon,klev)
+  REAL pfrac_1nucl(klon,klev)
+  REAL pfrac_impa(klon,klev)
+  !
+  ! Fraction d'aerosols lessivee par impaction et par nucleation
+  ! POur ON-LINE
+  !
+  REAL frac_impa(klon,klev)
+  REAL frac_nucl(klon,klev)
+  real zct      ,zcl
+  !AA
+  !
+  ! Options du programme:
+  !
+  REAL seuil_neb ! un nuage existe vraiment au-dela
+  PARAMETER (seuil_neb=0.001)
+
+  INTEGER ninter ! sous-intervals pour la precipitation
+  INTEGER ncoreczq  
+  INTEGER iflag_cldcon
+  PARAMETER (ninter=5)
+  LOGICAL evap_prec ! evaporation de la pluie
+  PARAMETER (evap_prec=.TRUE.)
+  REAL ratqs(klon,klev) ! determine la largeur de distribution de vapeur
+  logical ptconv(klon,klev) ! determine la largeur de distribution de vapeur
+
+  real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
+  real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
+  real erf   
+  REAL qcloud(klon)
+  !
+  LOGICAL cpartiel ! condensation partielle
+  PARAMETER (cpartiel=.TRUE.)
+  REAL t_coup
+  PARAMETER (t_coup=234.0)
+  !
+  ! Variables locales:
+  !
+  INTEGER i, k, n, kk
+  REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5   
+  REAL zrfl(klon), zrfln(klon), zqev, zqevt
+  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
+  REAL ztglace, zt(klon)
+  INTEGER nexpo ! exponentiel pour glace/eau
+  REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
+  REAL zchau      ,zfroi      ,zfice(klon),zneb(klon)
+  !
+  LOGICAL appel1er
+  SAVE appel1er
+  !$OMP THREADPRIVATE(appel1er)
+  !
+  !---------------------------------------------------------------
+  !
+  !AA Variables traceurs:
+  !AA  Provisoire !!! Parametres alpha du lessivage
+  !AA  A priori on a 4 scavenging # possibles
+  !
+  REAL a_tr_sca(4)
+  save a_tr_sca
+  !$OMP THREADPRIVATE(a_tr_sca)
+  !
+  ! Variables intermediaires
+  !
+  REAL zalpha_tr
+  REAL zfrac_lessi
+  REAL zprec_cond(klon)
+  !AA
+  REAL zmair, zcpair, zcpeau
+  !     Pour la conversion eau-neige
+  REAL zlh_solid(klon), zm_solid
+  !IM 
+  !ym      INTEGER klevm1
+  !---------------------------------------------------------------
+  !
+  ! Fonctions en ligne:
+  !
+  REAL fallvs,fallvc ! vitesse de chute pour crystaux de glace
+  REAL zzz
+  include "YOETHF.h"
+  include "FCTTRE.h"
+  fallvc (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_con
+  fallvs (zzz) = 3.29/2.0 * ((zzz)**0.16) * ffallv_lsc
+  !
+  DATA appel1er /.TRUE./
+  !ym
+  zdelq=0.0
+
+  print*,'NUAGES4 A. JAM'
+  IF (appel1er) THEN
+     !
+     PRINT*, 'fisrtilp, ninter:', ninter
+     PRINT*, 'fisrtilp, evap_prec:', evap_prec
+     PRINT*, 'fisrtilp, cpartiel:', cpartiel
+     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
+        PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
+        PRINT*, 'Je prefere un sous-intervalle de 6 minutes'
+        !         CALL abort
+     ENDIF
+     appel1er = .FALSE.
+     !
+     !AA initialiation provisoire
+     a_tr_sca(1) = -0.5
+     a_tr_sca(2) = -0.5
+     a_tr_sca(3) = -0.5
+     a_tr_sca(4) = -0.5
+     !
+     !AA Initialisation a 1 des coefs des fractions lessivees 
+     !
+     !cdir collapse
+     DO k = 1, klev
+        DO i = 1, klon
+           pfrac_nucl(i,k)=1.
+           pfrac_1nucl(i,k)=1.
+           pfrac_impa(i,k)=1.
+        ENDDO
+     ENDDO
+
+  ENDIF          !  test sur appel1er
+  !
+  !MAf Initialisation a 0 de zoliq
+  !      DO i = 1, klon
+  !         zoliq(i)=0.
+  !      ENDDO 
+  ! Determiner les nuages froids par leur temperature
+  !  nexpo regle la raideur de la transition eau liquide / eau glace.
+  !
+  ztglace = RTT - 15.0
+  nexpo = 6
+  !cc      nexpo = 1
+  !
+  ! Initialiser les sorties:
+  !
+  !cdir collapse
+  DO k = 1, klev+1
+     DO i = 1, klon
+        prfl(i,k) = 0.0
+        psfl(i,k) = 0.0
+     ENDDO
+  ENDDO
+
+  !cdir collapse
+  DO k = 1, klev
+     DO i = 1, klon
+        d_t(i,k) = 0.0
+        d_q(i,k) = 0.0
+        d_ql(i,k) = 0.0
+        rneb(i,k) = 0.0
+        radliq(i,k) = 0.0
+        frac_nucl(i,k) = 1. 
+        frac_impa(i,k) = 1. 
+     ENDDO
+  ENDDO
+  DO i = 1, klon
+     rain(i) = 0.0
+     snow(i) = 0.0
+     zoliq(i)=0.
+     !     ENDDO
+     !
+     ! Initialiser le flux de precipitation a zero
+     !
+     !     DO i = 1, klon
+     zrfl(i) = 0.0
+     zneb(i) = seuil_neb
+  ENDDO
+  !
+  !
+  !AA Pour plus de securite 
+
+  zalpha_tr   = 0.
+  zfrac_lessi = 0.
+
+  !AA----------------------------------------------------------
+  !
+  ncoreczq=0
+  ! Boucle verticale (du haut vers le bas)
+  !
+  !IM : klevm1
+  !ym      klevm1=klev-1
+  DO k = klev, 1, -1
+     !
+     !AA----------------------------------------------------------
+     !
+     DO i = 1, klon
+        zt(i)=t(i,k)
+        zq(i)=q(i,k)
+     ENDDO
+     !
+     ! Calculer la varition de temp. de l'air du a la chaleur sensible
+     ! transporter par la pluie.
+     ! Il resterait a rajouter cet effet de la chaleur sensible sur les
+     ! flux de surface, du a la diff. de temp. entre le 1er niveau et la
+     ! surface.
+     !
+     IF(k.LE.klevm1) THEN         
+        DO i = 1, klon
+           !IM
+           zmair=(paprs(i,k)-paprs(i,k+1))/RG
+           zcpair=RCPD*(1.0+RVTMP2*zq(i))
+           zcpeau=RCPD*RVTMP2
+           zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau &
+                + zmair*zcpair*zt(i) ) &
+                / (zmair*zcpair + zrfl(i)*dtime*zcpeau)
+           !     C        WRITE (6,*) 'cppluie ', zt(i)-(t(i,k+1)+d_t(i,k+1))
+        ENDDO
+     ENDIF
+     !
+     !
+     ! Calculer l'evaporation de la precipitation
+     !
+
+
+     IF (evap_prec) THEN
+        DO i = 1, klon
+           IF (zrfl(i) .GT.0.) THEN
+              IF (thermcep) THEN
+                 zdelta=MAX(0.,SIGN(1.,RTT-zt(i)))
+                 zqs(i)= R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
+                 zqs(i)=MIN(0.5,zqs(i))
+                 zcor=1./(1.-RETV*zqs(i))
+                 zqs(i)=zqs(i)*zcor
+              ELSE
+                 IF (zt(i) .LT. t_coup) THEN
+                    zqs(i) = qsats(zt(i)) / pplay(i,k)
+                 ELSE
+                    zqs(i) = qsatl(zt(i)) / pplay(i,k)
+                 ENDIF
+              ENDIF
+              zqev = MAX (0.0, (zqs(i)-zq(i))*zneb(i) )
+              zqevt = coef_eva * (1.0-zq(i)/zqs(i)) * SQRT(zrfl(i)) &
+                   * (paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
+              zqevt = MAX(0.0,MIN(zqevt,zrfl(i))) &
+                   * RG*dtime/(paprs(i,k)-paprs(i,k+1))
+              zqev = MIN (zqev, zqevt)
+              zrfln(i) = zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
+                   /RG/dtime
+
+              ! pour la glace, on ré-évapore toute la précip dans la
+              ! couche du dessous
+              ! la glace venant de la couche du dessus est simplement
+              ! dans la couche du dessous.
+
+              IF (zt(i) .LT. t_coup.and.reevap_ice) zrfln(i)=0.
+
+              zq(i) = zq(i) - (zrfln(i)-zrfl(i)) &
+                   * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime
+              zt(i) = zt(i) + (zrfln(i)-zrfl(i)) &
+                   * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime &
+                   * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
+              zrfl(i) = zrfln(i)
+           ENDIF
+        ENDDO
+     ENDIF
+     !
+     ! Calculer Qs et L/Cp*dQs/dT:
+     !
+     IF (thermcep) THEN
+        DO i = 1, klon
+           zdelta = MAX(0.,SIGN(1.,RTT-zt(i)))
+           zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta
+           zcvm5 = zcvm5 /RCPD/(1.0+RVTMP2*zq(i))
+           zqs(i) = R2ES*FOEEW(zt(i),zdelta)/pplay(i,k)
+           zqs(i) = MIN(0.5,zqs(i))
+           zcor = 1./(1.-RETV*zqs(i))
+           zqs(i) = zqs(i)*zcor
+           zdqs(i) = FOEDE(zt(i),zdelta,zcvm5,zqs(i),zcor)
+        ENDDO
+     ELSE
+        DO i = 1, klon
+           IF (zt(i).LT.t_coup) THEN
+              zqs(i) = qsats(zt(i))/pplay(i,k)
+              zdqs(i) = dqsats(zt(i),zqs(i))
+           ELSE
+              zqs(i) = qsatl(zt(i))/pplay(i,k)
+              zdqs(i) = dqsatl(zt(i),zqs(i))
+           ENDIF
+        ENDDO
+     ENDIF
+     !
+     ! Determiner la condensation partielle et calculer la quantite
+     ! de l'eau condensee:
+     !
+
+     IF (cpartiel) THEN
+
+        !        print*,'Dans partiel k=',k
+        !
+        !   Calcul de l'eau condensee et de la fraction nuageuse et de l'eau
+        !   nuageuse a partir des PDF de Sandrine Bony.
+        !   rneb  : fraction nuageuse
+        !   zqn   : eau totale dans le nuage
+        !   zcond : eau condensee moyenne dans la maille.
+        !  on prend en compte le réchauffement qui diminue la partie
+        ! condensee
+        !
+        !   Version avec les raqts
+
+        if (iflag_pdf.eq.0) then
+
+           do i=1,klon
+              zdelq = min(ratqs(i,k),0.99) * zq(i)
+              rneb(i,k) = (zq(i)+zdelq-zqs(i)) / (2.0*zdelq)
+              zqn(i) = (zq(i)+zdelq+zqs(i))/2.0
+           enddo
+
+        else
+           !
+           !   Version avec les nouvelles PDFs.
+           do i=1,klon
+              if(zq(i).lt.1.e-15) then
+                 ncoreczq=ncoreczq+1
+                 zq(i)=1.e-15
+              endif
+           enddo
+
+           if (iflag_cldcon>=5) then
+
+              call cloudth(klon,klev,k,ztv, &
+                   zq,zqta,fraca, &
+                   qcloud,ctot,zpspsk,paprs,ztla,zthl, &
+                   ratqs,zqs,t)
+
+              do i=1,klon
+                 rneb(i,k)=ctot(i,k)
+                 zqn(i)=qcloud(i)
+              enddo
+
+           endif
+
+           if (iflag_cldcon <= 4) then
+              lognormale = .true.
+           elseif (iflag_cldcon == 6) then
+              ! lognormale en l'absence des thermiques
+              lognormale = fraca(:,k) < 1e-10
+           else
+              ! Dans le cas iflag_cldcon=5, on prend systématiquement la
+              ! bi-gaussienne
+              lognormale = .false.
+           end if
+
+           do i=1,klon
+              if (lognormale(i)) then
+                 zpdf_sig(i)=ratqs(i,k)*zq(i)
+                 zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
+                 zpdf_delta(i)=log(zq(i)/zqs(i))
+                 zpdf_a(i)=zpdf_delta(i)/(zpdf_k(i)*sqrt(2.))
+                 zpdf_b(i)=zpdf_k(i)/(2.*sqrt(2.))
+                 zpdf_e1(i)=zpdf_a(i)-zpdf_b(i)
+                 zpdf_e1(i)=sign(min(abs(zpdf_e1(i)),5.),zpdf_e1(i))
+                 zpdf_e1(i)=1.-erf(zpdf_e1(i))
+                 zpdf_e2(i)=zpdf_a(i)+zpdf_b(i)
+                 zpdf_e2(i)=sign(min(abs(zpdf_e2(i)),5.),zpdf_e2(i))
+                 zpdf_e2(i)=1.-erf(zpdf_e2(i))
+              endif
+           enddo
+
+           do i=1,klon
+              if (lognormale(i)) then
+                 if (zpdf_e1(i).lt.1.e-10) then
+                    rneb(i,k)=0.
+                    zqn(i)=zqs(i)
+                 else
+                    rneb(i,k)=0.5*zpdf_e1(i)
+                    zqn(i)=zq(i)*zpdf_e2(i)/zpdf_e1(i)
+                 endif
+              endif
+
+           enddo
+
+
+        endif ! iflag_pdf
+
+        DO i=1,klon
+           IF (rneb(i,k) .LE. 0.0) THEN
+              zqn(i) = 0.0
+              rneb(i,k) = 0.0
+              zcond(i) = 0.0
+              rhcl(i,k)=zq(i)/zqs(i)
+           ELSE IF (rneb(i,k) .GE. 1.0) THEN
+              zqn(i) = zq(i)
+              rneb(i,k) = 1.0                  
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
+              rhcl(i,k)=1.0
+           ELSE
+              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
+              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
+           ENDIF
+        ENDDO
+        !         do i=1,klon
+        !            IF (rneb(i,k) .LE. 0.0) zqn(i) = 0.0
+        !            IF (rneb(i,k) .GE. 1.0) zqn(i) = zq(i)
+        !            rneb(i,k) = MAX(0.0,MIN(1.0,rneb(i,k)))
+        !c           zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i))
+        !c  On ne divise pas par 1+zdqs pour forcer a avoir l'eau predite par
+        !c  la convection.
+        !c  ATTENTION !!! Il va falloir verifier tout ca.
+        !            zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
+        !c           print*,'ZDQS ',zdqs(i)
+        !c--Olivier
+        !            rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
+        !            IF (rneb(i,k) .LE. 0.0) rhcl(i,k)=zq(i)/zqs(i)
+        !            IF (rneb(i,k) .GE. 1.0) rhcl(i,k)=1.0
+        !c--fin
+        !           ENDDO
+     ELSE
+        DO i = 1, klon
+           IF (zq(i).GT.zqs(i)) THEN
+              rneb(i,k) = 1.0
+           ELSE
+              rneb(i,k) = 0.0
+           ENDIF
+           zcond(i) = MAX(0.0,zq(i)-zqs(i))/(1.+zdqs(i))
+        ENDDO
+     ENDIF
+     !
+     DO i = 1, klon
+        zq(i) = zq(i) - zcond(i)
+        !         zt(i) = zt(i) + zcond(i) * RLVTT/RCPD
+        zt(i) = zt(i) + zcond(i) * RLVTT/RCPD/(1.0+RVTMP2*zq(i))
+     ENDDO
+     !
+     ! Partager l'eau condensee en precipitation et eau liquide nuageuse
+     !
+     DO i = 1, klon
+        IF (rneb(i,k).GT.0.0) THEN
+           zoliq(i) = zcond(i)
+           zrho(i) = pplay(i,k) / zt(i) / RD
+           zdz(i) = (paprs(i,k)-paprs(i,k+1)) / (zrho(i)*RG)
+           zfice(i) = 1.0 - (zt(i)-ztglace) / (273.13-ztglace)
+           zfice(i) = MIN(MAX(zfice(i),0.0),1.0)
+           zfice(i) = zfice(i)**nexpo
+           zneb(i) = MAX(rneb(i,k), seuil_neb)
+           radliq(i,k) = zoliq(i)/REAL(ninter+1)
+        ENDIF
+     ENDDO
+     !
+     DO n = 1, ninter
+        DO i = 1, klon
+           IF (rneb(i,k).GT.0.0) THEN
+              zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
+
+              IF (zneb(i).EQ.seuil_neb) THEN
+                 ztot = 0.0
+              ELSE
+                 !  quantite d'eau a eliminer: zchau
+                 !  meme chose pour la glace: zfroi
+                 if (ptconv(i,k)) then
+                    zcl   =cld_lc_con
+                    zct   =1./cld_tau_con
+                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
+                         *fallvc(zrhol(i)) * zfice(i)
+                 else
+                    zcl   =cld_lc_lsc
+                    zct   =1./cld_tau_lsc
+                    zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i) &
+                         *fallvs(zrhol(i)) * zfice(i)
+                 endif
+                 zchau    = zct   *dtime/REAL(ninter) * zoliq(i) &
+                      *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
+                 ztot    = zchau    + zfroi
+                 ztot    = MAX(ztot   ,0.0)
+              ENDIF
+              ztot    = MIN(ztot,zoliq(i))
+              zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
+              radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
+           ENDIF
+        ENDDO
+     ENDDO
+     !
+     DO i = 1, klon
+        IF (rneb(i,k).GT.0.0) THEN
+           d_ql(i,k) = zoliq(i)
+           zrfl(i) = zrfl(i)+ MAX(zcond(i)-zoliq(i),0.0) &
+                * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
+        ENDIF
+        IF (zt(i).LT.RTT) THEN
+           psfl(i,k)=zrfl(i)
+        ELSE
+           prfl(i,k)=zrfl(i)
+        ENDIF
+     ENDDO
+     !
+     ! Calculer les tendances de q et de t:
+     !
+     DO i = 1, klon
+        d_q(i,k) = zq(i) - q(i,k)
+        d_t(i,k) = zt(i) - t(i,k)
+     ENDDO
+     !
+     !AA--------------- Calcul du lessivage stratiforme  -------------
+
+     DO i = 1,klon
+        !
+        zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0) &
+             * (paprs(i,k)-paprs(i,k+1))/RG
+        IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+           !AA lessivage nucleation LMD5 dans la couche elle-meme
+           if (t(i,k) .GE. ztglace) THEN
+              zalpha_tr = a_tr_sca(3)
+           else
+              zalpha_tr = a_tr_sca(4)
+           endif
+           zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+           pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
+           frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
+           !
+           ! nucleation avec un facteur -1 au lieu de -0.5
+           zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
+           pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
+        ENDIF
+        !
+     ENDDO      ! boucle sur i
+     !
+     !AA Lessivage par impaction dans les couches en-dessous
+     DO kk = k-1, 1, -1
+        DO i = 1, klon
+           IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+              if (t(i,kk) .GE. ztglace) THEN
+                 zalpha_tr = a_tr_sca(1)
+              else
+                 zalpha_tr = a_tr_sca(2)
+              endif
+              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+              pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
+              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
+           ENDIF
+        ENDDO
+     ENDDO
+     !
+     !AA----------------------------------------------------------
+     !                     FIN DE BOUCLE SUR K   
+  end DO
+  !
+  !AA-----------------------------------------------------------
+  !
+  ! Pluie ou neige au sol selon la temperature de la 1ere couche
+  !
+  DO i = 1, klon
+     IF ((t(i,1)+d_t(i,1)) .LT. RTT) THEN
+        snow(i) = zrfl(i)
+        zlh_solid(i) = RLSTT-RLVTT
+     ELSE
+        rain(i) = zrfl(i)
+        zlh_solid(i) = 0.
+     ENDIF
+  ENDDO
+  !
+  ! For energy conservation : when snow is present, the solification
+  ! latent heat is considered.
+  DO k = 1, klev
+     DO i = 1, klon
+        zcpair=RCPD*(1.0+RVTMP2*(q(i,k)+d_q(i,k)))
+        zmair=(paprs(i,k)-paprs(i,k+1))/RG
+        zm_solid = (prfl(i,k)-prfl(i,k+1)+psfl(i,k)-psfl(i,k+1))*dtime
+        d_t(i,k) = d_t(i,k) + zlh_solid(i) *zm_solid / (zcpair*zmair)
+     END DO
+  END DO
+  !
+
+  if (ncoreczq>0) then
+     print*,'WARNING : ZQ dans fisrtilp ',ncoreczq,' val < 1.e-15.'
+  endif
+
+END SUBROUTINE fisrtilp
Index: trunk/libf/phylmd/inistats.F
===================================================================
--- trunk/libf/phylmd/inistats.F	(revision 66)
+++ trunk/libf/phylmd/inistats.F	(revision 66)
@@ -0,0 +1,133 @@
+      subroutine inistats(ierr)
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+      integer,intent(out) :: ierr
+      integer :: nid
+      integer :: l,nsteppd
+      real, dimension(llm) ::  sig_s
+      integer :: idim_lat,idim_lon,idim_llm,idim_llmp1,idim_time
+      real, dimension(istime) :: lt
+      integer :: nvarid
+      real, dimension(llm) :: pseudoalt
+
+      write (*,*) 
+      write (*,*) '                        || STATS ||'
+      write (*,*) 
+      write (*,*) 'daysec',daysec
+      write (*,*) 'dtphys',dtphys
+      nsteppd=nint(daysec/dtphys)
+      write (*,*) 'nsteppd=',nsteppd
+      if (abs(float(nsteppd)-daysec/dtphys).gt.1.e-8*daysec)
+     &   stop'Dans Instat:  1jour .ne. n pas physiques'
+
+      if(mod(nsteppd,istime).ne.0)
+     &   stop'Dans Instat:  1jour .ne. n*istime pas physiques'
+
+      istats=nsteppd/istime
+      write (*,*) 'istats=',istats
+      write (*,*) 'Storing ',istime,'times per day'
+      write (*,*) 'thus every ',istats,'physical timestep '
+      write (*,*) 
+
+      do l= 1, llm
+         sig_s(l)=((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
+         pseudoalt(l)=log(preff/presnivs(l))*8.  
+      enddo
+
+      ierr = NF_CREATE("stats.nc",NF_CLOBBER,nid)
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_lat)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_lon)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid, "llmp1", llm+1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_time)
+
+      ierr = NF_ENDDEF(nid)
+      call def_var_stats(nid,"Time","Time",
+     &            "hours since 0000-00-0 00:00:00",1,
+     &            idim_time,nvarid,ierr)
+! Time is initialised later by mkstats subroutine
+
+      call def_var_stats(nid,"latitude","latitude",
+     &            "degrees_north",1,idim_lat,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+      call def_var_stats(nid,"longitude","East longitude",
+     &            "degrees_east",1,idim_lon,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+
+! Niveaux verticaux, aps et bps
+      ierr = NF_REDEF (nid)
+! presnivs
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs", NF_DOUBLE, 1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs", NF_FLOAT, 1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",15,
+     &                        "Vertical levels")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"Pa")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',4,"down")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid, 
+     &                          presnivs(1:llm))
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid, 
+     &                        presnivs(1:llm))
+#endif 
+! Pseudo alts
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"altitude", NF_DOUBLE, 1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"altitude", NF_FLOAT, 1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",8,"altitude")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif 
+!      call def_var_stats(nid,"aps","hybrid pressure at midlayers"," ", 
+!     &            1,idim_llm,nvarid,ierr)
+!#ifdef NC_DOUBLE
+!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+!#else
+!      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+!#endif
+
+!      call def_var_stats(nid,"bps","hybrid sigma at midlayers"," ", 
+!     &            1,idim_llm,nvarid,ierr)
+!#ifdef NC_DOUBLE
+!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+!#else 
+!      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+!#endif
+
+      ierr=NF_CLOSE(nid)
+
+      end subroutine inistats
+
Index: trunk/libf/phylmd/initphysto.F
===================================================================
--- trunk/libf/phylmd/initphysto.F	(revision 53)
+++ 	(revision )
@@ -1,305 +1,0 @@
-!
-! $Id: initphysto.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-C
-C
-      subroutine initphysto
-     .  (infile,
-     .  rlon, rlat, tstep,t_ops,t_wrt,nq,fileid)
-       
-       USE dimphy
-       USE mod_phys_lmdz_para
-       USE IOIPSL
-       USE iophy
-       USE control_mod
-
-      implicit none
-
-C
-C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
-C   au format IOIPSL
-C
-C   Appels succesifs des routines: histbeg
-C                                  histhori
-C                                  histver
-C                                  histdef
-C                                  histend
-C
-C   Entree:
-C
-C      infile: nom du fichier histoire a creer
-C      day0,anne0: date de reference
-C      tstep: duree du pas de temps en seconde
-C      t_ops: frequence de l'operation pour IOIPSL
-C      t_wrt: frequence d'ecriture sur le fichier
-C      nq: nombre de traceurs
-C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
-C      filevid:ID du fichier netcdf pour la grille v
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "indicesol.h"
-cym#include "dimphy.h"
-
-C   Arguments
-      character*(*) infile
-      integer nhoriid, i
-      real tstep, t_ops, t_wrt
-      integer fileid, filevid
-      integer nq,l
-      real nivsigs(llm)
-
-C   Variables locales
-C
-      integer tau0
-      real zjulian
-      character*3 str
-      character*10 ctrac
-      integer iq
-      integer uhoriid, vhoriid, thoriid, zvertiid
-      integer ii,jj
-      integer zan, idayref
-      logical ok_sync
-      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
-C
-      REAL rlon(klon), rlat(klon)
-
-C  Initialisations
-C
-      pi = 4. * atan (1.)
-      str='q  '
-      ctrac = 'traceur   '
-      ok_sync= .true.
-C
-C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
-C         
-
-      zan = annee_ref
-      idayref = day_ref
-      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
-      tau0 = 0
-	
-cym	CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
-cym         DO i = 1, iim
-cym            zx_lon(i,1) = rlon(i+1)
-cym            zx_lon(i,jjm+1) = rlon(i+1)
-cym         ENDDO
-cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
-
-
-      call histbeg_phy(infile,tau0, zjulian, tstep,
-     .                 nhoriid, fileid)
-
-c$OMP MASTER	
-C  Appel a histvert pour la grille verticale
-C
-	DO l=1,llm
-            nivsigs(l)=REAL(l)
-         ENDDO
-
-	write(*,*) 'avant histvert ds initphysto'
-
-      call histvert(fileid, 'sig_s', 'Niveaux sigma',
-     . 'sigma_level',
-     .              llm, nivsigs, zvertiid)
-C
-C  Appels a histdef pour la definition des variables a sauvegarder
-C
-	write(*,*) 'apres histvert ds initphysto'
-
-       CALL histdef(fileid, "phis", "Surface geop. height", "-",
-     .                iim,jj_nb,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-c
-	write(*,*) 'apres phis ds initphysto'
-
-         CALL histdef(fileid, "aire", "Grid area", "-",
-     .                iim,jj_nb,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-         write(*,*) 'apres aire ds initphysto'
-
-cym     Attention dtime et istphy ne sont pas �rit ---> a �iminer ?
-         CALL histdef(fileid, "dtime", "tps phys ", "s",
-     .                1,1,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-	
-	 CALL histdef(fileid, "istphy", "tps stock", "s",
-     .                1,1,nhoriid, 1,1,1, -99, 32,
-     .                "once", t_ops, t_wrt)
-
-C T 
-C
-      call histdef(fileid, 't', 'Temperature', 'K',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-        write(*,*) 'apres t ds initphysto'
-C mfu 
-C
-      call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-        write(*,*) 'apres mfu ds initphysto'
-C
-C mfd 
-C
-      call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-C
-C en_u 
-C
-      call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-               write(*,*) 'apres en_u ds initphysto'
-C
-C de_u 
-C
-      call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-C
-C en_d 
-C
-      call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-
-C
-C de_d 
-C
-      call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-c coefh frac_impa,frac_nucl
-	
-	call histdef(fileid, "coefh", " ", " ",
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c abderrahmane le 16 09 02
-        call histdef(fileid, "fm_th", " ", " ",
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-        call histdef(fileid, "en_th", " ", " ",
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, "inst(X)", t_ops, t_wrt)
-c fin aj
-	
-	write(*,*) 'apres coefh ds initphysto'	
-
-	call histdef(fileid, 'frac_impa', ' ', ' ',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-	
-	call histdef(fileid, 'frac_nucl', ' ', ' ',
-     .             iim, jj_nb, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-c
-c pyu1
-c
-      CALL histdef(fileid, "pyu1", " ", " ",
-     .                iim,jj_nb,nhoriid, 1,1,1, -99, 32,
-     .                "inst(X)", t_ops, t_wrt)
-
-c
-c pyv1
-c
-	CALL histdef(fileid, "pyv1", " ", " ",
-     .                iim,jj_nb,nhoriid, 1,1,1, -99, 32,
-     .                "inst(X)", t_ops, t_wrt)
-	
-	write(*,*) 'apres pyv1 ds initphysto'
-c
-c ftsol1
-c
-	call histdef(fileid, "ftsol1", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1,1, -99,32,
-     .             "inst(X)", t_ops, t_wrt)
-
-c
-c ftsol2
-c
-        call histdef(fileid, "ftsol2", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1,1, -99,32,
-     .             "inst(X)", t_ops, t_wrt)
-
-c
-c ftsol3
-c
-        call histdef(fileid, "ftsol3", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1,1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c ftsol4
-c
-        call histdef(fileid, "ftsol4", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1,1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-	
-c
-c rain
-c
-        call histdef(fileid, "rain", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1,1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c psrf1
-c
-	call histdef(fileid, "psrf1", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-	
-c
-c psrf2
-c
-        call histdef(fileid, "psrf2", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c psrf3
-c
-        call histdef(fileid, "psrf3", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-
-c
-c psrf4
-c
-        call histdef(fileid, "psrf4", " ", " ",
-     .             iim, jj_nb, nhoriid, 1, 1, 1, -99,
-     .             32, "inst(X)", t_ops, t_wrt)
-	
-	write(*,*) 'avant histend ds initphysto'	
-
-      call histend(fileid)
-c     if (ok_sync) call histsync(fileid)
-      if (ok_sync) call histsync
-c$OMP END MASTER
-	
-
-      return
-      end
Index: trunk/libf/phylmd/initphysto.F90
===================================================================
--- trunk/libf/phylmd/initphysto.F90	(revision 66)
+++ trunk/libf/phylmd/initphysto.F90	(revision 66)
@@ -0,0 +1,216 @@
+!
+! $Id: initphysto.F90 1454 2010-11-18 12:01:24Z fairhead $
+!
+SUBROUTINE initphysto(infile,tstep,t_ops,t_wrt,fileid)
+  
+  USE dimphy
+  USE mod_phys_lmdz_para
+  USE IOIPSL
+  USE iophy
+  USE control_mod
+  
+  IMPLICIT NONE
+
+!
+!   Routine d'initialisation des ecritures des fichiers histoires LMDZ
+!   au format IOIPSL
+!
+!   Appels succesifs des routines: histbeg
+!                                  histhori
+!                                  histver
+!                                  histdef
+!                                  histend
+!
+!   Entree:
+!
+!      infile: nom du fichier histoire a creer
+!      day0,anne0: date de reference
+!      tstep: duree du pas de temps en seconde
+!      t_ops: frequence de l'operation pour IOIPSL
+!      t_wrt: frequence d'ecriture sur le fichier
+!
+!   Sortie:
+!      fileid: ID du fichier netcdf cree
+!
+!   L. Fairhead, LMD, 03/99
+!
+! =====================================================================
+!
+!   Declarations
+  INCLUDE "dimensions.h"
+  INCLUDE "paramet.h"
+  INCLUDE "comconst.h"
+  INCLUDE "comgeom.h"
+  INCLUDE "temps.h"
+  INCLUDE "logic.h"
+  INCLUDE "description.h"
+  INCLUDE "serre.h"
+  INCLUDE "indicesol.h"
+
+!   Arguments
+  CHARACTER(len=*), INTENT(IN) :: infile
+  REAL, INTENT(IN)             :: tstep
+  REAL, INTENT(IN)             :: t_ops
+  REAL, INTENT(IN)             :: t_wrt
+  INTEGER, INTENT(OUT)         :: fileid
+
+! Variables locales
+  INTEGER nhoriid, i
+  INTEGER l,k
+  REAL nivsigs(llm)
+  INTEGER tau0
+  REAL zjulian
+  INTEGER iq
+  INTEGER uhoriid, vhoriid, thoriid, zvertiid
+  INTEGER ii,jj
+  INTEGER zan, idayref
+  LOGICAL ok_sync
+  REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
+  CHARACTER(len=12) :: nvar
+
+!  Initialisations
+!
+  pi = 4. * ATAN (1.)
+  ok_sync= .TRUE.
+!
+!  Appel a histbeg: creation du fichier netcdf et initialisations diverses
+!         
+
+  zan = annee_ref
+  idayref = day_ref
+  CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
+  tau0 = 0
+  
+  CALL histbeg_phy(infile,tau0, zjulian, tstep, &
+       nhoriid, fileid)
+
+!$OMP MASTER	
+!  Appel a histvert pour la grille verticale
+!
+  DO l=1,llm
+     nivsigs(l)=REAL(l)
+  ENDDO
+  
+  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', &
+       'sigma_level', &
+       llm, nivsigs, zvertiid)
+!
+!  Appels a histdef pour la definition des variables a sauvegarder
+!
+  CALL histdef(fileid, "phis", "Surface geop. height", "-", &
+       iim,jj_nb,nhoriid, 1,1,1, -99, 32, &
+       "once", t_ops, t_wrt)
+  
+  CALL histdef(fileid, "aire", "Grid area", "-", &
+       iim,jj_nb,nhoriid, 1,1,1, -99, 32, &
+       "once", t_ops, t_wrt)
+
+  CALL histdef(fileid, "longitudes", "longitudes", "-", &
+       iim,jj_nb,nhoriid, 1,1,1, -99, 32, &
+       "once", t_ops, t_wrt)
+
+  CALL histdef(fileid, "latitudes", "latitudes", "-", &
+       iim,jj_nb,nhoriid, 1,1,1, -99, 32, &
+       "once", t_ops, t_wrt)
+! T 
+  CALL histdef(fileid, 't', 'Temperature', 'K', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+! mfu 
+  CALL histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt)
+! mfd 
+  CALL histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+! en_u 
+  CALL histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt)
+! de_u 
+  CALL histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt)
+! en_d 
+  CALL histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt)
+! de_d 
+  CALL histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+! coefh
+  CALL histdef(fileid, "coefh", " ", " ", iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, "inst(X)", t_ops, t_wrt)
+! fm_th
+  CALL histdef(fileid, "fm_th", " ", " ",iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, "inst(X)", t_ops, t_wrt)
+! en_th
+  CALL histdef(fileid, "en_th", " ", " ",iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, "inst(X)", t_ops, t_wrt)
+! frac_impa
+  CALL histdef(fileid, 'frac_impa', ' ', ' ',iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt)
+! frac_nucl
+  CALL histdef(fileid, 'frac_nucl', ' ', ' ',iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid,32, 'inst(X)', t_ops, t_wrt)
+! pyu1
+  CALL histdef(fileid, "pyu1", " ", " ", iim,jj_nb,nhoriid, &
+       1,1,1, -99, 32, "inst(X)", t_ops, t_wrt)
+! pyv1
+  CALL histdef(fileid, "pyv1", " ", " ", iim,jj_nb,nhoriid, &
+       1,1,1, -99, 32,"inst(X)", t_ops, t_wrt)    
+! ftsol1
+  CALL histdef(fileid, "ftsol1", " ", " ",iim, jj_nb, nhoriid, &
+       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
+! ftsol2
+  CALL histdef(fileid, "ftsol2", " ", " ",iim, jj_nb, nhoriid, &
+       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
+! ftsol3
+  CALL histdef(fileid, "ftsol3", " ", " ", iim, jj_nb, nhoriid, &
+       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
+! ftsol4
+  CALL histdef(fileid, "ftsol4", " ", " ",iim, jj_nb, nhoriid, &
+       1, 1,1, -99, 32, "inst(X)", t_ops, t_wrt)
+! psrf1
+  CALL histdef(fileid, "psrf1", " ", " ",iim, jj_nb, nhoriid, &
+       1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt)
+! psrf2
+  CALL histdef(fileid, "psrf2", " ", " ",iim, jj_nb, nhoriid, &
+       1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt)
+! psrf3
+  CALL histdef(fileid, "psrf3", " ", " ",iim, jj_nb, nhoriid, &
+       1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt)
+! psrf4
+  CALL histdef(fileid, "psrf4", " ", " ", iim, jj_nb, nhoriid, &
+       1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt)
+! sh
+  CALL histdef(fileid, 'sh', '', '', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+! da
+  CALL histdef(fileid, 'da', '', '', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+! mp
+  CALL histdef(fileid, 'mp', '', '', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+! upwd
+  CALL histdef(fileid, 'upwd', '', '', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+! dnwd
+  CALL histdef(fileid, 'dnwd', '', '', iim, jj_nb, nhoriid, &
+       llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+
+! phi
+  DO k=1,llm
+     IF (k<10) THEN
+        WRITE(nvar,'(i1)') k
+     ELSE IF (k<100) THEN
+        WRITE(nvar,'(i2)') k
+     ELSE
+        WRITE(nvar,'(i3)') k
+     END IF
+     nvar='phi_lev'//trim(nvar)
+     
+     CALL histdef(fileid, nvar, '', '', iim, jj_nb, nhoriid, &
+          llm, 1, llm, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
+  END DO
+
+  CALL histend(fileid)
+  IF (ok_sync) CALL histsync
+!$OMP END MASTER
+	
+END SUBROUTINE initphysto
Index: trunk/libf/phylmd/mkstat.F90
===================================================================
--- trunk/libf/phylmd/mkstat.F90	(revision 66)
+++ trunk/libf/phylmd/mkstat.F90	(revision 66)
@@ -0,0 +1,164 @@
+subroutine mkstats(ierr)
+
+ 
+!
+!  This program writes a stats.nc file from sums and sums of squares
+!  to means and standard deviations and also writes netcdf style
+!  file so that the data can be viewed easily.  The data file is
+!  overwritten in place.  
+!  SRL  21 May 1996
+!  Yann W. july 2003
+
+
+implicit none
+
+#include "dimensions.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+integer :: ierr,nid,nbvar,i,ndims,lt,nvarid
+integer, dimension(4) :: id,varid,start,size
+integer, dimension(5) :: dimids
+character (len=50) :: name,nameout,units,title
+real, dimension(iip1,jjp1,llm) :: sum3d,square3d,mean3d,sd3d
+real, dimension(iip1,jjp1) :: sum2d,square2d,mean2d,sd2d
+real, dimension(istime) :: time
+real, dimension(jjp1) :: lat
+real, dimension(iip1) :: lon
+real, dimension(llm) :: alt
+logical :: lcopy=.true.
+!integer :: latid,lonid,altid,timeid
+integer :: meanid,sdid
+!integer, dimension(4) :: dimout
+
+! Incrementation of count for the last step, which is not done in wstats
+count(istime)=count(istime)+1
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+! We catch the id of dimensions of the stats file
+
+ierr= NF_INQ_DIMID(nid,"latitude",id(1))
+ierr= NF_INQ_DIMID(nid,"longitude",id(2))
+ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+ierr= NF_INQ_VARID(nid,"latitude",varid(1))
+ierr= NF_INQ_VARID(nid,"longitude",varid(2))
+ierr= NF_INQ_VARID(nid,"altitude",varid(3))
+ierr= NF_INQ_VARID(nid,"Time",varid(4))
+
+! Time initialisation
+
+do i=1,istime
+   time(i)=i*24./istime
+#ifdef NC_DOUBLE
+   ierr= NF_PUT_VARA_DOUBLE(nid,varid(4),i,1,time(i))
+#else
+   ierr= NF_PUT_VARA_REAL(nid,varid(4),i,1,time(i))
+#endif
+enddo
+
+! We catche the values of the variables
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(1),lat)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(2),lon)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,varid(1),lat)
+         ierr = NF_GET_VAR_REAL(nid,varid(2),lon)
+         ierr = NF_GET_VAR_REAL(nid,varid(3),alt)
+#endif
+
+! We catch the number of variables in the stats file
+ierr = NF_INQ_NVARS(nid,nbvar)
+
+! to catche the "real" number of variables (without the "additionnal variables")
+nbvar=(nbvar-4)/2 
+
+do i=1,nbvar
+   varid=(i-1)*2+5
+
+   ! What's the variable's name?
+   ierr=NF_INQ_VARNAME(nid,varid,name)
+   write(*,*) "OK variable ",name
+   ! Its units?
+   units=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"units",units)
+   ! Its title?
+   title=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"title",title)
+   ! Its number of dimensions?   
+   ierr=NF_INQ_VARNDIMS(nid,varid,ndims)
+   ! Its values?
+
+   if(ndims==4) then ! lat, lon, alt & time
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=altid
+!      dimout(4)=timeid
+
+      size=(/iip1,jjp1,llm,1/)
+      do lt=1,istime
+         start=(/1,1,1,lt/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square3d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square3d)
+#endif
+         ! Calculation of these variables
+         mean3d=sum3d/count(lt)
+         sd3d=sqrt(max(0.,square3d/count(lt)-mean3d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd3d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd3d)
+#endif
+      enddo
+
+    else if (ndims.eq.3) then
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=timeid
+
+      size=(/iip1,jjp1,1,0/)
+      do lt=1,istime
+         start=(/1,1,lt,0/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square2d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square2d)
+#endif
+         ! Calculation of these variables
+         mean2d=sum2d/count(lt)
+         sd2d=sqrt(max(0.,square2d/count(lt)-mean2d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd2d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd2d)
+#endif
+      enddo
+
+    endif 
+enddo
+
+ierr= NF_CLOSE(nid)
+
+end
Index: trunk/libf/phylmd/phyetat0.F
===================================================================
--- trunk/libf/phylmd/phyetat0.F	(revision 53)
+++ trunk/libf/phylmd/phyetat0.F	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: phyetat0.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id: phyetat0.F 1457 2010-11-22 15:19:25Z musat $
 !
 c
@@ -21,5 +21,6 @@
       USE infotrac
       USE traclmdz_mod,    ONLY : traclmdz_from_restart
-      USE carbon_cycle_mod,ONLY : carbon_cycle_tr, carbon_cycle_cpl
+      USE carbon_cycle_mod,ONLY :
+     &     carbon_cycle_tr, carbon_cycle_cpl, co2_send
 
       IMPLICIT none
@@ -133,37 +134,12 @@
 
        
-
-         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
-             clesphy0(1)=tab_cntrl( 5 )
-         ENDIF
-
-         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
-             clesphy0(2)=tab_cntrl( 6 )
-         ENDIF
-
-         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
-             clesphy0(3)=tab_cntrl( 7 )
-         ENDIF
-
-         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
-             clesphy0(4)=tab_cntrl( 8 )
-         ENDIF
-
-         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
-             clesphy0(5)=tab_cntrl( 9 )
-         ENDIF
-
-         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
-             clesphy0(6)=tab_cntrl( 10 )
-         ENDIF
-
-         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
-             clesphy0(7)=tab_cntrl( 11 )
-         ENDIF
-
-         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
-             clesphy0(8)=tab_cntrl( 12 )
-         ENDIF
-
+      clesphy0(1)=tab_cntrl( 5 )
+      clesphy0(2)=tab_cntrl( 6 )
+      clesphy0(3)=tab_cntrl( 7 )
+      clesphy0(4)=tab_cntrl( 8 )
+      clesphy0(5)=tab_cntrl( 9 )
+      clesphy0(6)=tab_cntrl( 10 )
+      clesphy0(7)=tab_cntrl( 11 )
+      clesphy0(8)=tab_cntrl( 12 )
 
 c
@@ -841,5 +817,5 @@
           ENDIF
           WRITE(str2,'(i2.2)') nsrf
-          CALL get_field("TKE"//str2,pbl_tke(:,1:klev,nsrf),found)
+          CALL get_field("TKE"//str2,pbl_tke(:,1:klev+1,nsrf),found)
           IF (.NOT. found) THEN
             PRINT*, "phyetat0: <TKE"//str2//"> est absent"
@@ -848,5 +824,5 @@
           xmin = 1.0E+20
           xmax = -1.0E+20
-          DO k = 1, klev
+          DO k = 1, klev+1
             DO i = 1, klon
               xmin = MIN(pbl_tke(i,k,nsrf),xmin)
@@ -1078,6 +1054,17 @@
 
          END DO
-         
          CALL traclmdz_from_restart(trs)
+
+         IF (carbon_cycle_cpl) THEN
+            ALLOCATE(co2_send(klon), stat=ierr)
+            IF (ierr /= 0) CALL abort_gcm
+     &           ('phyetat0','pb allocation co2_send',1)
+            CALL get_field("co2_send",co2_send,found)
+            IF (.NOT. found) THEN
+               PRINT*,"phyetat0: Le champ <co2_send> est absent"
+               PRINT*,"Initialisation uniforme a co2_ppm=",co2_ppm
+               co2_send(:) = co2_ppm
+            END IF
+         END IF
       END IF
 
Index: trunk/libf/phylmd/phyredem.F
===================================================================
--- trunk/libf/phylmd/phyredem.F	(revision 53)
+++ trunk/libf/phylmd/phyredem.F	(revision 66)
@@ -1,4 +1,4 @@
 !
-! $Id: phyredem.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id: phyredem.F 1457 2010-11-22 15:19:25Z musat $
 !
 c
@@ -15,5 +15,5 @@
       USE infotrac
       USE control_mod
-
+      USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
 
       IMPLICIT none
@@ -289,5 +289,5 @@
             WRITE(str2,'(i2.2)') nsrf
             CALL put_field("TKE"//str2,"Energ. Cineti. Turb."//str2,
-     .                     pbl_tke(:,1:klev,nsrf))
+     .                     pbl_tke(:,1:klev+1,nsrf))
           ELSE
             PRINT*, "Trop de sous-mailles"
@@ -337,4 +337,12 @@
             CALL put_field("trs_"//tname(iiq),"",trs(:,it))
          END DO
+         IF (carbon_cycle_cpl) THEN
+            IF (.NOT. ALLOCATED(co2_send)) THEN
+               ! This is the case of create_etat0_limit, ce0l
+               ALLOCATE(co2_send(klon))
+               co2_send(:) = co2_ppm0
+            END IF
+            CALL put_field("co2_send","co2_ppm for coupling",co2_send)
+         END IF
       END IF
 
Index: trunk/libf/phylmd/phys_output_mod.F90
===================================================================
--- trunk/libf/phylmd/phys_output_mod.F90	(revision 53)
+++ trunk/libf/phylmd/phys_output_mod.F90	(revision 66)
@@ -1,3 +1,3 @@
-! $Id: phys_output_mod.F90 1424 2010-09-01 09:20:28Z jghattas $
+! $Id: phys_output_mod.F90 1473 2011-01-12 15:07:43Z fairhead $
 !
 ! Abderrahmane 12 2007
@@ -427,4 +427,6 @@
   type(ctrl_out),save :: o_pres         = ctrl_out((/ 2, 3, 10, 10, 1 /),'pres')
   type(ctrl_out),save :: o_paprs        = ctrl_out((/ 2, 3, 10, 10, 1 /),'paprs')
+  type(ctrl_out),save :: o_mass        = ctrl_out((/ 2, 3, 10, 10, 1 /),'mass')
+
   type(ctrl_out),save :: o_rneb         = ctrl_out((/ 2, 5, 10, 10, 1 /),'rneb')
   type(ctrl_out),save :: o_rnebcon      = ctrl_out((/ 2, 5, 10, 10, 1 /),'rnebcon')
@@ -1108,4 +1110,5 @@
  CALL histdef3d(iff,o_pres%flag,o_pres%name, "Air pressure", "Pa" )
  CALL histdef3d(iff,o_paprs%flag,o_paprs%name, "Air pressure Inter-Couches", "Pa" )
+ CALL histdef3d(iff,o_mass%flag,o_mass%name, "Masse Couches", "kg/m2" )
  CALL histdef3d(iff,o_rneb%flag,o_rneb%name, "Cloud fraction", "-")
  CALL histdef3d(iff,o_rnebcon%flag,o_rnebcon%name, "Convective Cloud Fraction", "-")
Index: trunk/libf/phylmd/phys_output_write.h
===================================================================
--- trunk/libf/phylmd/phys_output_write.h	(revision 53)
+++ trunk/libf/phylmd/phys_output_write.h	(revision 66)
@@ -104,4 +104,9 @@
      s                   o_psol%name,itau_w,zx_tmp_fi2d)
        ENDIF
+
+       IF (o_mass%flag(iff)<=lev_files(iff)) THEN
+      CALL histwrite_phy(nid_files(iff),o_mass%name,itau_w,zmasse)
+        ENDIF
+
 
        IF (o_qsurf%flag(iff)<=lev_files(iff)) THEN
Index: trunk/libf/phylmd/physiq.F
===================================================================
--- trunk/libf/phylmd/physiq.F	(revision 53)
+++ trunk/libf/phylmd/physiq.F	(revision 66)
@@ -1,3 +1,3 @@
-! $Id: physiq.F 1428 2010-09-13 08:43:37Z fairhead $
+! $Id: physiq.F 1486 2011-02-11 12:07:39Z fairhead $
 c#define IO_DEBUG
 
@@ -158,4 +158,8 @@
       save ok_LES                            
 c$OMP THREADPRIVATE(ok_LES)                  
+c
+      LOGICAL callstats ! sortir le fichier stats 
+      save callstats                            
+c$OMP THREADPRIVATE(callstats)                  
 c
       LOGICAL ok_region ! sortir le fichier regional
@@ -606,5 +610,5 @@
       real, save :: ale_bl_prescr=0.
 
-      real, save :: ale_max=100.
+      real, save :: ale_max=1000.
       real, save :: alp_max=2.
 
@@ -1150,4 +1154,5 @@
 !     and 360
 
+      INTEGER ierr
 #include "YOMCST.h"
 #include "YOETHF.h"
@@ -1222,4 +1227,5 @@
      .     ok_instan, ok_hf,
      .     ok_LES,
+     .     callstats,
      .     solarlong0,seuil_inversion,
      .     fact_cldcon, facttemps,ok_newmicro,iflag_radia,
@@ -1250,5 +1256,4 @@
 cym Attention pbase pas initialise dans concvl !!!!
           pbase=0
-          paire_ter(:)=0.    
 cIM 180608
 c         pmflxr=0.
@@ -1847,21 +1852,22 @@
 ! doit donc etre placé avant radlwsw et pbl_surface
 
+!!!   jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
+      day_since_equinox = (jD_cur + jH_cur) - jD_eq 
+!
+!   choix entre calcul de la longitude solaire vraie ou valeur fixee a 
+!   solarlong0
+      if (solarlong0<-999.) then
+       if (new_orbit) then
 ! calcul selon la routine utilisee pour les planetes
-      if (new_orbit) then
-        call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
-        day_since_equinox = (jD_cur + jH_cur) - jD_eq 
-!        day_since_equinox = (jD_cur) - jD_eq 
         call solarlong(day_since_equinox, zlongi, dist)
-      else      
+       else    
 ! calcul selon la routine utilisee pour l'AR4
-!   choix entre calcul de la longitude solaire vraie ou valeur fixee a
-!   solarlong0
-        if (solarlong0<-999.) then
-           CALL orbite(REAL(days_elapsed+1),zlongi,dist)
-        else
+        CALL orbite(REAL(days_elapsed+1),zlongi,dist)
+       endif   
+      else    
            zlongi=solarlong0  ! longitude solaire vraie
-           dist=1.            ! distance au soleil / moyenne
-        endif
-      endif
+           dist=1.            ! distance au soleil / moyenne 
+      endif   
       if(prt_level.ge.1)                                                &
      &    write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
@@ -3376,5 +3382,6 @@
      I                   cdragh,coefh,u1,v1,ftsol,pctsrf,
      I                   frac_impa, frac_nucl,
-     I                   pphis,airephy,dtime,itap)
+     I                   pphis,airephy,dtime,itap,
+     I                   rlon,rlat,qx(:,:,ivap),da,phi,mp,upwd,dnwd)
 
 
@@ -3694,5 +3701,58 @@
 c====================================================================
 c
-      
+
+c        -----------------------------------------------------------------
+c        WSTATS: Saving statistics
+c        -----------------------------------------------------------------
+c        ("stats" stores and accumulates 8 key variables in file "stats.nc"
+c        which can later be used to make the statistic files of the run:
+c        "stats")          only possible in 3D runs !
+
+         
+         IF (callstats) THEN
+
+           call wstats(klon,o_psol%name,"Surface pressure","Pa"
+     &                 ,2,paprs(:,1))
+           call wstats(klon,o_tsol%name,"Surface temperature","K",
+     &                 2,zxtsol)
+           zx_tmp_fi2d(:) = rain_fall(:) + snow_fall(:)
+           call wstats(klon,o_precip%name,"Precip Totale liq+sol",
+     &                 "kg/(s*m2)",2,zx_tmp_fi2d)
+           zx_tmp_fi2d(:) = rain_lsc(:) + snow_lsc(:)
+           call wstats(klon,o_plul%name,"Large-scale Precip",
+     &                 "kg/(s*m2)",2,zx_tmp_fi2d)
+           zx_tmp_fi2d(:) = rain_con(:) + snow_con(:)
+           call wstats(klon,o_pluc%name,"Convective Precip",
+     &                 "kg/(s*m2)",2,zx_tmp_fi2d)
+           call wstats(klon,o_sols%name,"Solar rad. at surf.",
+     &                 "W/m2",2,solsw)
+           call wstats(klon,o_soll%name,"IR rad. at surf.",
+     &                 "W/m2",2,sollw)
+          zx_tmp_fi2d(:) = topsw(:)-toplw(:)
+          call wstats(klon,o_nettop%name,"Net dn radiatif flux at TOA",
+     &                 "W/m2",2,zx_tmp_fi2d)
+
+
+
+           call wstats(klon,o_temp%name,"Air temperature","K",
+     &                 3,t_seri)
+           call wstats(klon,o_vitu%name,"Zonal wind","m.s-1",
+     &                 3,u_seri)
+           call wstats(klon,o_vitv%name,"Meridional wind",
+     &                "m.s-1",3,v_seri)
+           call wstats(klon,o_vitw%name,"Vertical wind",
+     &                "m.s-1",3,omega)
+           call wstats(klon,o_ovap%name,"Specific humidity", "kg/kg",
+     &                 3,q_seri)
+ 
+
+
+           IF(lafin) THEN
+             write (*,*) "Writing stats..."
+             call mkstats(ierr)
+           ENDIF
+
+         ENDIF !if callstats
+     
 
       IF (lafin) THEN
Index: trunk/libf/phylmd/phystokenc.F
===================================================================
--- trunk/libf/phylmd/phystokenc.F	(revision 53)
+++ 	(revision )
@@ -1,435 +1,0 @@
-!
-c
-c
-      SUBROUTINE phystokenc (
-     I                   nlon,nlev,pdtphys,rlon,rlat,
-     I                   pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     I                   pfm_therm,pentr_therm,
-     I                   cdragh, pcoefh,yu1,yv1,ftsol,pctsrf,
-     I                   frac_impa,frac_nucl,
-     I                   pphis,paire,dtime,itap)
-      USE ioipsl
-      USE dimphy
-      USE infotrac, ONLY : nqtot
-      USE iophy
-      USE control_mod
-
-      IMPLICIT none
-
-c======================================================================
-c Auteur(s) FH
-c Objet: Moniteur general des tendances traceurs
-c
-
-c======================================================================
-#include "dimensions.h"
-#include "tracstoke.h"
-#include "indicesol.h"
-c======================================================================
-
-c Arguments:
-c
-c   EN ENTREE:
-c   ==========
-c
-c   divers:
-c   -------
-c
-      integer nlon ! nombre de points horizontaux
-      integer nlev ! nombre de couches verticales
-      real pdtphys ! pas d'integration pour la physique (seconde)
-c
-      integer physid, itap
-      save physid
-c$OMP THREADPRIVATE(physid)
-      integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
-
-c   convection:
-c   -----------
-c
-      REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
-      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
-      REAL pen_u(klon,klev) ! flux entraine dans le panache montant
-      REAL pde_u(klon,klev) ! flux detraine dans le panache montant
-      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
-      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
-      real pt(klon,klev)
-      REAL,allocatable,save :: t(:,:)
-c$OMP THREADPRIVATE(t)
-c
-      REAL rlon(klon), rlat(klon), dtime
-      REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1)
-
-c   Couche limite:
-c   --------------
-c
-      REAL cdragh(klon)          ! cdrag
-      REAL pcoefh(klon,klev)     ! coeff melange CL
-      REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
-      REAL yv1(klon)
-      REAL yu1(klon),pphis(klon),paire(klon)
-
-c   Les Thermiques : (Abderr 25 11 02)
-c   ---------------
-      REAL pfm_therm(klon,klev+1)
-      real fm_therm1(klon,klev)
-      REAL pentr_therm(klon,klev)
-    
-      REAL,allocatable,save :: entr_therm(:,:)
-      REAL,allocatable,save :: fm_therm(:,:)
-c$OMP THREADPRIVATE(entr_therm)
-c$OMP THREADPRIVATE(fm_therm)
-c
-c   Lessivage:
-c   ----------
-c
-      REAL frac_impa(klon,klev)
-      REAL frac_nucl(klon,klev)
-c
-c Arguments necessaires pour les sources et puits de traceur
-C
-      real ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
-      real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
-c======================================================================
-c
-      INTEGER i, k
-c
-      REAL,allocatable,save :: mfu(:,:)  ! flux de masse dans le panache montant
-      REAL,allocatable,save :: mfd(:,:)  ! flux de masse dans le panache descendant
-      REAL,allocatable,save :: en_u(:,:) ! flux entraine dans le panache montant
-      REAL,allocatable,save :: de_u(:,:) ! flux detraine dans le panache montant
-      REAL,allocatable,save :: en_d(:,:) ! flux entraine dans le panache descendant
-      REAL,allocatable,save :: de_d(:,:) ! flux detraine dans le panache descendant
-      REAL,allocatable,save :: coefh(:,:) ! flux detraine dans le panache descendant
-
-      REAL,allocatable,save :: pyu1(:)
-      REAL,allocatable,save :: pyv1(:)
-      REAL,allocatable,save :: pftsol(:,:)
-      REAL,allocatable,save :: ppsrf(:,:)
-c$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh)
-c$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf)
-      real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon)
-      real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon)
-
-      REAL dtcum
-
-      integer iadvtr,irec
-      real zmin,zmax
-      logical ok_sync
- 
-      save dtcum
-      save iadvtr,irec
-c$OMP THREADPRIVATE(dtcum,iadvtr,irec)
-      data iadvtr,irec/0,1/
-      logical,save :: first=.true.
-c$OMP THREADPRIVATE(first)
-c
-c   Couche limite:
-c======================================================================
-
-c Dans le meme vecteur on recombine le drag et les coeff d'echange
-      pcoefh_buf(:,1)      = cdragh(:)
-      pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
-
-      ok_sync = .true.
-	print*,'Dans phystokenc.F'
-      print*,'iadvtr= ',iadvtr
-      print*,'istphy= ',istphy
-      print*,'istdyn= ',istdyn
-
-      if (first) then
-      
-        allocate( t(klon,klev))
-        allocate( mfu(klon,klev))  
-        allocate( mfd(klon,klev))  
-        allocate( en_u(klon,klev)) 
-        allocate( de_u(klon,klev)) 
-        allocate( en_d(klon,klev)) 
-        allocate( de_d(klon,klev)) 
-        allocate( coefh(klon,klev)) 
-        allocate( entr_therm(klon,klev))
-        allocate( fm_therm(klon,klev))
-        allocate( pyu1(klon))
-        allocate( pyv1(klon))
-        allocate( pftsol(klon,nbsrf))
-        allocate( ppsrf(klon,nbsrf))
-  
-        first=.false.
-      endif
-      
-      IF (iadvtr.eq.0) THEN
-	
-	CALL initphysto('phystoke',
-     . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqtot,physid)
-  	
-	write(*,*) 'apres initphysto ds phystokenc' 
-
-	
-      ENDIF
-c
-      ndex2d = 0
-      ndex3d = 0
-      i=itap 
-cym      CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-      CALL histwrite_phy(physid,"phis",i,pphis)
-c
-      i=itap
-cym      CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-      CALL histwrite_phy(physid,"aire",i,paire)
-
-      iadvtr=iadvtr+1
-c
-      if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then
-	print*,'reinitialisation des champs cumules 
-     s          a iadvtr=',iadvtr
-         do k=1,klev
-            do i=1,klon
-               mfu(i,k)=0.
-               mfd(i,k)=0.
-               en_u(i,k)=0.
-               de_u(i,k)=0.
-               en_d(i,k)=0.
-               de_d(i,k)=0.
-               coefh(i,k)=0.
-                t(i,k)=0.
-		fm_therm(i,k)=0.
-               entr_therm(i,k)=0.
-            enddo
-         enddo
-         do i=1,klon
-            pyv1(i)=0.
-            pyu1(i)=0.
-         end do
-         do k=1,nbsrf
-             do i=1,klon
-               pftsol(i,k)=0.
-               ppsrf(i,k)=0.
-            enddo
-         enddo
-
-         dtcum=0.
-      endif
-
-      do k=1,klev
-         do i=1,klon
-            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
-            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
-            en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
-            de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
-            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
-            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
-            coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
-                t(i,k)=t(i,k)+pt(i,k)*pdtphys
-       fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
-       entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
-         enddo
-      enddo
-         do i=1,klon
-            pyv1(i)=pyv1(i)+yv1(i)*pdtphys
-            pyu1(i)=pyu1(i)+yu1(i)*pdtphys
-         end do
-         do k=1,nbsrf
-             do i=1,klon
-               pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
-               ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
-            enddo
-         enddo
-
-      dtcum=dtcum+pdtphys
-
-      IF(mod(iadvtr,istphy).eq.0) THEN 
-c
-c   normalisation par le temps cumule
-         do k=1,klev
-            do i=1,klon
-               mfu(i,k)=mfu(i,k)/dtcum
-               mfd(i,k)=mfd(i,k)/dtcum
-               en_u(i,k)=en_u(i,k)/dtcum
-               de_u(i,k)=de_u(i,k)/dtcum
-               en_d(i,k)=en_d(i,k)/dtcum
-               de_d(i,k)=de_d(i,k)/dtcum
-               coefh(i,k)=coefh(i,k)/dtcum
-c Unitel a enlever
-	      t(i,k)=t(i,k)/dtcum	
-               fm_therm(i,k)=fm_therm(i,k)/dtcum
-	       entr_therm(i,k)=entr_therm(i,k)/dtcum
-            enddo
-         enddo
-         do i=1,klon
-            pyv1(i)=pyv1(i)/dtcum
-            pyu1(i)=pyu1(i)/dtcum
-         end do
-         do k=1,nbsrf
-             do i=1,klon
-               pftsol(i,k)=pftsol(i,k)/dtcum
-               pftsol1(i) = pftsol(i,1)
-               pftsol2(i) = pftsol(i,2)
-               pftsol3(i) = pftsol(i,3)
-               pftsol4(i) = pftsol(i,4)
-
-               ppsrf(i,k)=ppsrf(i,k)/dtcum
-               ppsrf1(i) = ppsrf(i,1)
-               ppsrf2(i) = ppsrf(i,2)
-               ppsrf3(i) = ppsrf(i,3)
-               ppsrf4(i) = ppsrf(i,4)
-
-            enddo
-         enddo
-c
-c   ecriture des champs
-c
-         irec=irec+1
-
-ccccc
-cym         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
-         CALL histwrite_phy(physid,"t",itap,t)
-
-cym         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
-      CALL histwrite_phy(physid,"mfu",itap,mfu)
-cym	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
-      CALL histwrite_phy(physid,"mfd",itap,mfd)
-cym        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
-      CALL histwrite_phy(physid,"en_u",itap,en_u)
-cym        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
-      CALL histwrite_phy(physid,"de_u",itap,de_u)
-cym        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
-      CALL histwrite_phy(physid,"en_d",itap,en_d)
-cym        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)       
-      CALL histwrite_phy(physid,"de_d",itap,de_d)
-cym        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)         
-      CALL histwrite_phy(physid,"coefh",itap,coefh)	
-
-c ajou...
-	do k=1,klev
-           do i=1,klon
-	 fm_therm1(i,k)=fm_therm(i,k)	
-	   enddo
-	enddo
-
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d)
-      CALL histwrite_phy(physid,"fm_th",itap,fm_therm1)
-c
-cym      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d)
-      CALL histwrite_phy(physid,"en_th",itap,entr_therm)
-cccc
-cym       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
-        CALL histwrite_phy(physid,"frac_impa",itap,frac_impa)
-
-cym        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
-        CALL histwrite_phy(physid,"frac_nucl",itap,frac_nucl)
- 
-cym        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
-      CALL histwrite_phy(physid,"pyu1",itap,pyu1)
-	
-cym	CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
-      CALL histwrite_phy(physid,"pyv1",itap,pyv1)
-	
-cym	CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
-      CALL histwrite_phy(physid,"ftsol1",itap,pftsol1)
-cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
-      CALL histwrite_phy(physid,"ftsol2",itap,pftsol2)
-cym          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
-      CALL histwrite_phy(physid,"ftsol3",itap,pftsol3)
-cym         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
-      CALL histwrite_phy(physid,"ftsol4",itap,pftsol4)
-
-cym        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
-      CALL histwrite_phy(physid,"psrf1",itap,ppsrf1)
-cym        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
-      CALL histwrite_phy(physid,"psrf2",itap,ppsrf2)
-cym        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
-      CALL histwrite_phy(physid,"psrf3",itap,ppsrf3)
-cym        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
-      CALL histwrite_phy(physid,"psrf4",itap,ppsrf4)
-
-c$OMP MASTER
-      if (ok_sync) call histsync(physid)
-c$OMP END MASTER
-c     if (ok_sync) call histsync
-	
-c
-cAA Test sur la valeur des coefficients de lessivage 
-c
-         zmin=1e33
-         zmax=-1e33
-         do k=1,klev
-            do i=1,klon
-                  zmax=max(zmax,frac_nucl(i,k))
-                  zmin=min(zmin,frac_nucl(i,k))
-            enddo
-         enddo
-         Print*,'------ coefs de lessivage (min et max) --------'
-         Print*,'facteur de nucleation ',zmin,zmax
-         zmin=1e33
-         zmax=-1e33
-         do k=1,klev
-            do i=1,klon
-                  zmax=max(zmax,frac_impa(i,k))
-                  zmin=min(zmin,frac_impa(i,k))
-            enddo
-         enddo
-         Print*,'facteur d impaction ',zmin,zmax
-
-      ENDIF 
-
-c   reinitialisation des champs cumules
-	go to 768
-      if (mod(iadvtr,istphy).eq.1) then
-         do k=1,klev
-            do i=1,klon
-               mfu(i,k)=0.
-               mfd(i,k)=0.
-               en_u(i,k)=0.
-               de_u(i,k)=0.
-               en_d(i,k)=0.
-               de_d(i,k)=0.
-               coefh(i,k)=0.
-	       t(i,k)=0.
-               fm_therm(i,k)=0.
-	       entr_therm(i,k)=0.
-            enddo
-         enddo
-         do i=1,klon
-            pyv1(i)=0.
-            pyu1(i)=0.
-         end do
-         do k=1,nbsrf
-             do i=1,klon
-               pftsol(i,k)=0.
-               ppsrf(i,k)=0.
-            enddo
-         enddo
-
-         dtcum=0.
-      endif
-
-      do k=1,klev
-         do i=1,klon
-            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
-            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
-            en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
-            de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
-            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
-            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
-            coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
-		t(i,k)=t(i,k)+pt(i,k)*pdtphys
-       fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
-       entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
-         enddo
-      enddo
-         do i=1,klon
-            pyv1(i)=pyv1(i)+yv1(i)*pdtphys
-            pyu1(i)=pyu1(i)+yu1(i)*pdtphys
-         end do
-         do k=1,nbsrf
-             do i=1,klon
-               pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
-               ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
-            enddo
-         enddo
-
-      dtcum=dtcum+pdtphys
-768   continue
-
-      RETURN
-      END
Index: trunk/libf/phylmd/phystokenc.F90
===================================================================
--- trunk/libf/phylmd/phystokenc.F90	(revision 66)
+++ trunk/libf/phylmd/phystokenc.F90	(revision 66)
@@ -0,0 +1,362 @@
+SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, &
+     pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
+     pfm_therm,pentr_therm, &
+     cdragh, pcoefh,yu1,yv1,ftsol,pctsrf, &
+     frac_impa,frac_nucl, &
+     pphis,paire,dtime,itap, &
+     psh, pda, pphi, pmp, pupwd, pdnwd)
+  
+  USE ioipsl
+  USE dimphy
+  USE infotrac, ONLY : nqtot
+  USE iophy
+  USE control_mod
+  
+  IMPLICIT NONE
+  
+!======================================================================
+! Auteur(s) FH
+! Objet: Ecriture des variables pour transport offline
+!
+!======================================================================
+  INCLUDE "dimensions.h"
+  INCLUDE "tracstoke.h"
+  INCLUDE "indicesol.h"
+  INCLUDE "iniprint.h"
+!======================================================================
+
+! Arguments:
+!
+  REAL,DIMENSION(klon,klev), INTENT(IN)     :: psh   ! humidite specifique
+  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pda
+  REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi
+  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pmp
+  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pupwd ! saturated updraft mass flux
+  REAL,DIMENSION(klon,klev), INTENT(IN)     :: pdnwd ! saturated downdraft mass flux
+
+!   EN ENTREE:
+!   ==========
+!
+!   divers:
+!   -------
+!
+  INTEGER nlon ! nombre de points horizontaux
+  INTEGER nlev ! nombre de couches verticales
+  REAL pdtphys ! pas d'integration pour la physique (seconde)
+  INTEGER itap
+  INTEGER, SAVE :: physid
+!$OMP THREADPRIVATE(physid)
+
+!   convection:
+!   -----------
+!
+  REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
+  REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
+  REAL pen_u(klon,klev) ! flux entraine dans le panache montant
+  REAL pde_u(klon,klev) ! flux detraine dans le panache montant
+  REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
+  REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
+  REAL pt(klon,klev)
+  REAL,ALLOCATABLE,SAVE :: t(:,:)
+!$OMP THREADPRIVATE(t)
+!
+  REAL rlon(klon), rlat(klon), dtime
+  REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1)
+
+!   Couche limite:
+!   --------------
+!
+  REAL cdragh(klon)          ! cdrag
+  REAL pcoefh(klon,klev)     ! coeff melange CL
+  REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
+  REAL yv1(klon)
+  REAL yu1(klon),pphis(klon),paire(klon)
+
+!   Les Thermiques : (Abderr 25 11 02)
+!   ---------------
+  REAL, INTENT(IN) ::  pfm_therm(klon,klev+1)
+  REAL pentr_therm(klon,klev)
+  
+  REAL,ALLOCATABLE,SAVE :: entr_therm(:,:)
+  REAL,ALLOCATABLE,SAVE :: fm_therm(:,:)
+!$OMP THREADPRIVATE(entr_therm)
+!$OMP THREADPRIVATE(fm_therm)
+!
+!   Lessivage:
+!   ----------
+!
+  REAL frac_impa(klon,klev)
+  REAL frac_nucl(klon,klev)
+!
+! Arguments necessaires pour les sources et puits de traceur
+!
+  REAL ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
+  REAL pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
+!======================================================================
+!
+  INTEGER i, k, kk
+  REAL,ALLOCATABLE,SAVE :: mfu(:,:)  ! flux de masse dans le panache montant
+  REAL,ALLOCATABLE,SAVE :: mfd(:,:)  ! flux de masse dans le panache descendant
+  REAL,ALLOCATABLE,SAVE :: en_u(:,:) ! flux entraine dans le panache montant
+  REAL,ALLOCATABLE,SAVE :: de_u(:,:) ! flux detraine dans le panache montant
+  REAL,ALLOCATABLE,SAVE :: en_d(:,:) ! flux entraine dans le panache descendant
+  REAL,ALLOCATABLE,SAVE :: de_d(:,:) ! flux detraine dans le panache descendant
+  REAL,ALLOCATABLE,SAVE :: coefh(:,:) ! flux detraine dans le panache descendant
+  
+  REAL,ALLOCATABLE,SAVE :: pyu1(:)
+  REAL,ALLOCATABLE,SAVE :: pyv1(:)
+  REAL,ALLOCATABLE,SAVE :: pftsol(:,:)
+  REAL,ALLOCATABLE,SAVE :: ppsrf(:,:)
+!$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh)
+!$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf)
+
+
+  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: sh  
+  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: da
+  REAL,DIMENSION(:,:,:), ALLOCATABLE,SAVE   :: phi
+  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: mp
+  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: upwd
+  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: dnwd
+  
+  REAL, SAVE :: dtcum
+  INTEGER, SAVE:: iadvtr=0
+!$OMP THREADPRIVATE(dtcum,iadvtr)
+  REAL zmin,zmax
+  LOGICAL ok_sync
+  CHARACTER(len=12) :: nvar
+!
+!======================================================================
+
+  iadvtr=iadvtr+1
+
+! Dans le meme vecteur on recombine le drag et les coeff d'echange
+  pcoefh_buf(:,1)      = cdragh(:)
+  pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
+  
+  ok_sync = .TRUE.
+
+! Initialization done only once
+!======================================================================
+  IF (iadvtr==1) THEN
+     ALLOCATE( t(klon,klev))
+     ALLOCATE( mfu(klon,klev))  
+     ALLOCATE( mfd(klon,klev))  
+     ALLOCATE( en_u(klon,klev)) 
+     ALLOCATE( de_u(klon,klev)) 
+     ALLOCATE( en_d(klon,klev)) 
+     ALLOCATE( de_d(klon,klev)) 
+     ALLOCATE( coefh(klon,klev)) 
+     ALLOCATE( entr_therm(klon,klev))
+     ALLOCATE( fm_therm(klon,klev))
+     ALLOCATE( pyu1(klon))
+     ALLOCATE( pyv1(klon))
+     ALLOCATE( pftsol(klon,nbsrf))
+     ALLOCATE( ppsrf(klon,nbsrf))
+     
+     ALLOCATE(sh(klon,klev)) 
+     ALLOCATE(da(klon,klev)) 
+     ALLOCATE(phi(klon,klev,klev)) 
+     ALLOCATE(mp(klon,klev)) 
+     ALLOCATE(upwd(klon,klev)) 
+     ALLOCATE(dnwd(klon,klev)) 
+
+     CALL initphysto('phystoke', dtime, dtime*istphy,dtime*istphy,physid)
+     
+     ! Write field phis and aire only once
+     CALL histwrite_phy(physid,"phis",itap,pphis)
+     CALL histwrite_phy(physid,"aire",itap,paire)
+     CALL histwrite_phy(physid,"longitudes",itap,rlon)
+     CALL histwrite_phy(physid,"latitudes",itap,rlat)
+
+  END IF
+  
+  
+! Set to zero cumulating fields
+!======================================================================
+  IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN
+     WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr
+     mfu(:,:)=0.
+     mfd(:,:)=0.
+     en_u(:,:)=0.
+     de_u(:,:)=0.
+     en_d(:,:)=0.
+     de_d(:,:)=0.
+     coefh(:,:)=0.
+     t(:,:)=0.
+     fm_therm(:,:)=0.
+     entr_therm(:,:)=0.
+     pyv1(:)=0.
+     pyu1(:)=0.
+     pftsol(:,:)=0.
+     ppsrf(:,:)=0.
+     sh(:,:)=0.
+     da(:,:)=0.
+     phi(:,:,:)=0.
+     mp(:,:)=0.
+     upwd(:,:)=0.
+     dnwd(:,:)=0.
+     dtcum=0.
+  ENDIF
+  
+
+! Cumulate fields at each time step
+!======================================================================
+  DO k=1,klev
+     DO i=1,klon
+        mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
+        mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
+        en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
+        de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
+        en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
+        de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
+        coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
+        t(i,k)=t(i,k)+pt(i,k)*pdtphys
+        fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
+        entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
+        sh(i,k) = sh(i,k) + psh(i,k)*pdtphys
+        da(i,k) = da(i,k) + pda(i,k)*pdtphys
+        mp(i,k) = mp(i,k) + pmp(i,k)*pdtphys
+        upwd(i,k) = upwd(i,k) + pupwd(i,k)*pdtphys
+        dnwd(i,k) = dnwd(i,k) + pdnwd(i,k)*pdtphys
+     ENDDO
+  ENDDO
+
+  DO kk=1,klev
+     DO k=1,klev
+        DO i=1,klon
+           phi(i,k,kk) = phi(i,k,kk) + pphi(i,k,kk)*pdtphys
+        END DO
+     END DO
+  END DO
+
+  DO i=1,klon
+     pyv1(i)=pyv1(i)+yv1(i)*pdtphys
+     pyu1(i)=pyu1(i)+yu1(i)*pdtphys
+  END DO
+  DO k=1,nbsrf
+     DO i=1,klon
+        pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
+        ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
+     ENDDO
+  ENDDO
+  
+! Add time step to cumulated time
+  dtcum=dtcum+pdtphys
+  
+
+! Write fields to file, if it is time to do so
+!======================================================================
+  IF(MOD(iadvtr,istphy)==0) THEN 
+
+     ! normalize with time period
+     DO k=1,klev
+        DO i=1,klon
+           mfu(i,k)=mfu(i,k)/dtcum
+           mfd(i,k)=mfd(i,k)/dtcum
+           en_u(i,k)=en_u(i,k)/dtcum
+           de_u(i,k)=de_u(i,k)/dtcum
+           en_d(i,k)=en_d(i,k)/dtcum
+           de_d(i,k)=de_d(i,k)/dtcum
+           coefh(i,k)=coefh(i,k)/dtcum
+           t(i,k)=t(i,k)/dtcum	
+           fm_therm(i,k)=fm_therm(i,k)/dtcum
+           entr_therm(i,k)=entr_therm(i,k)/dtcum
+           sh(i,k)=sh(i,k)/dtcum
+           da(i,k)=da(i,k)/dtcum
+           mp(i,k)=mp(i,k)/dtcum
+           upwd(i,k)=upwd(i,k)/dtcum
+           dnwd(i,k)=dnwd(i,k)/dtcum
+        ENDDO
+     ENDDO
+     DO kk=1,klev
+        DO k=1,klev
+           DO i=1,klon
+              phi(i,k,kk) = phi(i,k,kk)/dtcum
+           END DO
+        END DO
+     END DO
+     DO i=1,klon
+        pyv1(i)=pyv1(i)/dtcum
+        pyu1(i)=pyu1(i)/dtcum
+     END DO
+     DO k=1,nbsrf
+        DO i=1,klon
+           pftsol(i,k)=pftsol(i,k)/dtcum
+           ppsrf(i,k)=ppsrf(i,k)/dtcum
+        ENDDO
+     ENDDO
+
+     ! write fields
+     CALL histwrite_phy(physid,"t",itap,t)
+     CALL histwrite_phy(physid,"mfu",itap,mfu)
+     CALL histwrite_phy(physid,"mfd",itap,mfd)
+     CALL histwrite_phy(physid,"en_u",itap,en_u)
+     CALL histwrite_phy(physid,"de_u",itap,de_u)
+     CALL histwrite_phy(physid,"en_d",itap,en_d)
+     CALL histwrite_phy(physid,"de_d",itap,de_d)
+     CALL histwrite_phy(physid,"coefh",itap,coefh)	
+     CALL histwrite_phy(physid,"fm_th",itap,fm_therm)
+     CALL histwrite_phy(physid,"en_th",itap,entr_therm)
+     CALL histwrite_phy(physid,"frac_impa",itap,frac_impa)
+     CALL histwrite_phy(physid,"frac_nucl",itap,frac_nucl)
+     CALL histwrite_phy(physid,"pyu1",itap,pyu1)
+     CALL histwrite_phy(physid,"pyv1",itap,pyv1)
+     CALL histwrite_phy(physid,"ftsol1",itap,pftsol(:,1))
+     CALL histwrite_phy(physid,"ftsol2",itap,pftsol(:,2))
+     CALL histwrite_phy(physid,"ftsol3",itap,pftsol(:,3))
+     CALL histwrite_phy(physid,"ftsol4",itap,pftsol(:,4))
+     CALL histwrite_phy(physid,"psrf1",itap,ppsrf(:,1))
+     CALL histwrite_phy(physid,"psrf2",itap,ppsrf(:,2))
+     CALL histwrite_phy(physid,"psrf3",itap,ppsrf(:,3))
+     CALL histwrite_phy(physid,"psrf4",itap,ppsrf(:,4))
+     CALL histwrite_phy(physid,"sh",itap,sh)
+     CALL histwrite_phy(physid,"da",itap,da)
+     CALL histwrite_phy(physid,"mp",itap,mp)
+     CALL histwrite_phy(physid,"upwd",itap,upwd)
+     CALL histwrite_phy(physid,"dnwd",itap,dnwd)
+
+
+! phi
+     DO k=1,klev
+        IF (k<10) THEN
+           WRITE(nvar,'(i1)') k
+        ELSE IF (k<100) THEN
+           WRITE(nvar,'(i2)') k
+        ELSE
+           WRITE(nvar,'(i3)') k
+        END IF
+        nvar='phi_lev'//trim(nvar)
+        
+        CALL histwrite_phy(physid,nvar,itap,phi(:,:,k))
+     END DO
+     
+     ! Syncronize file
+!$OMP MASTER
+     IF (ok_sync) CALL histsync(physid)
+!$OMP END MASTER
+     
+     
+     ! Calculate min and max values for some fields (coefficients de lessivage)
+     zmin=1e33
+     zmax=-1e33
+     DO k=1,klev
+        DO i=1,klon
+           zmax=MAX(zmax,frac_nucl(i,k))
+           zmin=MIN(zmin,frac_nucl(i,k))
+        ENDDO
+     ENDDO
+     WRITE(lunout,*)'------ coefs de lessivage (min et max) --------'
+     WRITE(lunout,*)'facteur de nucleation ',zmin,zmax
+     zmin=1e33
+     zmax=-1e33
+     DO k=1,klev
+        DO i=1,klon
+           zmax=MAX(zmax,frac_impa(i,k))
+           zmin=MIN(zmin,frac_impa(i,k))
+        ENDDO
+     ENDDO
+     WRITE(lunout,*)'facteur d impaction ',zmin,zmax
+     
+  ENDIF ! IF(MOD(iadvtr,istphy)==0)
+
+END SUBROUTINE phystokenc
Index: trunk/libf/phylmd/phytrac.F90
===================================================================
--- trunk/libf/phylmd/phytrac.F90	(revision 53)
+++ trunk/libf/phylmd/phytrac.F90	(revision 66)
@@ -66,6 +66,6 @@
 !--------
   REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: u       ! 
-  REAL,DIMENSION(klon,klev),INTENT(IN)   :: v       ! 
+  REAL,DIMENSION(klon,klev),INTENT(IN)   :: u       ! variable not used
+  REAL,DIMENSION(klon,klev),INTENT(IN)   :: v       ! variable not used
   REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
   REAL,DIMENSION(klon,klev),INTENT(IN)   :: rh      ! humidite relative
@@ -118,5 +118,5 @@
 !--------------
 !
-  REAL,DIMENSION(klon,klev),INTENT(IN) :: cdragh ! coeff drag pour T et Q
+  REAL,DIMENSION(klon),INTENT(IN)      :: cdragh ! coeff drag pour T et Q
   REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh  ! coeff melange CL (m**2/s)
   REAL,DIMENSION(klon),INTENT(IN)      :: yu1    ! vents au premier niveau
@@ -213,6 +213,5 @@
      SELECT CASE(type_trac)
      CASE('lmdz')
-!IM ajout t_seri, pplay, sh    CALL traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)
-        CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, aerosol, lessivage)
+        CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
      CASE('inca')
         source(:,:)=0.
Index: trunk/libf/phylmd/read_map2D.F90
===================================================================
--- trunk/libf/phylmd/read_map2D.F90	(revision 53)
+++ trunk/libf/phylmd/read_map2D.F90	(revision 66)
@@ -11,6 +11,6 @@
 
 ! Input arguments
-  CHARACTER(len=20), INTENT(IN) :: filename     ! name of file to read
-  CHARACTER(len=20), INTENT(IN) :: varname      ! name of variable in file
+  CHARACTER(len=*), INTENT(IN)  :: filename     ! name of file to read
+  CHARACTER(len=*), INTENT(IN)  :: varname      ! name of variable in file
   INTEGER, INTENT(IN)           :: timestep     ! actual timestep
   LOGICAL, INTENT(IN)           :: inverse      ! TRUE if latitude needs to be inversed
@@ -27,18 +27,21 @@
   REAL, DIMENSION(nbp_lon,nbp_lat) :: var_glo2D_tmp ! 2D global
   REAL, DIMENSION(klon_glo)        :: var_glo1D     ! 1D global
-
+  INCLUDE "iniprint.h"
 
 ! Read variable from file. Done by master process MPI and master thread OpenMP
   IF (is_mpi_root .AND. is_omp_root) THEN
-     ierr = NF90_OPEN (filename, NF90_NOWRITE, nid)
-     IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Problem in opening file '//filename,1)
+     ierr = NF90_OPEN(trim(filename), NF90_NOWRITE, nid)
+     IF (ierr /= NF90_NOERR) CALL write_err_mess('Problem in opening file')
 
-     ierr = NF90_INQ_VARID(nid, varname, nvarid)
-     IF (ierr /= NF90_NOERR) CALL abort_gcm(modname, 'The variable '//varname//' is absent in file',1)
+     ierr = NF90_INQ_VARID(nid, trim(varname), nvarid)
+     IF (ierr /= NF90_NOERR) CALL write_err_mess('The variable is absent in file')
      
      start=(/1,1,timestep/)
      count=(/nbp_lon,nbp_lat,1/)
      ierr = NF90_GET_VAR(nid, nvarid, var_glo2D,start,count)
-     IF (ierr /= NF90_NOERR) CALL abort_gcm(modname, 'Problem in reading varaiable '//varname,1)
+     IF (ierr /= NF90_NOERR) CALL write_err_mess('Problem in reading varaiable')
+
+     ierr = NF90_CLOSE(nid)
+     IF (ierr /= NF90_NOERR) CALL write_err_mess('Problem in closing file')
 
      ! Inverse latitude order
@@ -53,4 +56,7 @@
      CALL grid2Dto1D_glo(var_glo2D,var_glo1D)
 
+     WRITE(lunout,*) 'in read_map2D, filename = ', trim(filename)
+     WRITE(lunout,*) 'in read_map2D, varname  = ', trim(varname)
+     WRITE(lunout,*) 'in read_map2D, timestep = ', timestep
   ENDIF
 
@@ -58,3 +64,17 @@
   CALL scatter(var_glo1D, varout)
 
+  CONTAINS
+    SUBROUTINE write_err_mess(err_mess)
+
+      CHARACTER(len=*), INTENT(IN) :: err_mess
+      INCLUDE "iniprint.h"
+      
+      WRITE(lunout,*) 'Error in read_map2D, filename = ', trim(filename)
+      WRITE(lunout,*) 'Error in read_map2D, varname  = ', trim(varname)
+      WRITE(lunout,*) 'Error in read_map2D, timestep = ', timestep
+
+      CALL abort_gcm(modname, err_mess, 1)
+
+    END SUBROUTINE write_err_mess
+
 END SUBROUTINE read_map2D
Index: trunk/libf/phylmd/readaerosol.F90
===================================================================
--- trunk/libf/phylmd/readaerosol.F90	(revision 53)
+++ trunk/libf/phylmd/readaerosol.F90	(revision 66)
@@ -1,3 +1,3 @@
-! $Id: readaerosol.F90 1403 2010-07-01 09:02:53Z fairhead $
+! $Id: readaerosol.F90 1484 2011-02-09 15:44:57Z jghattas $
 !
 MODULE readaerosol_mod
@@ -7,5 +7,5 @@
 CONTAINS
 
-SUBROUTINE readaerosol(name_aero, type, iyr_in, klev_src, pt_ap, pt_b, pt_out, psurf, load)
+SUBROUTINE readaerosol(name_aero, type, filename, iyr_in, klev_src, pt_ap, pt_b, pt_out, psurf, load)
 
 !****************************************************************************************
@@ -27,5 +27,6 @@
   ! Input arguments
   CHARACTER(len=7), INTENT(IN) :: name_aero
-  CHARACTER(len=*), INTENT(IN) :: type  ! correspond to aer_type in clesphys.h
+  CHARACTER(len=*), INTENT(IN) :: type  ! actuel, annuel, scenario or preind
+  CHARACTER(len=8), INTENT(IN) :: filename
   INTEGER, INTENT(IN)          :: iyr_in
 
@@ -58,5 +59,5 @@
      ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
      ! pt_out has dimensions (klon, klev_src, 12)
-     CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
+     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
      
 
@@ -67,5 +68,5 @@
      ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
      ! pt_out has dimensions (klon, klev_src, 12)
-     CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
+     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
      
   ELSE IF (type == 'annuel') THEN
@@ -76,5 +77,5 @@
      ! get_aero_fromfile returns pt_out allocated and initialized with data for nbr_tsteps month 
      ! pt_out has dimensions (klon, klev_src, 12)
-     CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
+     CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
      
   ELSE IF (type == 'scenario') THEN
@@ -86,5 +87,5 @@
         ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
         ! pt_out has dimensions (klon, klev_src, 12)
-        CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
+        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
         
      ELSE IF (iyr_in .GE. 2100) THEN
@@ -93,5 +94,5 @@
         ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
         ! pt_out has dimensions (klon, klev_src, 12)
-        CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
+        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
         
      ELSE
@@ -113,5 +114,5 @@
         ! get_aero_fromfile returns pt_out allocated and initialized with data for 12 month 
         ! pt_out has dimensions (klon, klev_src, 12)
-        CALL get_aero_fromfile(name_aero, cyear, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
+        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, p0, pt_out, psurf, load)
         
         ! If to read two decades:
@@ -125,5 +126,5 @@
            ! get_aero_fromfile returns pt_2 allocated and initialized with data for 12 month 
            ! pt_2 has dimensions (klon, klev_src, 12)
-           CALL get_aero_fromfile(name_aero, cyear, klev_src2, pt_ap, pt_b, p0, pt_2, psurf2, load2)
+           CALL get_aero_fromfile(name_aero, cyear, filename, klev_src2, pt_ap, pt_b, p0, pt_2, psurf2, load2)
            ! Test for same number of vertical levels
            IF (klev_src /= klev_src2) THEN
@@ -160,5 +161,5 @@
 
   ELSE
-     WRITE(lunout,*)'This option is not implemented : aer_type = ', type
+     WRITE(lunout,*)'This option is not implemented : aer_type = ', type,' name_aero=',name_aero
      CALL abort_gcm('readaerosol','Error : aer_type parameter not accepted',1)
   END IF ! type
@@ -168,5 +169,5 @@
 
 
-  SUBROUTINE get_aero_fromfile(varname, cyr, klev_src, pt_ap, pt_b, p0, pt_year, psurf_out, load_out)
+  SUBROUTINE get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, p0, pt_year, psurf_out, load_out)
 !****************************************************************************************
 ! Read 12 month aerosol from file and distribute to local process on physical grid. 
@@ -200,4 +201,5 @@
     CHARACTER(len=7), INTENT(IN)          :: varname
     CHARACTER(len=4), INTENT(IN)          :: cyr
+    CHARACTER(len=8), INTENT(IN)          :: filename
 
 ! Output arguments
@@ -213,5 +215,4 @@
 ! Local variables
     CHARACTER(len=30)     :: fname
-    CHARACTER(len=8)      :: filename='aerosols'
     CHARACTER(len=30)     :: cvar
     INTEGER               :: ncid, dimid, varid
@@ -242,7 +243,8 @@
 ! 1) Open file 
 !****************************************************************************************
-       fname = filename//cyr//'.nc'
+! Add suffix to filename
+       fname = trim(filename)//cyr//'.nc'
   
-       WRITE(lunout,*) 'reading ', TRIM(fname)
+       WRITE(lunout,*) 'reading variable ',TRIM(varname),' in file ', TRIM(fname)
        CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid) )
 
@@ -283,14 +285,4 @@
           CALL abort_gcm('get_aero_fromfile', 'latitudes do not correspond between file and model',1)
        END IF
-
-! 1.5) Check number of month in file opened
-!
-!**************************************************************************************************
-       ierr = nf90_inq_dimid(ncid, 'TIME',dimid)
-       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps) )
-!       IF (nbr_tsteps /= 12 .AND. nbr_tsteps /= 14) THEN
-       IF (nbr_tsteps /= 12 ) THEN
-         CALL abort_gcm('get_aero_fromfile', 'not the right number of months in aerosol file read (should be 12 for the moment)',1)
-       ENDIF
 
 
@@ -335,4 +327,12 @@
 
        IF (new_file) THEN
+! ++) Check number of month in file opened
+!**************************************************************************************************
+       ierr = nf90_inq_dimid(ncid, 'TIME',dimid)
+       CALL check_err( nf90_inquire_dimension(ncid, dimid, len = nbr_tsteps) )
+!       IF (nbr_tsteps /= 12 .AND. nbr_tsteps /= 14) THEN
+       IF (nbr_tsteps /= 12 ) THEN
+         CALL abort_gcm('get_aero_fromfile', 'not the right number of months in aerosol file read (should be 12 for the moment)',1)
+       ENDIF
 
 ! ++) Read the aerosol concentration month by month and concatenate to total variable varyear
Index: trunk/libf/phylmd/readaerosol_interp.F90
===================================================================
--- trunk/libf/phylmd/readaerosol_interp.F90	(revision 53)
+++ trunk/libf/phylmd/readaerosol_interp.F90	(revision 66)
@@ -92,4 +92,6 @@
   LOGICAL,SAVE       :: debug=.FALSE.! Debugging in this subroutine
 !$OMP THREADPRIVATE(vert_interp, debug)
+  CHARACTER(len=8)      :: type
+  CHARACTER(len=8)      :: filename
 
 
@@ -173,5 +175,32 @@
      ! Reading values corresponding to the closest year taking into count the choice of aer_type. 
      ! For aer_type=scenario interpolation between 2 data sets is done in readaerosol.
-     CALL readaerosol(name_aero(id_aero), aer_type, iyr, klev_src, pt_ap, pt_b, pt_tmp, &
+     ! If aer_type=mix1 or mix2, the run type and file name depends on the aerosol.
+     IF (aer_type=='preind' .OR. aer_type=='actuel' .OR. aer_type=='annuel' .OR. aer_type=='scenario') THEN
+        ! Standard case
+        filename='aerosols'
+        type=aer_type
+     ELSE IF (aer_type == 'mix1') THEN
+        ! Special case using a mix of decenal sulfate file and annual aerosols(all aerosols except sulfate)
+        IF (name_aero(id_aero) == 'SO4') THEN
+           filename='so4.run '
+           type='scenario'
+        ELSE
+           filename='aerosols'
+           type='annuel'
+        END IF
+     ELSE  IF (aer_type == 'mix2') THEN
+        ! Special case using a mix of decenal sulfate file and natrual aerosols
+        IF (name_aero(id_aero) == 'SO4') THEN
+           filename='so4.run '
+           type='scenario'
+        ELSE
+           filename='aerosols'
+           type='preind'
+        END IF
+     ELSE
+        CALL abort_gcm('readaerosol_interp', 'this aer_type not supported',1)
+     END IF
+
+     CALL readaerosol(name_aero(id_aero), type, filename, iyr, klev_src, pt_ap, pt_b, pt_tmp, &
           psurf_year(:,:,id_aero), load_year(:,:,id_aero))
      IF (.NOT. ALLOCATED(var_year)) THEN
@@ -182,5 +211,6 @@
 
      ! Reading values corresponding to the preindustrial concentrations.
-     CALL readaerosol(name_aero(id_aero), 'preind', iyr, pi_klev_src, pt_ap, pt_b, pt_tmp, &
+     type='preind'
+     CALL readaerosol(name_aero(id_aero), type, filename, iyr, pi_klev_src, pt_ap, pt_b, pt_tmp, &
           pi_psurf_year(:,:,id_aero), pi_load_year(:,:,id_aero))
 
Index: trunk/libf/phylmd/statto.h
===================================================================
--- trunk/libf/phylmd/statto.h	(revision 66)
+++ trunk/libf/phylmd/statto.h	(revision 66)
@@ -0,0 +1,34 @@
+
+!  statto:
+!     This include file controls the production of statistics.
+!     Some variables could be set in a namelist, but it is easier to
+!     do it here since arrays can then be dimensioned using parameters
+!     and values shouldn't have to change too often.   SRL
+
+!     Calculate stats every istats physics timesteps, starting at first
+!     call.  If istats=0 then don't do statistics at all.  Check value
+!     if number of physics timesteps changes.
+	integer istats
+
+!     Calculate itime independent sums and sums of squares,
+!     example, istat=1,istime=1 gives a single time mean
+	integer, parameter :: istime=12
+
+!     Number of 2D and 3D variables on which to do statistics.
+	integer n2dvar, n3dvar
+	parameter (n2dvar = 8, n3dvar = 5)
+
+!     Units for writing stats header and data
+	integer usdata
+
+!     count tab to know the variable record
+        integer count(istime)
+
+!     Record of the number of stores made for each time.
+	integer nstore(istime)
+
+! Size of the "controle" array
+        integer, parameter :: cntrlsize=15
+
+!       common /sttcom/ dummy,nstore,istats,usdata
+        common /sttcom/ nstore,istats,usdata,count
Index: trunk/libf/phylmd/surf_land_orchidee_mod.F90
===================================================================
--- trunk/libf/phylmd/surf_land_orchidee_mod.F90	(revision 53)
+++ trunk/libf/phylmd/surf_land_orchidee_mod.F90	(revision 66)
@@ -43,6 +43,5 @@
     USE mod_surf_para
     USE mod_synchro_omp
-   
-USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_land_inst, fco2_lu_inst
+    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
 
 !    
@@ -138,6 +137,4 @@
     INTEGER                                   :: error
     REAL, DIMENSION(klon)                     :: swdown_vrai
-    REAL, DIMENSION(klon)                     :: fco2_land_comp  ! sur grille compresse
-    REAL, DIMENSION(klon)                     :: fco2_lu_comp    ! sur grille compresse
     CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
     CHARACTER (len = 80)                      :: abort_message
@@ -348,14 +345,9 @@
        ENDIF
 !
-! Allocate variables needed for carbon_cycle_mod
+! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
 !
        IF (carbon_cycle_cpl) THEN
-          IF (.NOT. ALLOCATED(fco2_land_inst)) THEN
-             ALLOCATE(fco2_land_inst(klon),stat=error)
-             IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fco2_land_inst',1)
-             
-             ALLOCATE(fco2_lu_inst(klon),stat=error)
-             IF(error /=0) CALL abort_gcm(modname,'Pb in allocation fco2_lu_inst',1)
-          END IF
+          abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
+          CALL abort_gcm(modname,abort_message,1)
        END IF
        
@@ -464,22 +456,4 @@
 
     
-! JG : TEMPORAIRE!!!! Les variables fco2_land_comp et fco2_lu_comp seront plus tard en sortie d'ORCHIDEE
-!      ici mis a valeur quelquonque pour test. Ces variables sont sur la grille compresse avec uniquement des points de terres
-
-    fco2_land_comp(:) = 1.
-    fco2_lu_comp(:)   = 10.
-
-! Decompress variables for the module carbon_cycle_mod
-    IF (carbon_cycle_cpl) THEN
-       fco2_land_inst(:)=0.
-       fco2_lu_inst(:)=0.
-       
-       DO igrid = 1, knon
-          ireal = knindex(igrid)
-          fco2_land_inst(ireal) = fco2_land_comp(igrid)
-          fco2_lu_inst(ireal)   = fco2_lu_comp(igrid)
-       END DO
-    END IF
-
   END SUBROUTINE surf_land_orchidee
 !
Index: trunk/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90
===================================================================
--- trunk/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 53)
+++ trunk/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90	(revision 66)
@@ -138,7 +138,7 @@
     INTEGER                                   :: ij, jj, igrid, ireal, index
     INTEGER                                   :: error
+    INTEGER, SAVE                             :: nb_fields_cpl ! number of fields for the climate-carbon coupling (between ATM and ORCHIDEE). 
+    REAL, SAVE, ALLOCATABLE, DIMENSION(:,:)   :: fields_cpl    ! Fluxes for the climate-carbon coupling
     REAL, DIMENSION(klon)                     :: swdown_vrai
-    REAL, DIMENSION(klon)                     :: fco2_land_comp  ! sur grille compresse
-    REAL, DIMENSION(klon)                     :: fco2_lu_comp    ! sur grille compresse
     CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
     CHARACTER (len = 80)                      :: abort_message
@@ -210,4 +210,12 @@
   
     IF (debut) THEN
+! Test de coherence
+#ifndef ORCH_NEW
+       ! Compilation avec orchidee nouvelle version necessaire avec carbon_cycle_cpl=y
+       IF (carbon_cycle_cpl) THEN
+          abort_message='You must define preprossing key ORCH_NEW when running carbon_cycle_cpl=y'
+          CALL abort_gcm(modname,abort_message,1)
+       END IF
+#endif
        ALLOCATE(ktindex(knon))
        IF ( .NOT. ALLOCATED(albedo_keep)) THEN
@@ -342,14 +350,21 @@
 !
 ! Allocate variables needed for carbon_cycle_mod
-!
+       IF ( carbon_cycle_cpl ) THEN
+          nb_fields_cpl=2
+       ELSE
+          nb_fields_cpl=1
+       END IF
+
+
        IF (carbon_cycle_cpl) THEN
-          IF (.NOT. ALLOCATED(fco2_land_inst)) THEN
-             ALLOCATE(fco2_land_inst(klon),stat=error)
-             IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fco2_land_inst',1)
-             
-             ALLOCATE(fco2_lu_inst(klon),stat=error)
-             IF(error /=0) CALL abort_gcm(modname,'Pb in allocation fco2_lu_inst',1)
-          END IF
+          ALLOCATE(fco2_land_inst(klon),stat=error)
+          IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fco2_land_inst',1)
+          
+          ALLOCATE(fco2_lu_inst(klon),stat=error)
+          IF(error /=0) CALL abort_gcm(modname,'Pb in allocation fco2_lu_inst',1)
        END IF
+
+       ALLOCATE(fields_cpl(klon,nb_fields_cpl), stat = error)
+       IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation fields_cpl',1)
 
     ENDIF                          ! (fin debut) 
@@ -406,8 +421,13 @@
                evap, fluxsens, fluxlat, coastalflow, riverflow, &
                tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
-               lon_scat, lat_scat, q2m, t2m)
+               lon_scat, lat_scat, q2m, t2m &
+#ifdef ORCH_NEW
+               , nb_fields_cpl, fields_cpl)
+#else
+               )
+#endif
 
 #else          
-          ! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4) compiled in parallel mode(with preprocessing flag CPP_MPI)
+          ! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4, 1.9.5) compiled in parallel mode(with preprocessing flag CPP_MPI)
           CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, offset, knon, ktindex, & 
                orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
@@ -418,5 +438,10 @@
                evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
                tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
-               lon_scat, lat_scat, q2m, t2m)
+               lon_scat, lat_scat, q2m, t2m &
+#ifdef ORCH_NEW
+               , nb_fields_cpl, fields_cpl(1:knon,:))
+#else
+               )
+#endif
 #endif
           
@@ -431,5 +456,4 @@
 
     IF (knon /=0) THEN
-    
 #ifndef CPP_MPI
        ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
@@ -442,6 +466,10 @@
             evap, fluxsens, fluxlat, coastalflow, riverflow, &
             tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
-            lon_scat, lat_scat, q2m, t2m)
-       
+            lon_scat, lat_scat, q2m, t2m &
+#ifdef ORCH_NEW
+            , nb_fields_cpl, fields_cpl)
+#else
+            )
+#endif
 #else
        ! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
@@ -454,7 +482,11 @@
             evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
             tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
-            lon_scat, lat_scat, q2m, t2m)
-#endif
-       
+            lon_scat, lat_scat, q2m, t2m &
+#ifdef ORCH_NEW
+            , nb_fields_cpl, fields_cpl(1:knon,:))
+#else
+            )
+#endif
+#endif
     ENDIF
 
@@ -478,11 +510,4 @@
 
     IF (debut) lrestart_read = .FALSE.
-
-
-! JG : TEMPORAIRE!!!! Les variables fco2_land_comp et fco2_lu_comp seront plus tard en sortie d'ORCHIDEE
-!      ici mis a valeur quelquonque pour test. Ces variables sont sur la grille compresse avec uniquement des points de terres
-
-    fco2_land_comp(:) = 1.
-    fco2_lu_comp(:)   = 10.
 
 ! Decompress variables for the module carbon_cycle_mod
@@ -493,6 +518,6 @@
        DO igrid = 1, knon
           ireal = knindex(igrid)
-          fco2_land_inst(ireal) = fco2_land_comp(igrid)
-          fco2_lu_inst(ireal)   = fco2_lu_comp(igrid)
+          fco2_land_inst(ireal) = fields_cpl(igrid,1)
+          fco2_lu_inst(ireal)   = fields_cpl(igrid,2)
        END DO
     END IF
Index: trunk/libf/phylmd/traclmdz_mod.F90
===================================================================
--- trunk/libf/phylmd/traclmdz_mod.F90	(revision 53)
+++ trunk/libf/phylmd/traclmdz_mod.F90	(revision 66)
@@ -84,5 +84,5 @@
 
 
-  SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, aerosol, lessivage)
+  SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
     ! This subroutine allocates and initialize module variables and control variables.
     ! Initialization of the tracers should be done here only for those not found in the restart file.
@@ -104,4 +104,5 @@
     REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
     REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
+    REAL,INTENT(IN)                        :: pdtphys ! Pas d'integration pour la physique (seconde)  
 
 ! Output variables
@@ -226,5 +227,5 @@
 ! ----------------------------------------------
     IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
-       CALL carbon_cycle_init(tr_seri, aerosol, radio)
+       CALL carbon_cycle_init(tr_seri, pdtphys, aerosol, radio)
     END IF
 
@@ -312,5 +313,5 @@
 !--------------
 !
-    REAL,DIMENSION(klon,klev),INTENT(IN) :: cdragh     ! coeff drag pour T et Q
+    REAL,DIMENSION(klon),INTENT(IN)      :: cdragh     ! coeff drag pour T et Q
     REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh      ! coeff melange CL (m**2/s)
     REAL,DIMENSION(klon),INTENT(IN)      :: yu1        ! vents au premier niveau
@@ -546,5 +547,5 @@
 !======================================================================
     IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
-       CALL carbon_cycle(nstep, pdtphys, pctsrf, tr_seri)
+       CALL carbon_cycle(nstep, pdtphys, pctsrf, tr_seri, source)
     END IF
 
Index: trunk/libf/phylmd/wstats.F90
===================================================================
--- trunk/libf/phylmd/wstats.F90	(revision 66)
+++ trunk/libf/phylmd/wstats.F90	(revision 66)
@@ -0,0 +1,351 @@
+subroutine wstats(ngrid,nom,titre,unite,dim,px)
+
+implicit none
+
+#include "dimensions.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,intent(in) :: ngrid
+character (len=*),intent(in) :: nom,titre,unite
+integer,intent(in) :: dim
+real, dimension(ngrid,llm),intent(in) :: px
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
+real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
+character (len=50) :: namebis
+character (len=50), save :: firstvar
+integer :: ierr,varid,nbdim,nid
+integer :: meanid,sdid
+integer, dimension(4)  :: id,start,size
+logical, save :: firstcall=.TRUE.
+integer :: l,i,j,ig0
+integer,save :: index
+
+integer, save :: step=0
+
+
+if (firstcall) then
+   firstcall=.false.
+   firstvar=trim((nom))
+   call inistats(ierr)
+endif
+
+if (firstvar==nom) then ! If we're back to the first variable
+      step = step + 1
+endif
+
+if (mod(step,istats).ne.0) then
+   RETURN
+endif
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+namebis=trim(nom)
+ierr= NF_INQ_VARID(nid,namebis,meanid)
+
+if (ierr.ne.NF_NOERR) then
+
+   if (firstvar==nom) then 
+      index=1
+      count=0
+   endif
+
+
+!declaration de la variable
+
+! choix du nom des coordonnees
+   ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+   ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+   if (dim.eq.3) then
+      ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+      ierr= NF_INQ_DIMID(nid,"Time",id(4))
+      nbdim=4
+   else if (dim==2) then
+      ierr= NF_INQ_DIMID(nid,"Time",id(3))
+      nbdim=3
+   endif
+
+   write (*,*) "====================="
+   write (*,*) "STATS: creation de ",nom
+   namebis=trim(nom)
+   call def_var_stats(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+   namebis=trim(nom)//"_sd"
+   call def_var_stats(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+   call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+
+   ierr= NF_CLOSE(nid)
+   return
+
+else
+   namebis=trim(nom)//"_sd"
+   ierr= NF_INQ_VARID(nid,namebis,sdid)
+
+endif
+
+if (firstvar==nom) then 
+   count(index)=count(int(index))+1
+   index=index+1
+   if (index>istime) then
+      index=1
+   endif
+endif
+
+if (count(index)==0) then
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+      mean3d=0
+      sd3d=0
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+      mean2d=0
+      sd2d=0
+   endif
+else
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+   endif
+endif
+
+if (dim.eq.3) then
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+   mean3d(:,:,:)= mean3d(:,:,:)+dx3(:,:,:)
+   sd3d(:,:,:)= sd3d(:,:,:)+dx3(:,:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+   if (ierr.ne.NF_NOERR) then
+     write (*,*) NF_STRERROR(ierr)
+     stop ""
+   endif
+
+else if (dim.eq.2) then
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+   mean2d(:,:)= mean2d(:,:)+dx2(:,:)
+   sd2d(:,:)= sd2d(:,:)+dx2(:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+   if (ierr.ne.NF_NOERR) then
+     write (*,*) NF_STRERROR(ierr)
+     stop ""
+   endif
+
+endif
+
+ierr= NF_CLOSE(nid)
+
+end subroutine wstats
+
+!======================================================
+subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
+
+implicit none
+
+include "dimensions.h"
+!!!!!!include "dimphys.h"
+include "netcdf.inc"
+
+integer, intent(in) :: nid,varid,dim,index,ngrid
+real, dimension(ngrid,llm), intent(in) :: px
+integer, intent(out) :: ierr
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+
+integer :: l,i,j,ig0
+integer, dimension(4) :: start,size
+real, dimension(iip1,jjp1,llm) :: dx3
+real, dimension(iip1,jjp1) :: dx2
+
+if (dim.eq.3) then
+
+   start=(/1,1,1,index/)
+   size=(/iip1,jjp1,llm,1/)
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
+#endif
+
+else if (dim.eq.2) then
+
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
+#endif
+
+endif
+
+end subroutine inivar
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine def_var_stats(nid,name,title,units,nbdim,dimids,nvarid,ierr)
+
+! This subroutine defines variable 'name' in a (pre-existing and opened)
+! NetCDF file (known from its NetCDF ID 'nid').
+! The number of dimensions 'nbdim' of the variable, as well as the IDs of
+! corresponding dimensions must be set (in array 'dimids').
+! Upon successfull definition of the variable, 'nvarid' contains the
+! NetCDF ID of the variable.
+! The variables' attributes 'title' (Note that 'long_name' would be more
+! appropriate) and 'units' are also set. 
+
+implicit none
+
+#include "netcdf.inc"
+
+integer,intent(in) :: nid ! NetCDF file ID
+character(len=*),intent(in) :: name ! the variable's name
+character(len=*),intent(in) :: title ! 'title' attribute of variable
+character(len=*),intent(in) :: units ! 'units' attribute of variable
+integer,intent(in) :: nbdim ! number of dimensions of the variable
+integer,dimension(nbdim),intent(in) :: dimids ! NetCDF IDs of the dimensions
+                                              ! the variable is defined along
+integer,intent(out) :: nvarid ! NetCDF ID of the variable
+integer,intent(out) :: ierr ! returned NetCDF staus code
+
+! 1. Switch to NetCDF define mode 
+ierr=NF_REDEF(nid)
+
+! 2. Define the variable
+#ifdef NC_DOUBLE
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+#else
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+#endif
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var_stats: Failed defining variable "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 3. Write attributes
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",&
+                     len_trim(adjustl(title)),adjustl(title))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var_stats: Failed writing title attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",&
+                     len_trim(adjustl(units)),adjustl(units))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var_stats: Failed writing units attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 4. Switch out of NetCDF define mode
+ierr = NF_ENDDEF(nid)
+
+end subroutine def_var_stats
+
