Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerave.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerave.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerave.F	(revision 222)
@@ -0,0 +1,182 @@
+      subroutine aerave( ndata,
+     &     longdata,epdata,omegdata,gdata,          
+     &     longref,epref,temp,nir,longir
+     &     ,epir,omegir,gir,qref )
+
+
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculate mean values of aerosol quantities in each band.
+!     
+!     Authors
+!     ------- 
+!     R. Fournier (1996) 
+!     F. Forget (1996)
+!     
+!     Called by
+!     ---------
+!     suaer_corrk.F90
+!     
+!     Calls
+!     -----
+!     blackl.F
+!     
+!==================================================================
+
+!     
+!     R.Fournier 02/1996 
+!     (modif F.Forget 02/1996)
+!     le spectre est decoupe en "nir" bandes et cette routine calcule
+!     les donnees radiatives moyenne sur chaque bande : l'optimisation
+!     est faite pour une temperature au sol "temp" et une epaisseur
+!     optique de l'atmosphere "epref" a la longueur d'onde "longref"
+!     
+!     dans la version actuelle, les ponderations sont independantes de
+!     l'epaisseur optique : c'est a dire que "omegir", "gir"
+!     et "epir/epre" sont independants de "epref".
+!     en effet les ponderations sont choisies pour une solution exacte
+!     en couche mince et milieu isotherme. 
+!     
+!     entree
+!     
+!     ndata : taille des champs data
+!     longdata,epdata,omegdata,gdata : proprietes radiative de l'aerosol
+!     (longdata longueur d'onde en METRES)
+!     * longref : longueur d'onde a laquelle l'epaisseur optique
+!     est connue
+!     * epref : epaisseur optique a longref
+!     * temp : temperature choisie pour la ponderation (Planck)
+!     * nir : nombre d'intervals dans la discretisation spectrale
+!     du GCM
+!     * longir : longueurs d'onde definissant ces intervals
+!     
+!     sortie
+!     
+!     * epir : epaisseur optique moyenne pour chaque interval
+!     * omegir : "scattering albedo" moyen pour chaque interval
+!     * gir : "assymetry factor" moyen pour chaque interval
+!     * qref : extinction coefficient at reference wavelength
+
+!=======================================================================
+! output
+
+      REAL longref
+      REAL epref
+      REAL temp
+      INTEGER nir
+      REAL*8 longir(nir+1)
+      REAL epir(nir)
+      REAL omegir(nir)
+      REAL gir(nir)
+
+!=======================================================================
+
+      INTEGER iir,nirmx
+      PARAMETER (nirmx=100)
+      INTEGER idata,ndata
+
+      DOUBLE PRECISION tmp1
+      REAL tmp2,tmp3
+
+!=======================================================================
+! input
+
+      REAL emit
+      REAL totalemit(nirmx)
+      REAL longdata(ndata),epdata(ndata)
+     &     ,omegdata(ndata),gdata(ndata)
+      REAL qextcorrdata(ndata)
+      INTEGER ibande,nbande
+      PARAMETER (nbande=1000)
+
+      REAL long,deltalong
+      INTEGER ilong
+      INTEGER i1,i2
+      REAL c1,c2
+      REAL factep,qextcorr,omeg,g,qref
+
+      long=longref
+
+
+!=======================================================================
+!     pre-interpolation
+      ilong=1
+      DO idata=2,ndata
+         IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+         c1=1.E+0
+         c2=0.E+0
+      ELSE
+         c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+         c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+
+      qref=c1*epdata(i1)+c2*epdata(i2)
+      factep=qref/epref
+      DO idata=1,ndata
+         qextcorrdata(idata)=epdata(idata)/factep
+      ENDDO
+!=======================================================================
+
+      DO iir=1,nir
+
+         deltalong=(longir(iir+1)-longir(iir)) / nbande
+         totalemit(iir)=0.E+0
+         epir(iir)=0.E+0
+         omegir(iir)=0.E+0
+         gir(iir)=0.E+0
+
+         DO ibande=1,nbande
+
+            long=longir(iir) + (ibande-0.5E+0) * deltalong
+            CALL blackl(DBLE(long),DBLE(temp),tmp1)
+            emit=REAL(tmp1)
+
+!=======================================================================
+!     interpolation
+            ilong=1
+            DO idata=2,ndata
+               IF (long.gt.longdata(idata)) ilong=idata
+            ENDDO
+            i1=ilong
+            i2=ilong+1
+
+            IF (i2.gt.ndata) i2=ndata
+            IF (long.lt.longdata(1)) i2=1
+            IF (i1.eq.i2) THEN
+               c1=1.E+0
+               c2=0.E+0
+            ELSE
+               c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+               c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+            ENDIF
+!=======================================================================
+
+            qextcorr=c1*qextcorrdata(i1)+c2*qextcorrdata(i2)
+            omeg=c1*omegdata(i1)+c2*omegdata(i2)
+            g=c1*gdata(i1)+c2*gdata(i2)
+
+            totalemit(iir)=totalemit(iir)+deltalong*emit
+            epir(iir)=epir(iir)+deltalong*emit*qextcorr
+            omegir(iir)=omegir(iir)+deltalong*emit*omeg*qextcorr
+            gir(iir)=gir(iir)+deltalong*emit*omeg*qextcorr*g
+
+         ENDDO
+
+         gir(iir)=gir(iir)/omegir(iir)
+         omegir(iir)=omegir(iir)/epir(iir)
+         epir(iir)=epir(iir)/totalemit(iir)
+
+      ENDDO
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerave_new.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerave_new.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerave_new.F	(revision 222)
@@ -0,0 +1,223 @@
+      SUBROUTINE aerave_new ( ndata,
+     & longdata,epdata,omegdata,gdata,          
+     &            longref,epref,temp,nir,longir
+     &            ,epir,omegir,gir,qref,omegaref        )
+
+
+      IMPLICIT NONE
+c.......................................................................
+c
+c R.Fournier 02/1996 
+c (modif F.Forget 02/1996)
+c le spectre est decoupe en "nir" bandes et cette routine calcule
+c les donnees radiatives moyenne sur chaque bande : l'optimisation
+c est faite pour une temperature au sol "temp" et une epaisseur
+c optique de l'atmosphere "epref" a la longueur d'onde "longref"
+c
+c dans la version actuelle, les ponderations sont independantes de
+c l'epaisseur optique : c'est a dire que "omegir", "gir"
+c et "epir/epre" sont independants de "epref".
+c en effet les ponderations sont choisies pour une solution exacte
+c en couche mince et milieu isotherme. 
+c
+c entree
+c
+c    ndata : taille des champs data
+c    longdata,epdata,omegdata,gdata : proprietes radiative de l'aerosol
+c                  (longdata longueur d'onde en METRES)
+c  * longref : longueur d'onde a laquelle l'epaisseur optique
+c              est connue
+c  * epref : epaisseur optique a longref
+c  * temp : temperature choisie pour la ponderation (Planck)
+c  * nir : nombre d'intervals dans la discretisation spectrale
+c           du GCM
+c  * longir : longueurs d'onde definissant ces intervals
+c
+c sortie
+c
+c  * epir : epaisseur optique moyenne pour chaque interval
+c  * omegir : "scattering albedo" moyen pour chaque interval
+c  * gir : "assymetry factor" moyen pour chaque interval
+c  * qref : extinction coefficient at reference wavelength
+c  * omegaref : single scat. albedo at reference wavelength
+c
+c.......................................................................
+c
+      REAL longref
+      REAL epref
+      REAL temp
+      INTEGER nir
+      REAL*8 longir(nir+1)
+      REAL epir(nir)
+      REAL omegir(nir)
+      REAL gir(nir)
+c
+c.......................................................................
+c
+      INTEGER iir,nirmx
+      PARAMETER (nirmx=100)
+      INTEGER idata,ndata
+c
+c.......................................................................
+c
+      REAL emit
+      REAL totalemit(nirmx)
+      REAL longdata(ndata),epdata(ndata)
+     &    ,omegdata(ndata),gdata(ndata)
+      REAL qextcorrdata(ndata)
+      INTEGER ibande,nbande
+      PARAMETER (nbande=1000)
+      REAL long,deltalong
+      INTEGER ilong
+      INTEGER i1,i2
+      REAL c1,c2
+      REAL factep,qextcorr,omeg,g
+      REAL qref,omegaref
+c
+c.......................................................................
+c
+      DOUBLE PRECISION tmp1
+      REAL tmp2,tmp3
+c
+c
+      long=longref
+
+
+      !if(nir.eq.27)then
+      !print*,'long',long
+      !print*,'longdata',longdata
+      !print*,'epdata',epdata
+      !print*,'omegdata',omegdata
+      !print*,'gdata',gdata
+      !print*,'data looks aok!'
+
+      !print*,'ndata=',ndata
+      !print*,'longdata',shape(longdata)
+      !print*,'epdata',shape(epdata)
+      !print*,'omegdata',shape(omegdata)
+      !print*,'gdata',shape(gdata)
+      ! print*,'longref',longref
+      !print*,'epref',epref
+      !print*,'temp',temp
+      !print*,'nir',nir
+      !print*,'longir',longir
+      !print*,'epir',epir
+      !print*,'omegir',gir
+      !print*,'qref',qref
+      !print*,'longir=',longir
+      !stop
+      !endif
+
+
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+      qref=c1*epdata(i1)+c2*epdata(i2)
+      omegaref=c1*omegdata(i1)+c2*omegdata(i2)
+      factep=qref/epref
+      DO idata=1,ndata
+        qextcorrdata(idata)=epdata(idata)/factep
+      ENDDO
+c
+c.......................................................................
+c
+      DO iir=1,nir
+c
+c.......................................................................
+c
+        deltalong=(longir(iir+1)-longir(iir)) / nbande
+        totalemit(iir)=0.E+0
+        epir(iir)=0.E+0
+        omegir(iir)=0.E+0
+        gir(iir)=0.E+0
+c
+c.......................................................................
+c
+        DO ibande=1,nbande
+c
+c.......................................................................
+c
+          long=longir(iir) + (ibande-0.5E+0) * deltalong
+          CALL blackl(DBLE(long),DBLE(temp),tmp1)
+          emit=REAL(tmp1)
+c
+c.......................................................................
+c
+c********************************************************
+c interpolation
+      ilong=1
+      DO idata=2,ndata
+        IF (long.gt.longdata(idata)) ilong=idata
+      ENDDO
+      i1=ilong
+      i2=ilong+1
+      IF (i2.gt.ndata) i2=ndata
+      IF (long.lt.longdata(1)) i2=1
+      IF (i1.eq.i2) THEN
+        c1=1.E+0
+        c2=0.E+0
+      ELSE
+        c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
+        c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
+      ENDIF
+c********************************************************
+c
+          qextcorr=c1*qextcorrdata(i1)+c2*qextcorrdata(i2)
+          omeg=c1*omegdata(i1)+c2*omegdata(i2)
+          g=c1*gdata(i1)+c2*gdata(i2)
+c
+c.......................................................................
+c
+          totalemit(iir)=totalemit(iir)+deltalong*emit
+          epir(iir)=epir(iir)+deltalong*emit*qextcorr
+          omegir(iir)=omegir(iir)+deltalong*emit*omeg*qextcorr
+          gir(iir)=gir(iir)+deltalong*emit*omeg*qextcorr*g
+c
+c.......................................................................
+c
+        ENDDO
+c
+c.......................................................................
+c
+        gir(iir)=gir(iir)/omegir(iir)
+        omegir(iir)=omegir(iir)/epir(iir)
+        epir(iir)=epir(iir)/totalemit(iir)
+c
+c.......................................................................
+c
+      ENDDO
+c
+c......................................................................
+c
+c     Diagnostic de controle si on moyenne sur tout le spectre vis ou IR :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     tmp2=0.E+0
+c     DO iir=1,nir
+c       tmp2=tmp2+totalemit(iir)
+c     ENDDO
+c     tmp3=5.67E-8 * temp**4
+c     IF (abs((tmp2-tmp3)/tmp3).gt.0.05E+0) THEN
+c       PRINT *,'!!!! <---> il manque du Planck (voir moyenne.F)'
+c       PRINT *,'somme des bandes :',tmp2,'--- Planck:',tmp3
+c     ENDIF
+c
+c......................................................................
+c
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aeropacity.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aeropacity.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aeropacity.F90	(revision 222)
@@ -0,0 +1,449 @@
+      Subroutine aeropacity(ngrid,nlayer,nq,pplay,pplev,pq, &
+         aerosol,reffrad,QREFvis3d,QREFir3d,tau_col,cloudfrac,totcloudfrac,clearsky)
+
+       use radinc_h, only : L_TAUMAX,naerkind
+       use aerosol_mod
+       USE comgeomfi_h
+       USE tracer_h, only: noms,rho_co2,rho_ice
+                  
+       implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Compute aerosol optical depth in each gridbox.
+!     
+!     Authors
+!     ------- 
+!     F. Forget
+!     F. Montmessin (water ice scheme) 
+!     update J.-B. Madeleine (2008)
+!     dust removal, simplification by Robin Wordsworth (2009)
+!
+!     Input
+!     ----- 
+!     ngrid             Number of horizontal gridpoints
+!     nlayer            Number of layers
+!     nq                Number of tracers
+!     pplev             Pressure (Pa) at each layer boundary
+!     pq                Aerosol mixing ratio
+!     reffrad(ngrid,nlayer,naerkind)         Aerosol effective radius
+!     QREFvis3d(ngrid,nlayermx,naerkind) \ 3d extinction coefficients
+!     QREFir3d(ngrid,nlayermx,naerkind)  / at reference wavelengths
+!
+!     Output
+!     ------
+!     aerosol            Aerosol optical depth in layer l, grid point ig
+!     tau_col            Total column optical depth at grid point ig
+!
+!=======================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comvert.h"
+
+      INTEGER,INTENT(IN) :: ngrid  ! number of atmospheric columns
+      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
+      INTEGER,INTENT(IN) :: nq     ! number of tracers
+      REAL,INTENT(IN) :: pplay(ngrid,nlayer) ! mid-layer pressure (Pa)
+      REAL,INTENT(IN) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa)
+      REAL,INTENT(IN) :: pq(ngrid,nlayer,nq) ! tracers (.../kg_of_air)
+      REAL,INTENT(OUT) :: aerosol(ngrid,nlayer,naerkind) ! aerosol optical depth
+      REAL,INTENT(IN) :: reffrad(ngrid,nlayer,naerkind) ! aerosol effective radius
+      REAL,INTENT(IN) :: QREFvis3d(ngrid,nlayermx,naerkind) ! extinction coefficient in the visible
+      REAL,INTENT(IN) :: QREFir3d(ngrid,nlayermx,naerkind)
+      REAL,INTENT(OUT):: tau_col(ngrid) !column integrated visible optical depth
+      ! BENJAMIN MODIFS
+      real,intent(in) :: cloudfrac(ngrid,nlayermx) ! cloud fraction
+      real,intent(out) :: totcloudfrac(ngrid) ! total cloud fraction
+      logical,intent(in) :: clearsky
+
+      real aerosol0
+
+      INTEGER l,ig,iq,iaer
+
+      LOGICAL,SAVE :: firstcall=.true.
+      REAL CBRT
+      EXTERNAL CBRT
+
+      INTEGER,SAVE :: i_co2ice=0      ! co2 ice
+      INTEGER,SAVE :: i_h2oice=0      ! water ice
+      CHARACTER(LEN=20) :: tracername ! to temporarily store text
+
+      ! for fixed dust profiles
+      real topdust, expfactor, zp
+      REAL taudusttmp(ngrid) ! Temporary dust opacity used before scaling
+      REAL tauh2so4tmp(ngrid) ! Temporary h2so4 opacity used before scaling
+
+      real CLFtot
+
+      ! identify tracers
+      IF (firstcall) THEN
+
+        write(*,*) "Tracers found in aeropacity:"
+        do iq=1,nq
+          tracername=noms(iq)
+          if (tracername.eq."co2_ice") then
+            i_co2ice=iq
+          write(*,*) "i_co2ice=",i_co2ice
+
+          endif
+          if (tracername.eq."h2o_ice") then
+            i_h2oice=iq
+            write(*,*) "i_h2oice=",i_h2oice
+          endif
+        enddo
+
+        if (noaero) then
+          print*, "No active aerosols found in aeropacity"
+        else
+          print*, "If you would like to use aerosols, make sure any old"
+          print*, "start files are updated in newstart using the option"
+          print*, "q=0"
+          write(*,*) "Active aerosols found in aeropacity:"
+        endif
+
+        if ((iaero_co2.ne.0).and.(.not.noaero)) then
+          print*, 'iaero_co2=  ',iaero_co2
+        endif
+        if (iaero_h2o.ne.0) then
+          print*,'iaero_h2o=  ',iaero_h2o    
+        endif
+        if (iaero_dust.ne.0) then
+          print*,'iaero_dust= ',iaero_dust
+        endif
+        if (iaero_h2so4.ne.0) then
+          print*,'iaero_h2so4= ',iaero_h2so4
+        endif
+        if (iaero_back2lay.ne.0) then
+          print*,'iaero_back2lay= ',iaero_back2lay
+        endif
+
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+
+!     ---------------------------------------------------------
+!==================================================================
+!    CO2 ice aerosols
+!==================================================================
+
+      if (iaero_co2.ne.0) then
+           iaer=iaero_co2
+!       1. Initialization
+            aerosol(1:ngrid,1:nlayermx,iaer)=0.0
+!       2. Opacity calculation
+            if (noaero) then ! aerosol set to zero
+             aerosol(1:ngrid,1:nlayermx,iaer)=0.0
+            elseif (aerofixco2.or.(i_co2ice.eq.0)) then !  CO2 ice cloud prescribed
+               aerosol(1:ngrid,1:nlayermx,iaer)=1.e-9
+               !aerosol(1:ngrid,12,iaer)=4.0 ! single cloud layer option
+            else
+               DO ig=1, ngrid
+                  DO l=1,nlayer-1 ! to stop the rad tran bug
+
+                     aerosol0 =                         &
+                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
+                          ( rho_co2 * reffrad(ig,l,iaer) )  ) *   &
+                          ( pq(ig,l,i_co2ice) + 1.E-9 ) *         &
+                          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+                     aerosol0           = max(aerosol0,1.e-9)
+                     aerosol0           = min(aerosol0,L_TAUMAX)
+                     aerosol(ig,l,iaer) = aerosol0
+!                     aerosol(ig,l,iaer) = 0.0
+!                     print*, aerosol(ig,l,iaer)
+!        using cloud fraction
+!                     aerosol(ig,l,iaer) = -log(1 - CLF + CLF*exp(-aerosol0/CLF))
+!                     aerosol(ig,l,iaer) = min(aerosol(ig,l,iaer),L_TAUMAX)
+
+
+                  ENDDO
+               ENDDO
+            end if ! if fixed or varying
+      end if ! if CO2 aerosols   
+!==================================================================
+!     Water ice / liquid 
+!==================================================================
+
+      if (iaero_h2o.ne.0) then 
+           iaer=iaero_h2o
+!       1. Initialization
+            aerosol(1:ngrid,1:nlayermx,iaer)=0.0
+!       2. Opacity calculation
+            if (aerofixh2o.or.(i_h2oice.eq.0).or.clearsky) then
+               aerosol(1:ngrid,1:nlayermx,iaer) =1.e-9
+
+               ! put cloud at cloudlvl
+               if(kastprof.and.(cloudlvl.ne.0.0))then
+                  ig=1
+                  do l=1,nlayer
+                     if(int(cloudlvl).eq.l)then
+                     !if(cloudlvl.gt.(pplay(ig,l)/pplev(ig,1)))then
+                        print*,'Inserting cloud at level ',l
+                        !aerosol(ig,l,iaer)=10.0
+
+                        rho_ice=920.0
+
+                        ! the Kasting approximation
+                        aerosol(ig,l,iaer) =                      &
+                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
+                          ( rho_ice * reffrad(ig,l,iaer) )  ) *   &
+                          !( pq(ig,l,i_h2oice) + 1.E-9 ) *         &
+                          ( 4.0e-4 + 1.E-9 ) *         &
+                          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+
+
+                        open(115,file='clouds.out',form='formatted')
+                        write(115,*) l,aerosol(ig,l,iaer)
+                        close(115)
+
+                        return
+                     endif
+                  end do
+
+                  call abort
+               endif
+
+            else
+
+               do ig=1, ngrid
+                  do l=1,nlayer-1 ! to stop the rad tran bug
+
+                     aerosol(ig,l,iaer) =                                    & !modification by BC
+                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
+                          ( rho_ice * reffrad(ig,l,iaer) )  ) *   &
+                          !  pq(ig,l,i_h2oice) *                   & !JL I dropped the +1e-9 here to have the same
+                          !( pplev(ig,l) - pplev(ig,l+1) ) / g       !   opacity in the clearsky=true and the 
+                                                                     !   clear=false/pq=0 case
+                          ( pq(ig,l,i_h2oice) + 1.E-9 ) *         & ! Doing this makes the code unstable, so I have restored it (RW)
+                          ( pplev(ig,l) - pplev(ig,l+1) ) / g 
+
+                  enddo
+               enddo
+
+               if(CLFvarying)then
+                  call totalcloudfrac(ngrid,nq,cloudfrac,totcloudfrac,pplev,pq,aerosol(1:ngrid,1:nlayermx,iaer))
+                  do ig=1, ngrid
+                     do l=1,nlayer-1 ! to stop the rad tran bug
+                        CLFtot  = max(totcloudfrac(ig),0.01)
+                        aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/CLFtot
+                        aerosol(ig,l,iaer) = max(aerosol(ig,l,iaer),1.e-9)
+                     enddo
+                  enddo
+               else
+                  do ig=1, ngrid
+                     do l=1,nlayer-1 ! to stop the rad tran bug
+                        CLFtot  = CLFfixval
+                        aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/CLFtot
+                        aerosol(ig,l,iaer) = max(aerosol(ig,l,iaer),1.e-9)
+                     enddo
+                  enddo
+              end if!(CLFvarying)
+            endif !(aerofixed.or.(i_h2oice.eq.0).or.clearsky)
+	      
+      end if ! End if h2o aerosol
+
+!==================================================================
+!             Dust 
+!==================================================================
+      if (iaero_dust.ne.0) then
+          iaer=iaero_dust
+!         1. Initialization 
+          aerosol(1:ngrid,1:nlayermx,iaer)=0.0
+          
+          topdust=30.0 ! km  (used to be 10.0 km) LK
+
+!       2. Opacity calculation
+
+!           expfactor=0.
+           DO l=1,nlayer-1
+             DO ig=1,ngrid
+!             Typical mixing ratio profile
+
+                 zp=(preff/pplay(ig,l))**(70./topdust)
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+
+!             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) &
+               *expfactor
+
+
+             ENDDO
+           ENDDO
+
+!          Rescaling each layer to reproduce the choosen (or assimilated)
+!          dust extinction opacity at visible reference wavelength, which
+!          is scaled to the "preff" reference surface pressure available in comvert.h
+!          and stored in startfi.nc
+
+            taudusttmp(1:ngrid)=0.
+              DO l=1,nlayer
+                DO ig=1,ngrid
+                   taudusttmp(ig) = taudusttmp(ig) &
+                          +  aerosol(ig,l,iaer)
+                ENDDO
+              ENDDO
+            DO l=1,nlayer-1
+               DO ig=1,ngrid
+                  aerosol(ig,l,iaer) = max(1E-20, &
+                          dusttau &
+                       *  pplev(ig,1) / preff &
+                       *  aerosol(ig,l,iaer) &
+                       /  taudusttmp(ig))
+
+              ENDDO
+            ENDDO
+      end if ! If dust aerosol   
+
+!==================================================================
+!           H2SO4 
+!==================================================================
+! added by LK
+      if (iaero_h2so4.ne.0) then
+         iaer=iaero_h2so4
+
+!       1. Initialization
+         aerosol(1:ngrid,1:nlayermx,iaer)=0.0
+
+
+!       2. Opacity calculation
+
+!           expfactor=0.
+         DO l=1,nlayer-1
+            DO ig=1,ngrid
+!              Typical mixing ratio profile
+
+               zp=(preff/pplay(ig,l))**(70./30) !emulating topdust
+               expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+
+!             Vertical scaling function
+               aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1))*expfactor
+
+            ENDDO
+         ENDDO
+         tauh2so4tmp(1:ngrid)=0.
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               tauh2so4tmp(ig) = tauh2so4tmp(ig) + aerosol(ig,l,iaer)
+            ENDDO
+         ENDDO
+         DO l=1,nlayer-1
+            DO ig=1,ngrid
+               aerosol(ig,l,iaer) = max(1E-20, &
+                          1 &
+                       *  pplev(ig,1) / preff &
+                       *  aerosol(ig,l,iaer) &
+                       /  tauh2so4tmp(ig))
+
+            ENDDO
+         ENDDO
+
+! 1/700. is assuming a "sulfurtau" of 1
+! Sulfur aerosol routine to be improved.
+!                     aerosol0 =                         &
+!                          (  0.75 * QREFvis3d(ig,l,iaer) /        &
+!                          ( rho_h2so4 * reffrad(ig,l,iaer) )  ) *   &
+!                          ( pq(ig,l,i_h2so4) + 1.E-9 ) *         &
+!                          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!                     aerosol0           = max(aerosol0,1.e-9)
+!                     aerosol0           = min(aerosol0,L_TAUMAX)
+!                     aerosol(ig,l,iaer) = aerosol0
+
+!                  ENDDO
+!               ENDDO
+      end if
+ 
+           
+!     ---------------------------------------------------------
+!==================================================================
+!    Two-layer aerosols (unknown composition)
+!    S. Guerlet (2013)
+!==================================================================
+
+      if (iaero_back2lay .ne.0) then
+           iaer=iaero_back2lay
+!       1. Initialization
+            aerosol(1:ngrid,1:nlayermx,iaer)=0.0
+!       2. Opacity calculation
+          DO ig=1,ngrid
+           DO l=1,nlayer-1
+             aerosol(ig,l,iaer) = ( pplev(ig,l) - pplev(ig,l+1) )
+             !! 1. below tropospheric layer: no aerosols
+             IF (pplev(ig,l) .gt. pres_bottom_tropo) THEN
+               aerosol(ig,l,iaer) = 0.*aerosol(ig,l,iaer)
+             !! 2. tropo layer
+             ELSEIF (pplev(ig,l) .le. pres_bottom_tropo .and. pplev(ig,l) .ge. pres_top_tropo) THEN
+               aerosol(ig,l,iaer) = obs_tau_col_tropo*aerosol(ig,l,iaer)
+             !! 3. linear transition
+             ELSEIF (pplev(ig,l) .lt. pres_top_tropo .and. pplev(ig,l) .gt. pres_bottom_strato) THEN
+               expfactor=log(obs_tau_col_strato/obs_tau_col_tropo)/log(pres_bottom_strato/pres_top_tropo)
+               aerosol(ig,l,iaer)= obs_tau_col_tropo*((pplev(ig,l)/pres_top_tropo)**expfactor)*aerosol(ig,l,iaer)/1.5
+             !! 4. strato layer
+             ELSEIF (pplev(ig,l) .le. pres_bottom_strato .and. pplev(ig,l) .gt. pres_top_strato) THEN
+               aerosol(ig,l,iaer)= obs_tau_col_strato*aerosol(ig,l,iaer)
+             !! 5. above strato layer: no aerosols
+             ELSEIF (pplev(ig,l) .lt. pres_top_strato) THEN
+               aerosol(ig,l,iaer) = 0.*aerosol(ig,l,iaer)
+             ENDIF
+	   ENDDO
+          ENDDO
+
+ !       3. Re-normalize to observed total column
+         tau_col(:)=0.0
+         DO l=1,nlayer
+          DO ig=1,ngrid
+               tau_col(ig) = tau_col(ig) &
+                     + aerosol(ig,l,iaer)/(obs_tau_col_tropo+obs_tau_col_strato)
+            ENDDO
+         ENDDO
+
+         DO ig=1,ngrid
+           DO l=1,nlayer-1
+                aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/tau_col(ig)
+           ENDDO
+         ENDDO
+
+
+      end if ! if Two-layer aerosols  
+
+
+! --------------------------------------------------------------------------
+! Column integrated visible optical depth in each point (used for diagnostic)
+
+      tau_col(:)=0.0
+      do iaer = 1, naerkind
+         do l=1,nlayer
+            do ig=1,ngrid
+               tau_col(ig) = tau_col(ig) + aerosol(ig,l,iaer)
+            end do
+         end do
+      end do
+
+      do ig=1,ngrid
+         do l=1,nlayer
+            do iaer = 1, naerkind
+               if(aerosol(ig,l,iaer).gt.1.e3)then
+                  print*,'WARNING: aerosol=',aerosol(ig,l,iaer)
+                  print*,'at ig=',ig,',  l=',l,', iaer=',iaer
+                  print*,'QREFvis3d=',QREFvis3d(ig,l,iaer)
+                  print*,'reffrad=',reffrad(ig,l,iaer)
+               endif
+            end do
+         end do
+      end do
+
+      do ig=1,ngrid
+         if(tau_col(ig).gt.1.e3)then
+            print*,'WARNING: tau_col=',tau_col(ig)
+            print*,'at ig=',ig
+            print*,'aerosol=',aerosol(ig,:,:)
+            print*,'QREFvis3d=',QREFvis3d(ig,:,:)
+            print*,'reffrad=',reffrad(ig,:,:)
+         endif
+      end do
+      return
+    end subroutine aeropacity
+      
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aeroptproperties.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aeroptproperties.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aeroptproperties.F90	(revision 222)
@@ -0,0 +1,744 @@
+      SUBROUTINE aeroptproperties(ngrid,nlayer,reffrad,nueffrad,   &
+                                  QVISsQREF3d,omegaVIS3d,gVIS3d,   &
+                                  QIRsQREF3d,omegaIR3d,gIR3d,      &
+                                  QREFvis3d,QREFir3d)!,		   &
+!                                  omegaREFvis3d,omegaREFir3d)
+
+      use radinc_h,    only: L_NSPECTI,L_NSPECTV,nsizemax,naerkind
+      use radcommon_h, only: QVISsQREF,omegavis,gvis,QIRsQREF,omegair,gir
+      use radcommon_h, only: qrefvis,qrefir,omegarefvis,omegarefir
+      use radcommon_h, only: radiustab,nsize
+
+      implicit none
+
+!     =============================================================
+!     Aerosol Optical Properties
+!
+!     Description:
+!       Compute the scattering parameters in each grid
+!       box, depending on aerosol grain sizes. Log-normal size
+!       distribution and Gauss-Legendre integration are used.
+
+!     Parameters:
+!       Don't forget to set the value of varyingnueff below; If
+!       the effective variance of the distribution for the given
+!       aerosol is considered homogeneous in the atmosphere, please
+!       set varyingnueff(iaer) to .false. Resulting computational
+!       time will be much better.
+
+!     Authors: J.-B. Madeleine, F. Forget, F. Montmessin
+!     Slightly modified and converted to F90 by R. Wordsworth (2009)
+!     Varying nueff section removed by R. Wordsworth for simplicity
+!     ==============================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+
+!     Local variables 
+!     ---------------
+
+
+
+!     =============================================================
+      LOGICAL, PARAMETER :: varyingnueff(naerkind) = .false.
+!     =============================================================
+
+!     Min. and max radius of the interpolation grid (in METERS)
+      REAL, PARAMETER :: refftabmin = 2e-8 !2e-8
+!      REAL, PARAMETER :: refftabmax = 35e-6
+      REAL, PARAMETER :: refftabmax = 1e-3
+!     Log of the min and max variance of the interpolation grid
+      REAL, PARAMETER :: nuefftabmin = -4.6
+      REAL, PARAMETER :: nuefftabmax = 0.
+!     Number of effective radius of the interpolation grid
+      INTEGER, PARAMETER :: refftabsize = 200
+!     Number of effective variances of the interpolation grid
+!      INTEGER, PARAMETER :: nuefftabsize = 100
+      INTEGER, PARAMETER :: nuefftabsize = 1
+!     Interpolation grid indices (reff,nueff)
+      INTEGER :: grid_i,grid_j
+!     Intermediate variable
+      REAL :: var_tmp,var3d_tmp(ngrid,nlayermx)
+!     Bilinear interpolation factors
+      REAL :: kx,ky,k1,k2,k3,k4
+!     Size distribution parameters
+      REAL :: sizedistk1,sizedistk2
+!     Pi!
+      REAL,SAVE :: pi
+!     Variables used by the Gauss-Legendre integration:
+      INTEGER radius_id,gausind
+      REAL kint
+      REAL drad
+      INTEGER, PARAMETER :: ngau = 10
+      REAL weightgaus(ngau),radgaus(ngau)
+      SAVE weightgaus,radgaus
+!      DATA weightgaus/.2955242247,.2692667193,.2190863625,.1494513491,.0666713443/
+!      DATA radgaus/.1488743389,.4333953941,.6794095682,.8650633666,.9739065285/
+      DATA    radgaus/0.07652652113350,0.22778585114165, &
+                      0.37370608871528,0.51086700195146, &
+                      0.63605368072468,0.74633190646476, &
+                      0.83911697181213,0.91223442826796, &
+                      0.96397192726078,0.99312859919241/
+
+      DATA weightgaus/0.15275338723120,0.14917298659407, &
+                      0.14209610937519,0.13168863843930, &
+                      0.11819453196154,0.10193011980823, &
+                      0.08327674160932,0.06267204829828, &
+                      0.04060142982019,0.01761400714091/
+!     Indices
+      INTEGER :: i,j,k,l,m,iaer,idomain
+      INTEGER :: ig,lg,chg
+
+!     Local saved variables
+!     ---------------------
+
+!     Radius axis of the interpolation grid
+      REAL,SAVE :: refftab(refftabsize)
+!     Variance axis of the interpolation grid
+      REAL,SAVE :: nuefftab(nuefftabsize)
+!     Volume ratio of the grid
+      REAL,SAVE :: logvratgrid,vratgrid
+!     Grid used to remember which calculation is done
+      LOGICAL,SAVE :: checkgrid(refftabsize,nuefftabsize,naerkind,2) = .false.
+!     Optical properties of the grid (VISIBLE)
+      REAL,SAVE :: qsqrefVISgrid(refftabsize,nuefftabsize,L_NSPECTV,naerkind)
+      REAL,SAVE :: qextVISgrid(refftabsize,nuefftabsize,L_NSPECTV,naerkind)
+      REAL,SAVE :: qscatVISgrid(refftabsize,nuefftabsize,L_NSPECTV,naerkind)
+      REAL,SAVE :: omegVISgrid(refftabsize,nuefftabsize,L_NSPECTV,naerkind)
+      REAL,SAVE :: gVISgrid(refftabsize,nuefftabsize,L_NSPECTV,naerkind)
+!     Optical properties of the grid (INFRARED)
+      REAL,SAVE :: qsqrefIRgrid(refftabsize,nuefftabsize,L_NSPECTI,naerkind)
+      REAL,SAVE :: qextIRgrid(refftabsize,nuefftabsize,L_NSPECTI,naerkind)
+      REAL,SAVE :: qscatIRgrid(refftabsize,nuefftabsize,L_NSPECTI,naerkind)
+      REAL,SAVE :: omegIRgrid(refftabsize,nuefftabsize,L_NSPECTI,naerkind)
+      REAL,SAVE :: gIRgrid(refftabsize,nuefftabsize,L_NSPECTI,naerkind)
+!     Optical properties of the grid (REFERENCE WAVELENGTHS)
+      REAL,SAVE :: qrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qscatrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qrefIRgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: qscatrefIRgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: omegrefVISgrid(refftabsize,nuefftabsize,naerkind)
+      REAL,SAVE :: omegrefIRgrid(refftabsize,nuefftabsize,naerkind)
+!     Firstcall
+      LOGICAL,SAVE :: firstcall = .true.
+!     Variables used by the Gauss-Legendre integration:
+      REAL,SAVE :: normd(refftabsize,nuefftabsize,naerkind,2)
+      REAL,SAVE :: dista(refftabsize,nuefftabsize,naerkind,2,ngau)
+      REAL,SAVE :: distb(refftabsize,nuefftabsize,naerkind,2,ngau)
+
+      REAL,SAVE :: radGAUSa(ngau,naerkind,2)
+      REAL,SAVE :: radGAUSb(ngau,naerkind,2)
+
+      REAL,SAVE :: qsqrefVISa(L_NSPECTV,ngau,naerkind)
+      REAL,SAVE :: qrefVISa(ngau,naerkind)
+      REAL,SAVE :: qsqrefVISb(L_NSPECTV,ngau,naerkind)
+      REAL,SAVE :: qrefVISb(ngau,naerkind)
+      REAL,SAVE :: omegVISa(L_NSPECTV,ngau,naerkind)
+      REAL,SAVE :: omegrefVISa(ngau,naerkind)
+      REAL,SAVE :: omegVISb(L_NSPECTV,ngau,naerkind)
+      REAL,SAVE :: omegrefVISb(ngau,naerkind)
+      REAL,SAVE :: gVISa(L_NSPECTV,ngau,naerkind)
+      REAL,SAVE :: gVISb(L_NSPECTV,ngau,naerkind)
+
+      REAL,SAVE :: qsqrefIRa(L_NSPECTI,ngau,naerkind)
+      REAL,SAVE :: qrefIRa(ngau,naerkind)
+      REAL,SAVE :: qsqrefIRb(L_NSPECTI,ngau,naerkind)
+      REAL,SAVE :: qrefIRb(ngau,naerkind)
+      REAL,SAVE :: omegIRa(L_NSPECTI,ngau,naerkind)
+      REAL,SAVE :: omegrefIRa(ngau,naerkind)
+      REAL,SAVE :: omegIRb(L_NSPECTI,ngau,naerkind)
+      REAL,SAVE :: omegrefIRb(ngau,naerkind)
+      REAL,SAVE :: gIRa(L_NSPECTI,ngau,naerkind)
+      REAL,SAVE :: gIRb(L_NSPECTI,ngau,naerkind)
+
+      REAL :: radiusm
+      REAL :: radiusr
+
+!     Inputs
+!     ------
+
+      INTEGER :: ngrid,nlayer
+!     Aerosol effective radius used for radiative transfer (meter)
+      REAL :: reffrad(ngrid,nlayermx,naerkind)
+!     Aerosol effective variance used for radiative transfer (n.u.)
+      REAL :: nueffrad(ngrid,nlayermx,naerkind)
+
+!     Outputs
+!     -------
+
+      REAL :: QVISsQREF3d(ngrid,nlayermx,L_NSPECTV,naerkind)
+      REAL :: omegaVIS3d(ngrid,nlayermx,L_NSPECTV,naerkind)
+      REAL :: gVIS3d(ngrid,nlayermx,L_NSPECTV,naerkind)
+
+      REAL :: QIRsQREF3d(ngrid,nlayermx,L_NSPECTI,naerkind)
+      REAL :: omegaIR3d(ngrid,nlayermx,L_NSPECTI,naerkind)
+      REAL :: gIR3d(ngrid,nlayermx,L_NSPECTI,naerkind)
+
+      REAL :: QREFvis3d(ngrid,nlayermx,naerkind)
+      REAL :: QREFir3d(ngrid,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngrid,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngrid,nlayermx,naerkind)
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+        IF ( (nsize(iaer,1).EQ.1).AND.(nsize(iaer,2).EQ.1) ) THEN
+!==================================================================
+!       If there is one single particle size, optical
+!         properties of the considered aerosol are homogeneous
+          DO lg = 1, nlayer
+            DO ig = 1, ngrid
+              DO chg = 1, L_NSPECTV
+                QVISsQREF3d(ig,lg,chg,iaer)=QVISsQREF(chg,iaer,1)
+                omegaVIS3d(ig,lg,chg,iaer)=omegaVIS(chg,iaer,1)
+                gVIS3d(ig,lg,chg,iaer)=gVIS(chg,iaer,1)
+              ENDDO
+              DO chg = 1, L_NSPECTI
+                QIRsQREF3d(ig,lg,chg,iaer)=QIRsQREF(chg,iaer,1)
+                omegaIR3d(ig,lg,chg,iaer)=omegaIR(chg,iaer,1)
+                gIR3d(ig,lg,chg,iaer)=gIR(chg,iaer,1)
+              ENDDO
+              QREFvis3d(ig,lg,iaer)=QREFvis(iaer,1)
+              QREFir3d(ig,lg,iaer)=QREFir(iaer,1)
+              omegaREFvis3d(ig,lg,iaer)=omegaREFvis(iaer,1)
+              omegaREFir3d(ig,lg,iaer)=omegaREFir(iaer,1)
+            ENDDO
+          ENDDO
+
+
+          if (firstcall) then
+             print*,'Optical prop. of the aerosol are homogenous for:'
+             print*,'iaer = ',iaer
+          endif
+
+        ELSE ! Varying effective radius and variance
+      DO idomain = 1, 2 ! Loop on visible or infrared channel
+!==================================================================
+!     1. Creating the effective radius and variance grid
+!     --------------------------------------------------
+      IF (firstcall) THEN
+
+!       1.1 Pi!
+        pi = 2. * asin(1.e0)
+
+!       1.2 Effective radius
+        refftab(1)    = refftabmin
+        refftab(refftabsize) = refftabmax
+
+        logvratgrid = log(refftabmax/refftabmin) / float(refftabsize-1)*3.
+        vratgrid = exp(logvratgrid)
+
+        do i = 2, refftabsize-1
+          refftab(i) = refftab(i-1)*vratgrid**(1./3.)
+        enddo
+
+!       1.3 Effective variance
+        if(nuefftabsize.eq.1)then ! addded by RDW
+           print*,'Warning: no variance range in aeroptproperties'
+           nuefftab(1)=0.2
+        else
+           do i = 0, nuefftabsize-1
+              nuefftab(i+1) = exp( nuefftabmin + i*(nuefftabmax-nuefftabmin)/(nuefftabsize-1) )
+           enddo
+        endif
+
+        firstcall = .false.
+      ENDIF
+
+!       1.4 Radius middle point and range for Gauss integration
+        radiusm=0.5*(radiustab(iaer,idomain,nsize(iaer,idomain)) + radiustab(iaer,idomain,1))
+        radiusr=0.5*(radiustab(iaer,idomain,nsize(iaer,idomain)) - radiustab(iaer,idomain,1))
+
+!       1.5 Interpolating data at the Gauss quadrature points:
+        DO gausind=1,ngau
+          drad=radiusr*radgaus(gausind)
+          radGAUSa(gausind,iaer,idomain)=radiusm-drad
+
+          radius_id=minloc(abs(radiustab(iaer,idomain,:) - (radiusm-drad)),DIM=1)
+          IF ((radiustab(iaer,idomain,radius_id) - (radiusm-drad)).GT.0) THEN
+            radius_id=radius_id-1
+          ENDIF
+          IF (radius_id.GE.nsize(iaer,idomain)) THEN
+            radius_id=nsize(iaer,idomain)-1
+            kint = 1.
+          ELSEIF (radius_id.LT.1) THEN
+            radius_id=1
+            kint = 0.
+          ELSE
+          kint = ( (radiusm-drad) -				&
+                   radiustab(iaer,idomain,radius_id) ) /	&
+                 ( radiustab(iaer,idomain,radius_id+1) -	&
+                   radiustab(iaer,idomain,radius_id) )
+          ENDIF
+          IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------------
+            DO m=1,L_NSPECTV
+               qsqrefVISa(m,gausind,iaer)=                      &
+                    (1-kint)*QVISsQREF(m,iaer,radius_id) +      &
+                    kint*QVISsQREF(m,iaer,radius_id+1)
+            omegVISa(m,gausind,iaer)=                           &
+                    (1-kint)*omegaVIS(m,iaer,radius_id) +       &
+                    kint*omegaVIS(m,iaer,radius_id+1)
+            gVISa(m,gausind,iaer)=                              &
+                    (1-kint)*gVIS(m,iaer,radius_id) +           &
+                    kint*gVIS(m,iaer,radius_id+1)
+            ENDDO
+            qrefVISa(gausind,iaer)=                             &
+                    (1-kint)*QREFvis(iaer,radius_id) +          &
+                    kint*QREFvis(iaer,radius_id+1)
+            omegrefVISa(gausind,iaer)=                          &
+                    (1-kint)*omegaREFvis(iaer,radius_id) +      &
+                    kint*omegaREFvis(iaer,radius_id+1)
+          ELSE ! INFRARED DOMAIN ----------------------------------
+            DO m=1,L_NSPECTI
+            qsqrefIRa(m,gausind,iaer)=                          &
+                    (1-kint)*QIRsQREF(m,iaer,radius_id) +       &
+                    kint*QIRsQREF(m,iaer,radius_id+1)
+            omegIRa(m,gausind,iaer)=                            &
+                    (1-kint)*omegaIR(m,iaer,radius_id) +        &
+                    kint*omegaIR(m,iaer,radius_id+1)
+            gIRa(m,gausind,iaer)=                               &
+                    (1-kint)*gIR(m,iaer,radius_id) +            &
+                    kint*gIR(m,iaer,radius_id+1)
+            ENDDO
+            qrefIRa(gausind,iaer)=                              &
+                    (1-kint)*QREFir(iaer,radius_id) +           &
+                    kint*QREFir(iaer,radius_id+1)
+            omegrefIRa(gausind,iaer)=                           &
+                    (1-kint)*omegaREFir(iaer,radius_id) +       &
+                    kint*omegaREFir(iaer,radius_id+1)
+          ENDIF
+        ENDDO
+
+        DO gausind=1,ngau
+          drad=radiusr*radgaus(gausind)
+          radGAUSb(gausind,iaer,idomain)=radiusm+drad
+
+          radius_id=minloc(abs(radiustab(iaer,idomain,:) -      &
+                               (radiusm+drad)),DIM=1)
+          IF ((radiustab(iaer,idomain,radius_id) -              &
+               (radiusm+drad)).GT.0) THEN
+            radius_id=radius_id-1
+          ENDIF
+          IF (radius_id.GE.nsize(iaer,idomain)) THEN
+            radius_id=nsize(iaer,idomain)-1
+            kint = 1.
+          ELSEIF (radius_id.LT.1) THEN
+            radius_id=1
+            kint = 0.
+          ELSE
+            kint = ( (radiusm+drad) -                           &
+                     radiustab(iaer,idomain,radius_id) ) /      &
+                   ( radiustab(iaer,idomain,radius_id+1) -      &
+                     radiustab(iaer,idomain,radius_id) )
+          ENDIF
+          IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------------
+            DO m=1,L_NSPECTV
+            qsqrefVISb(m,gausind,iaer)=                         &
+                    (1-kint)*QVISsQREF(m,iaer,radius_id) +      &
+                    kint*QVISsQREF(m,iaer,radius_id+1)    
+            omegVISb(m,gausind,iaer)=                           &
+                    (1-kint)*omegaVIS(m,iaer,radius_id) +       &
+                    kint*omegaVIS(m,iaer,radius_id+1)
+            gVISb(m,gausind,iaer)=                              &
+                    (1-kint)*gVIS(m,iaer,radius_id) +           &
+                    kint*gVIS(m,iaer,radius_id+1)
+            ENDDO
+            qrefVISb(gausind,iaer)=                             &
+                    (1-kint)*QREFvis(iaer,radius_id) +          &
+                    kint*QREFvis(iaer,radius_id+1)
+            omegrefVISb(gausind,iaer)=                          &
+                    (1-kint)*omegaREFvis(iaer,radius_id) +      &
+                    kint*omegaREFvis(iaer,radius_id+1)
+          ELSE ! INFRARED DOMAIN ----------------------------------
+            DO m=1,L_NSPECTI
+            qsqrefIRb(m,gausind,iaer)=                          &
+                    (1-kint)*QIRsQREF(m,iaer,radius_id) +       &
+                    kint*QIRsQREF(m,iaer,radius_id+1)
+            omegIRb(m,gausind,iaer)=                            &
+                    (1-kint)*omegaIR(m,iaer,radius_id) +        &
+                    kint*omegaIR(m,iaer,radius_id+1)
+            gIRb(m,gausind,iaer)=                               &
+                    (1-kint)*gIR(m,iaer,radius_id) +            &
+                    kint*gIR(m,iaer,radius_id+1)
+            ENDDO
+            qrefIRb(gausind,iaer)=                              &
+                    (1-kint)*QREFir(iaer,radius_id) +           &
+                    kint*QREFir(iaer,radius_id+1)
+            omegrefIRb(gausind,iaer)=                           &
+                    (1-kint)*omegaREFir(iaer,radius_id) +       &
+                    kint*omegaREFir(iaer,radius_id+1)
+          ENDIF
+        ENDDO
+
+!==================================================================
+! CONSTANT NUEFF FROM HERE
+!==================================================================
+
+!     2. Compute the scattering parameters using linear
+!       interpolation over grain sizes and constant nueff
+!     ---------------------------------------------------
+
+      DO lg = 1,nlayer
+        DO ig = 1, ngrid
+!         2.1 Effective radius index and kx calculation
+          var_tmp=reffrad(ig,lg,iaer)/refftabmin
+          var_tmp=log(var_tmp)*3.
+          var_tmp=var_tmp/logvratgrid+1.
+          grid_i=floor(var_tmp)
+          IF (grid_i.GE.refftabsize) THEN
+!           WRITE(*,*) 'Warning: particle size in grid box #'
+!           WRITE(*,*) ig,' is too large to be used by the '
+!           WRITE(*,*) 'radiative transfer; please extend the '
+!           WRITE(*,*) 'interpolation grid to larger grain sizes.'
+            grid_i=refftabsize-1
+            kx = 1.
+          ELSEIF (grid_i.LT.1) THEN
+!           WRITE(*,*) 'Warning: particle size in grid box #'
+!           WRITE(*,*) ig,' is too small to be used by the '
+!           WRITE(*,*) 'radiative transfer; please extend the '
+!           WRITE(*,*) 'interpolation grid to smaller grain sizes.'
+            grid_i=1
+            kx = 0.
+          ELSE
+            kx = ( reffrad(ig,lg,iaer)-refftab(grid_i) ) /            &
+                 ( refftab(grid_i+1)-refftab(grid_i) )
+          ENDIF
+!         2.3 Integration
+          DO j=grid_i,grid_i+1
+!             2.3.1 Check if the calculation has been done
+              IF (.NOT.checkgrid(j,1,iaer,idomain)) THEN
+!               2.3.2 Log-normal dist., r_g and sigma_g are defined
+!                 in [hansen_1974], "Light scattering in planetary
+!                 atmospheres", Space Science Reviews 16 527-610.
+!                 Here, sizedistk1=r_g and sizedistk2=sigma_g^2
+                sizedistk2 = log(1.+nueffrad(1,1,iaer))
+                sizedistk1 = exp(2.5*sizedistk2)
+                sizedistk1 = refftab(j) / sizedistk1
+
+                normd(j,1,iaer,idomain) = 1e-30
+                DO gausind=1,ngau
+                  drad=radiusr*radgaus(gausind)
+                  dista(j,1,iaer,idomain,gausind) = LOG((radiusm-drad)/sizedistk1)
+                  dista(j,1,iaer,idomain,gausind) =                   &
+                    EXP(-dista(j,1,iaer,idomain,gausind) *            &
+                    dista(j,1,iaer,idomain,gausind) *                 &
+                    0.5e0/sizedistk2)/(radiusm-drad)                  
+                  dista(j,1,iaer,idomain,gausind) =                   &
+                    dista(j,1,iaer,idomain,gausind) /                 &
+                    (sqrt(2e0*pi*sizedistk2))
+
+                  distb(j,1,iaer,idomain,gausind) = LOG((radiusm+drad)/sizedistk1)
+                  distb(j,1,iaer,idomain,gausind) =                   &
+                    EXP(-distb(j,1,iaer,idomain,gausind) *            &
+                    distb(j,1,iaer,idomain,gausind) *                 &
+                    0.5e0/sizedistk2)/(radiusm+drad)
+                  distb(j,1,iaer,idomain,gausind) =                   &
+                    distb(j,1,iaer,idomain,gausind) /                 &
+                    (sqrt(2e0*pi*sizedistk2))
+
+                  normd(j,1,iaer,idomain)=normd(j,1,iaer,idomain) +   &
+                    weightgaus(gausind) *                             &
+                    (                                                 &
+                    distb(j,1,iaer,idomain,gausind) * pi *            &
+                    radGAUSb(gausind,iaer,idomain) *                  &
+                    radGAUSb(gausind,iaer,idomain) +                  &
+                    dista(j,1,iaer,idomain,gausind) * pi *            &
+                    radGAUSa(gausind,iaer,idomain) *                  &
+                    radGAUSa(gausind,iaer,idomain)                    &
+                    )
+                ENDDO
+                IF (idomain.EQ.1) THEN ! VISIBLE DOMAIN -----------
+!                 2.3.3.vis Initialization
+                  qsqrefVISgrid(j,1,:,iaer)=0.
+                  qextVISgrid(j,1,:,iaer)=0.
+                  qscatVISgrid(j,1,:,iaer)=0.
+                  omegVISgrid(j,1,:,iaer)=0.
+                  gVISgrid(j,1,:,iaer)=0.
+                  qrefVISgrid(j,1,iaer)=0.
+                  qscatrefVISgrid(j,1,iaer)=0.
+                  omegrefVISgrid(j,1,iaer)=0.
+
+                  DO gausind=1,ngau
+                    DO m=1,L_NSPECTV
+!                     Convolution:
+                      qextVISgrid(j,1,m,iaer) =              &
+                        qextVISgrid(j,1,m,iaer) +            & 
+                        weightgaus(gausind) *                &
+                        (                                    &
+                        qsqrefVISb(m,gausind,iaer) *         &
+                        qrefVISb(gausind,iaer) *             &
+                        pi*radGAUSb(gausind,iaer,idomain) *  &
+                        radGAUSb(gausind,iaer,idomain) *     &
+                        distb(j,1,iaer,idomain,gausind) +    &
+                        qsqrefVISa(m,gausind,iaer) *         &
+                        qrefVISa(gausind,iaer) *             &
+                        pi*radGAUSa(gausind,iaer,idomain) *  &
+                        radGAUSa(gausind,iaer,idomain) *     &
+                        dista(j,1,iaer,idomain,gausind)      &
+                        )
+                      qscatVISgrid(j,1,m,iaer) =             &
+                        qscatVISgrid(j,1,m,iaer) +           &
+                        weightgaus(gausind) *                &
+                        (                                    &
+                        omegVISb(m,gausind,iaer) *           &
+                        qsqrefVISb(m,gausind,iaer) *         &
+                        qrefVISb(gausind,iaer) *             &
+                        pi*radGAUSb(gausind,iaer,idomain) *  &
+                        radGAUSb(gausind,iaer,idomain) *     &
+                        distb(j,1,iaer,idomain,gausind) +    &
+                        omegVISa(m,gausind,iaer) *           &
+                        qsqrefVISa(m,gausind,iaer) *         &
+                        qrefVISa(gausind,iaer) *             &
+                        pi*radGAUSa(gausind,iaer,idomain) *  &
+                        radGAUSa(gausind,iaer,idomain) *     &
+                        dista(j,1,iaer,idomain,gausind)      &
+                        )
+                      gVISgrid(j,1,m,iaer) =                 &
+                        gVISgrid(j,1,m,iaer) +               &
+                        weightgaus(gausind) *                &
+                        (                                    &
+                        omegVISb(m,gausind,iaer) *           &
+                        qsqrefVISb(m,gausind,iaer) *         &
+                        qrefVISb(gausind,iaer) *             &
+                        gVISb(m,gausind,iaer) *              &
+                        pi*radGAUSb(gausind,iaer,idomain) *  &
+                        radGAUSb(gausind,iaer,idomain) *     &
+                        distb(j,1,iaer,idomain,gausind) +    &
+                        omegVISa(m,gausind,iaer) *           &
+                        qsqrefVISa(m,gausind,iaer) *         &
+                        qrefVISa(gausind,iaer) *             &
+                        gVISa(m,gausind,iaer) *              &
+                        pi*radGAUSa(gausind,iaer,idomain) *  &
+                        radGAUSa(gausind,iaer,idomain) *     &
+                        dista(j,1,iaer,idomain,gausind)      &
+                        )
+                    ENDDO
+                    qrefVISgrid(j,1,iaer) =                  &
+                      qrefVISgrid(j,1,iaer) +                &
+                      weightgaus(gausind) *                  &
+                      (                                      &
+                      qrefVISb(gausind,iaer) *               &
+                      pi*radGAUSb(gausind,iaer,idomain) *    &
+                      radGAUSb(gausind,iaer,idomain) *       &
+                      distb(j,1,iaer,idomain,gausind) +      &
+                      qrefVISa(gausind,iaer) *               &
+                      pi*radGAUSa(gausind,iaer,idomain) *    &
+                      radGAUSa(gausind,iaer,idomain) *       &
+                      dista(j,1,iaer,idomain,gausind)        &
+                      )
+                    qscatrefVISgrid(j,1,iaer) =              &
+                      qscatrefVISgrid(j,1,iaer) +            &
+                      weightgaus(gausind) *                  &
+                      (                                      &
+                      omegrefVISb(gausind,iaer) *            &
+                      qrefVISb(gausind,iaer) *               & 
+                      pi*radGAUSb(gausind,iaer,idomain) *    &
+                      radGAUSb(gausind,iaer,idomain) *       &
+                      distb(j,1,iaer,idomain,gausind) +      &
+                      omegrefVISa(gausind,iaer) *            &
+                      qrefVISa(gausind,iaer) *               &
+                      pi*radGAUSa(gausind,iaer,idomain) *    &
+                      radGAUSa(gausind,iaer,idomain) *       &
+                      dista(j,1,iaer,idomain,gausind)        &
+                      )
+                  ENDDO
+
+                  qrefVISgrid(j,1,iaer)=qrefVISgrid(j,1,iaer) /          &
+                                normd(j,1,iaer,idomain)       
+                  qscatrefVISgrid(j,1,iaer)=qscatrefVISgrid(j,1,iaer) /  &
+                                normd(j,1,iaer,idomain)
+                  omegrefVISgrid(j,1,iaer)=qscatrefVISgrid(j,1,iaer) /   &
+                               qrefVISgrid(j,1,iaer)
+                  DO m=1,L_NSPECTV
+                    qextVISgrid(j,1,m,iaer)=qextVISgrid(j,1,m,iaer) /    &
+                                normd(j,1,iaer,idomain)
+                    qscatVISgrid(j,1,m,iaer)=qscatVISgrid(j,1,m,iaer) /  &
+                                normd(j,1,iaer,idomain)
+                    gVISgrid(j,1,m,iaer)=gVISgrid(j,1,m,iaer) /          &
+                                qscatVISgrid(j,1,m,iaer) /               &
+                                normd(j,1,iaer,idomain)
+
+                    qsqrefVISgrid(j,1,m,iaer)=qextVISgrid(j,1,m,iaer) /  &
+                                qrefVISgrid(j,1,iaer)
+                    omegVISgrid(j,1,m,iaer)=qscatVISgrid(j,1,m,iaer) /   &
+                                qextVISgrid(j,1,m,iaer)
+                  ENDDO
+                ELSE                   ! INFRARED DOMAIN ----------
+!                 2.3.3.ir Initialization
+                  qsqrefIRgrid(j,1,:,iaer)=0.
+                  qextIRgrid(j,1,:,iaer)=0.
+                  qscatIRgrid(j,1,:,iaer)=0.
+                  omegIRgrid(j,1,:,iaer)=0.
+                  gIRgrid(j,1,:,iaer)=0.
+                  qrefIRgrid(j,1,iaer)=0.
+                  qscatrefIRgrid(j,1,iaer)=0.
+                  omegrefIRgrid(j,1,iaer)=0.
+
+                  DO gausind=1,ngau
+                    DO m=1,L_NSPECTI
+!                     Convolution:
+                      qextIRgrid(j,1,m,iaer) =                  &
+                        qextIRgrid(j,1,m,iaer) +                &
+                        weightgaus(gausind) *                   &
+                        (                                       &
+                        qsqrefIRb(m,gausind,iaer) *             &
+                        qrefVISb(gausind,iaer) *                &
+                        pi*radGAUSb(gausind,iaer,idomain) *     &
+                        radGAUSb(gausind,iaer,idomain) *        &
+                        distb(j,1,iaer,idomain,gausind) +       &
+                        qsqrefIRa(m,gausind,iaer) *             &
+                        qrefVISa(gausind,iaer) *                &
+                        pi*radGAUSa(gausind,iaer,idomain) *     &
+                        radGAUSa(gausind,iaer,idomain) *        &
+                        dista(j,1,iaer,idomain,gausind)         &
+                        )
+                      qscatIRgrid(j,1,m,iaer) =                 &
+                        qscatIRgrid(j,1,m,iaer) +               &
+                        weightgaus(gausind) *                   &
+                        (                                       &
+                        omegIRb(m,gausind,iaer) *               &
+                        qsqrefIRb(m,gausind,iaer) *             &
+                        qrefVISb(gausind,iaer) *                &
+                        pi*radGAUSb(gausind,iaer,idomain) *     &
+                        radGAUSb(gausind,iaer,idomain) *        &
+                        distb(j,1,iaer,idomain,gausind) +       &
+                        omegIRa(m,gausind,iaer) *               &
+                        qsqrefIRa(m,gausind,iaer) *             &
+                        qrefVISa(gausind,iaer) *                &
+                        pi*radGAUSa(gausind,iaer,idomain) *     &
+                        radGAUSa(gausind,iaer,idomain) *        &
+                        dista(j,1,iaer,idomain,gausind)         &
+                        )
+                      gIRgrid(j,1,m,iaer) =                     &
+                        gIRgrid(j,1,m,iaer) +                   &
+                        weightgaus(gausind) *                   &
+                        (                                       &
+                        omegIRb(m,gausind,iaer) *               &
+                        qsqrefIRb(m,gausind,iaer) *             &
+                        qrefVISb(gausind,iaer) *                &
+                        gIRb(m,gausind,iaer) *                  &
+                        pi*radGAUSb(gausind,iaer,idomain) *     &
+                        radGAUSb(gausind,iaer,idomain) *        &
+                        distb(j,1,iaer,idomain,gausind) +       &
+                        omegIRa(m,gausind,iaer) *               &
+                        qsqrefIRa(m,gausind,iaer) *             &
+                        qrefVISa(gausind,iaer) *                &
+                        gIRa(m,gausind,iaer) *                  &
+                        pi*radGAUSa(gausind,iaer,idomain) *     &
+                        radGAUSa(gausind,iaer,idomain) *        &
+                        dista(j,1,iaer,idomain,gausind)         &
+                        )
+                    ENDDO
+                    qrefIRgrid(j,1,iaer) =                      &
+                      qrefIRgrid(j,1,iaer) +                    &
+                      weightgaus(gausind) *                     &
+                      (                                         &
+                      qrefIRb(gausind,iaer) *                   &
+                      pi*radGAUSb(gausind,iaer,idomain) *       &
+                      radGAUSb(gausind,iaer,idomain) *          &
+                      distb(j,1,iaer,idomain,gausind) +         &
+                      qrefIRa(gausind,iaer) *                   &
+                      pi*radGAUSa(gausind,iaer,idomain) *       &
+                      radGAUSa(gausind,iaer,idomain) *          &
+                      dista(j,1,iaer,idomain,gausind)           &
+                      )
+                    qscatrefIRgrid(j,1,iaer) =                  &
+                      qscatrefIRgrid(j,1,iaer) +                &
+                      weightgaus(gausind) *                     &
+                      (                                         &
+                      omegrefIRb(gausind,iaer) *                &
+                      qrefIRb(gausind,iaer) *                   &
+                      pi*radGAUSb(gausind,iaer,idomain) *       &
+                      radGAUSb(gausind,iaer,idomain) *          &
+                      distb(j,1,iaer,idomain,gausind) +         &
+                      omegrefIRa(gausind,iaer) *                &
+                      qrefIRa(gausind,iaer) *                   &
+                      pi*radGAUSa(gausind,iaer,idomain) *       &
+                      radGAUSa(gausind,iaer,idomain) *          &
+                      dista(j,1,iaer,idomain,gausind)           &
+                      )
+                  ENDDO
+ 
+                  qrefIRgrid(j,1,iaer)=qrefIRgrid(j,1,iaer) /          &
+                                normd(j,1,iaer,idomain)
+                  qscatrefIRgrid(j,1,iaer)=qscatrefIRgrid(j,1,iaer) /  &
+                                normd(j,1,iaer,idomain)
+                  omegrefIRgrid(j,1,iaer)=qscatrefIRgrid(j,1,iaer) /   &
+                               qrefIRgrid(j,1,iaer)
+                  DO m=1,L_NSPECTI
+                    qextIRgrid(j,1,m,iaer)=qextIRgrid(j,1,m,iaer) /    &
+                                normd(j,1,iaer,idomain)
+                    qscatIRgrid(j,1,m,iaer)=qscatIRgrid(j,1,m,iaer) /  &
+                                normd(j,1,iaer,idomain)
+                    gIRgrid(j,1,m,iaer)=gIRgrid(j,1,m,iaer) /          &
+                                qscatIRgrid(j,1,m,iaer) /              &
+                                normd(j,1,iaer,idomain)
+
+                    qsqrefIRgrid(j,1,m,iaer)=qextIRgrid(j,1,m,iaer) /  &
+                                qrefVISgrid(j,1,iaer)
+                    omegIRgrid(j,1,m,iaer)=qscatIRgrid(j,1,m,iaer) /   &
+                                qextIRgrid(j,1,m,iaer)
+                  ENDDO
+                ENDIF                  ! --------------------------
+                checkgrid(j,1,iaer,idomain) = .true.
+              ENDIF !checkgrid
+          ENDDO !grid_i
+!         2.4 Linear interpolation
+          k1 = (1-kx)
+          k2 = kx
+          IF (idomain.EQ.1) THEN ! VISIBLE ------------------------
+          DO m=1,L_NSPECTV
+             QVISsQREF3d(ig,lg,m,iaer) =                           &
+                        k1*qsqrefVISgrid(grid_i,1,m,iaer) +        &
+                        k2*qsqrefVISgrid(grid_i+1,1,m,iaer)
+            omegaVIS3d(ig,lg,m,iaer) =                             &
+                        k1*omegVISgrid(grid_i,1,m,iaer) +          &
+                        k2*omegVISgrid(grid_i+1,1,m,iaer)
+            gVIS3d(ig,lg,m,iaer) =                                 &
+                        k1*gVISgrid(grid_i,1,m,iaer) +             &
+                        k2*gVISgrid(grid_i+1,1,m,iaer)
+          ENDDO !L_NSPECTV
+          QREFvis3d(ig,lg,iaer) =                                  &
+                        k1*qrefVISgrid(grid_i,1,iaer) +            &
+                        k2*qrefVISgrid(grid_i+1,1,iaer)
+          omegaREFvis3d(ig,lg,iaer) =                              &
+                        k1*omegrefVISgrid(grid_i,1,iaer) +         &
+                        k2*omegrefVISgrid(grid_i+1,1,iaer)
+          ELSE                   ! INFRARED -----------------------
+          DO m=1,L_NSPECTI
+            QIRsQREF3d(ig,lg,m,iaer) =                             &
+                        k1*qsqrefIRgrid(grid_i,1,m,iaer) +         &
+                        k2*qsqrefIRgrid(grid_i+1,1,m,iaer)
+            omegaIR3d(ig,lg,m,iaer) =                              &
+                        k1*omegIRgrid(grid_i,1,m,iaer) +           &
+                        k2*omegIRgrid(grid_i+1,1,m,iaer) 
+            gIR3d(ig,lg,m,iaer) =                                  & 
+                        k1*gIRgrid(grid_i,1,m,iaer) +              &
+                        k2*gIRgrid(grid_i+1,1,m,iaer)
+          ENDDO !L_NSPECTI
+          QREFir3d(ig,lg,iaer) =                                   &
+                        k1*qrefIRgrid(grid_i,1,iaer) +             &
+                        k2*qrefIRgrid(grid_i+1,1,iaer)
+          omegaREFir3d(ig,lg,iaer) =                               &
+                        k1*omegrefIRgrid(grid_i,1,iaer) +          &
+                        k2*omegrefIRgrid(grid_i+1,1,iaer)
+          ENDIF                  ! --------------------------------
+        ENDDO !nlayermx
+      ENDDO !ngrid
+
+!==================================================================
+
+
+
+      ENDDO ! idomain
+
+      ENDIF ! nsize = 1
+
+      ENDDO ! iaer (loop on aerosol kind)
+
+      RETURN
+    END SUBROUTINE aeroptproperties
+
+
+
+      
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerosol_mod.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerosol_mod.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/aerosol_mod.F90	(revision 222)
@@ -0,0 +1,21 @@
+!==================================================================
+module aerosol_mod
+implicit none
+save
+!==================================================================
+
+!  aerosol indexes: these are initialized to be 0 if the
+!                 corresponding aerosol was not activated in callphys.def
+!                 -- otherwise a value is given in iniaerosol
+      integer :: iaero_co2 = 0 
+      integer :: iaero_h2o = 0
+      integer :: iaero_dust = 0
+      integer :: iaero_h2so4 = 0
+      logical :: noaero = .false.
+
+! two-layer simple aerosol model
+      integer :: iaero_back2lay = 0
+      
+!==================================================================
+end module aerosol_mod
+!==================================================================
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ave_stelspec.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ave_stelspec.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ave_stelspec.F90	(revision 222)
@@ -0,0 +1,179 @@
+      subroutine ave_stelspec(STELLAR)
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Average the chosen high resolution stellar spectrum over the
+!     visible bands in the model.
+!     
+!     Authors
+!     ------- 
+!     Robin Wordsworth (2010).
+!     Generalized to very late spectral types (and Brown dwarfs) Jeremy Leconte (2012)
+!
+!     Called by
+!     ---------
+!     setspv.F
+!     
+!     Calls
+!     -----
+!     none
+!     
+!==================================================================
+
+      use radinc_h, only: L_NSPECTV
+      use radcommon_h, only: BWNV, DWNV, tstellar
+      use datafile_mod, only: datadir
+
+      implicit none
+
+#include "callkeys.h"
+
+      real*8 STELLAR(L_NSPECTV)
+!      integer startype 
+
+      integer Nfine
+      integer,parameter :: Nfineband=200
+      integer ifine
+
+      real,allocatable :: lam(:),stel_f(:)
+      real band,lamm,lamp
+      real dl
+
+      character(len=100)  :: file_id,file_id_lam
+      character(len=200) :: file_path,file_path_lam
+
+      real lam_temp
+      double precision stel_temp
+      
+      integer :: ios ! file opening/reading status
+
+      STELLAR(:)=0.0
+
+      print*,'enter ave_stellspec'
+      if(stelbbody)then
+         tstellar=stelTbb
+	 Nfine=L_NSPECTV*Nfineband
+	 do band=1,L_NSPECTV
+	    lamm=10000.0/BWNV(band+1)
+	    lamp=10000.0/BWNV(band)
+	    dl=(lamp-lamm)/(Nfineband)
+	    do ifine=1,Nfineband
+	       lam_temp=lamm+(lamp-lamm)*(ifine-1.)/(Nfineband)
+               call blackl(dble(lam_temp*1e-6),dble(tstellar),stel_temp)
+	       STELLAR(band)=STELLAR(band)+stel_temp*dl
+	    enddo	    
+	 end do
+         STELLAR(1:L_NSPECTV)=STELLAR(1:L_NSPECTV)/sum(STELLAR(1:L_NSPECTV))
+      else
+         ! load high resolution stellar data
+         Select Case(startype)
+	   Case(1)
+            file_id='/stellar_spectra/sol.txt'
+            tstellar=5800.
+            file_id_lam='/stellar_spectra/lam.txt'
+            Nfine=5000
+	   Case(2)
+            file_id='/stellar_spectra/gl581.txt'
+            tstellar=3200.
+            file_id_lam='/stellar_spectra/lam.txt'
+            Nfine=5000
+	   Case(3)
+            file_id='/stellar_spectra/adleo.txt'
+            tstellar=3200.
+            file_id_lam='/stellar_spectra/lam.txt'
+            Nfine=5000
+	   Case(4)
+            file_id='/stellar_spectra/gj644.txt'
+            print*,'Find out tstellar before using this star!'
+            call abort
+            file_id_lam='/stellar_spectra/lam.txt'
+            Nfine=5000
+	   Case(5)
+            file_id='/stellar_spectra/hd128167.txt'
+            tstellar=6700. ! Segura et al. (2003)
+            file_id_lam='/stellar_spectra/lam.txt'
+            Nfine=5000
+	   Case(6)
+            file_id='/stellar_spectra/BD_Teff-1600K.txt'
+            tstellar=1600. 
+            file_id_lam='/stellar_spectra/lamBD.txt'
+            Nfine=5000
+	   Case(7)
+            file_id='/stellar_spectra/BD_Teff-1000K.txt'
+            tstellar=1000. 
+            file_id_lam='/stellar_spectra/lamBD.txt'
+            Nfine=5000
+	   Case(8)
+            file_id='/stellar_spectra/Flux_K5_Teff4700_logg4.5_Met-0.5_BTsettle.dat'
+            tstellar=4700. 
+            file_id_lam='/stellar_spectra/lambda_K5_Teff4700_logg4.5_Met-0.5_BTsettle.dat'
+            Nfine=3986
+	   Case Default
+            print*,'Error: unknown star type chosen'
+            call abort
+         End Select
+
+	 allocate(lam(Nfine),stel_f(Nfine))
+
+         file_path_lam=TRIM(datadir)//TRIM(file_id_lam)
+         open(110,file=file_path_lam,form='formatted',status='old',iostat=ios)
+         if (ios.ne.0) then        ! file not found
+           write(*,*) 'Error from ave_stelspec'
+           write(*,*) 'Data file ',trim(file_id_lam),' not found.'
+           write(*,*)'Check that your path to datagcm:',trim(datadir)
+           write(*,*)' is correct. You can change it in callphys.def with:'
+           write(*,*)' datadir = /absolute/path/to/datagcm'
+           write(*,*)' Also check that there is a ',trim(file_id_lam),' there.'
+           call abort
+         else
+           do ifine=1,Nfine
+             read(110,*) lam(ifine)
+           enddo
+           close(110)
+         endif
+
+
+         ! load high resolution wavenumber data
+         file_path=TRIM(datadir)//TRIM(file_id)
+         open(111,file=file_path,form='formatted',status='old',iostat=ios)
+         if (ios.ne.0) then        ! file not found
+           write(*,*) 'Error from ave_stelspec'
+           write(*,*) 'Data file ',trim(file_id),' not found.'
+           write(*,*)'Check that your path to datagcm:',trim(datadir)
+           write(*,*)' is correct. You can change it in callphys.def with:'
+           write(*,*)' datadir = /absolute/path/to/datagcm'
+           write(*,*)' Also check that there is a ',trim(file_id),' there.'
+           call abort
+         else
+           do ifine=1,Nfine
+             read(111,*) stel_f(ifine)
+           enddo
+           close(111)
+         endif
+	 
+         ! sum data by band
+         band=1
+	 Do while(lam(1).lt. real(10000.0/BWNV(band+1)))
+	    if (band.gt.L_NSPECTV-1) exit
+            band=band+1
+	 enddo
+	 dl=lam(2)-lam(1)
+         STELLAR(band)=STELLAR(band)+stel_f(1)*dl
+         do ifine = 2,Nfine
+            if(lam(ifine) .gt. real(10000.0/BWNV(band)))then
+               band=band-1
+            endif
+            if(band .lt. 1) exit
+	    dl=lam(ifine)-lam(ifine-1)
+            STELLAR(band)=STELLAR(band)+stel_f(ifine)*dl
+         end do
+	       
+	 
+         STELLAR(1:L_NSPECTV)=STELLAR(1:L_NSPECTV)/sum(STELLAR(1:L_NSPECTV))
+         deallocate(lam,stel_f)
+         
+      endif
+
+      end subroutine ave_stelspec
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bands.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bands.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bands.h	(revision 222)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'bands.h'
+!
+!   bands.h contains the visible & infrared bands in the model
+!
+!   NBinfrared = L_NSPECTI in the model
+!   NBvisible  = L_NSPECTV in the model
+!-----------------------------------------------------------------------
+
+      INTEGER, parameter :: NBinfrared=20
+      INTEGER, parameter :: NBvisible=30
+
+
+!-----------------------------------------------------------------------
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bilinear.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bilinear.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bilinear.F90	(revision 222)
@@ -0,0 +1,18 @@
+!-------------------------------------------------------------------------
+subroutine bilinear(f,f11,f21,f12,f22,x,x1,x2,y,y1,y2)  
+! Used for interpolation of continuum data
+
+  implicit none
+
+  real*8 x,y,x1,x2,y1,y2
+  real*8 f,f11,f12,f21,f22,fA,fB
+
+  ! 1st in x-direction
+  fA=f11*(x2-x)/(x2-x1)+f21*(x-x1)/(x2-x1)
+  fB=f12*(x2-x)/(x2-x1)+f22*(x-x1)/(x2-x1)
+
+  ! then in y-direction
+  f=fA*(y2-y)/(y2-y1)+fB*(y-y1)/(y2-y1)
+
+  return
+end subroutine bilinear
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bilinearbig.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bilinearbig.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/bilinearbig.F90	(revision 222)
@@ -0,0 +1,84 @@
+      subroutine bilinearbig(nX,nY,x_arr,y_arr,f2d_arr,x_in,y_in,f,ind)
+
+!     Necessary for interpolation of continuum data
+!     optimized by A. Spiga 01/2013 
+
+      implicit none
+
+      integer nX,nY,i,j,ind,b
+
+      real*8 x_in,y_in,x1,x2,y1,y2
+      real*8 f,f11,f12,f21,f22,fA,fB
+      real*8 x_arr(nX)
+      real*8 y_arr(nY)
+      real*8 f2d_arr(nX,nY)
+      real*8,save :: x,y
+
+      integer strlen
+      character*100 label
+      label='subroutine bilinear'
+
+
+      x=x_in
+      y=y_in
+
+   !! AS: important to optimize here because the array is quite large
+   !! ... and actually calculations only need to be done once
+   !! IF ind=-9999 we have not calculated yet
+   if ( ind == -9999) then
+      !1st check we're within the wavenumber range
+      if ((x.lt.x_arr(2)).or.(x.gt.x_arr(nX-2))) then
+         ind=-1
+      else
+        i=1
+        x2=x_arr(i)
+        do while ( x2 .le. x )
+          x1=x2
+          i=i+1
+          x2=x_arr(i)
+          ind=i-1
+        end do
+      endif
+   endif
+
+   !! Either we already saw we are out of wavenumber range
+   !! ... and we just have to set f=0 and exit
+   if ( ind == -1) then 
+      f=0.0D+0
+      return
+   !! Or we already determined ind -- so we just proceed
+   else
+      x1=x_arr(ind)
+      x2=x_arr(ind+1)
+   endif
+
+!     ... and for y within the temperature range
+      if ((y.lt.y_arr(1)).or.(y.gt.y_arr(nY))) then
+         write(*,*) 'Warning from bilinearH2H2:'
+         write(*,*) 'Outside continuum temperature range!'
+         if(y.lt.y_arr(1))then
+            y=y_arr(1)+0.01
+         endif
+         if(y.gt.y_arr(nY))then
+            y=y_arr(nY)-0.01
+         endif
+      else
+        j=1
+        y2=y_arr(j)
+        do while ( y2 .le. y )
+          y1=y2
+          j=j+1
+          y2=y_arr(j)
+          b=j-1
+        end do
+      endif
+      
+      f11=f2d_arr(ind,b)
+      f21=f2d_arr(ind+1,b)
+      f12=f2d_arr(ind,b+1)
+      f22=f2d_arr(ind+1,b+1)
+
+      call bilinear(f,f11,f21,f12,f22,x,x1,x2,y,y1,y2)
+
+      return
+    end subroutine bilinearbig
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/blackl.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/blackl.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/blackl.F	(revision 222)
@@ -0,0 +1,21 @@
+      subroutine blackl(blalong,blat,blae)
+
+      implicit double precision (a-h,o-z)
+
+      ! physical constants
+      sigma=5.67032D-8
+      pi=datan(1.d0)*4.d0
+      c0=2.9979d+08
+      h=6.6262d-34
+      cbol=1.3806d-23
+      rind=1.d0
+      c=c0/rind
+      c1=h*(c**2)
+      c2=h*c/cbol
+
+
+      blae=2.d0*pi*c1/blalong**5/(dexp(c2/blalong/blat)-1.d0)
+
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_cpp3d.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_cpp3d.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_cpp3d.F90	(revision 222)
@@ -0,0 +1,33 @@
+      subroutine calc_cpp3d(cppNI,rcpNI,t,p)
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the atmospheric specific heat capacity as a 
+!     function of pressure and temperature (for CO2 gas only)
+!
+!     Authors
+!     ------- 
+!     Robin Wordsworth (2009)
+!
+!==================================================================
+
+      implicit none
+
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "cpdet.h"
+
+      !real cp0, dB2dT2
+      real cppNI      ! specific heat capacity at const. pressure
+      real rcpNI      ! R / specific heat capacity
+      real t
+      real p
+
+      ! dummy function until I decide what to do!
+
+      cppNI  = cpp
+      rcpNI  = R/cppNI
+
+      return
+    end subroutine calc_cpp3d
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_cpp_mugaz.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_cpp_mugaz.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_cpp_mugaz.F90	(revision 222)
@@ -0,0 +1,117 @@
+      subroutine calc_cpp_mugaz
+
+!==================================================================
+!     Purpose
+!     -------
+!     Check to see if the atmospheric specific heat capacity and
+!     mean molar mass for the gas mixture defined in gases.def
+!     corresponds to what we're using. If it doesn't, abort run
+!     unless option 'check_cpp_match' is set to false in 
+!     callphys.def.
+!
+!     Authors
+!     ------- 
+!     Robin Wordsworth (2009)
+!     A. Spiga: make the routine OK with latest changes in rcm1d
+!
+!==================================================================
+
+      use gases_h
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+      real cpp_c   
+      real mugaz_c
+
+      integer igas
+
+      cpp_c   = 0.0
+      mugaz_c = 0.0
+
+      do igas=1,ngasmx
+
+         if(igas.eq.vgas)then
+            ! ignore variable gas in cpp calculation
+         else
+            ! all values at 300 K from Engineering Toolbox
+            if(igas.eq.igas_CO2)then
+               !cpp_c   = cpp_c   + 0.744*gfrac(igas) ! @ ~210 K (better for Mars conditions) 
+               cpp_c   = cpp_c   + 0.846*gfrac(igas)
+               mugaz_c = mugaz_c + 44.01*gfrac(igas)
+            elseif(igas.eq.igas_N2)then
+               cpp_c   = cpp_c   + 1.040*gfrac(igas)
+               mugaz_c = mugaz_c + 28.01*gfrac(igas)
+            elseif(igas.eq.igas_H2)then
+               cpp_c   = cpp_c   + 14.31*gfrac(igas)
+               mugaz_c = mugaz_c + 2.01*gfrac(igas)
+            elseif(igas.eq.igas_He)then
+               cpp_c   = cpp_c   + 5.19*gfrac(igas)
+               mugaz_c = mugaz_c + 4.003*gfrac(igas)
+            elseif(igas.eq.igas_H2O)then
+               cpp_c   = cpp_c   + 1.864*gfrac(igas)
+               mugaz_c = mugaz_c + 18.02*gfrac(igas)
+            elseif(igas.eq.igas_SO2)then
+               cpp_c   = cpp_c   + 0.64*gfrac(igas)
+               mugaz_c = mugaz_c + 64.066*gfrac(igas)
+            elseif(igas.eq.igas_H2S)then
+               cpp_c   = cpp_c   + 1.003*gfrac(igas) ! from wikipedia...
+               mugaz_c = mugaz_c + 34.08*gfrac(igas)
+            elseif(igas.eq.igas_CH4)then
+               cpp_c   = cpp_c   + 2.226*gfrac(igas)
+               mugaz_c = mugaz_c + 16.04*gfrac(igas)
+            elseif(igas.eq.igas_NH3)then
+               cpp_c   = cpp_c   + 2.175*gfrac(igas)
+               mugaz_c = mugaz_c + 17.03*gfrac(igas)
+               print*,'WARNING, cpp for NH3 may be for liquid'
+            elseif(igas.eq.igas_C2H6)then 
+               ! C2H6 http://encyclopedia.airliquide.com/Encyclopedia.asp?GasID=28
+               cpp_c   = cpp_c   + 1.763*gfrac(igas)
+               mugaz_c = mugaz_c + 30.07*gfrac(igas)
+            elseif(igas.eq.igas_C2H2)then
+               ! C2H2 http://encyclopedia.airliquide.com/Encyclopedia.asp?GasID=1
+               cpp_c   = cpp_c   + 1.575*gfrac(igas)
+               mugaz_c = mugaz_c + 26.04*gfrac(igas)
+            else
+               print*,'Error in calc_cpp_mugaz: Gas species not recognised!'
+               call abort
+            endif
+         endif
+
+      enddo
+
+      cpp_c = 1000.0*cpp_c
+
+      print*,'Cp in calc_cpp_mugaz is ',cpp_c,'J kg^-1 K^-1'
+      print*,'Mg in calc_cpp_mugaz is ',mugaz_c,'amu'
+      print*,'Predefined Cp in physics is ',cpp,'J kg^-1 K^-1'
+      print*,'Predefined Mg in physics is ',mugaz,'amu'
+
+      if (check_cpp_match) then
+         print*,'REQUEST TO CHECK cpp_match :'
+         if((abs(1.-cpp/cpp_c).gt.1.e-6) .or.  &
+              (abs(1.-mugaz/mugaz_c).gt.1.e-6)) then
+            ! Ehouarn: tolerate a small mismatch between computed/stored values
+            print*,'--> Values do not match!'
+            print*,'    Either adjust cpp / mugaz via newstart to calculated values,'
+            print*,'    or set check_cpp_match to .false. in callphys.def.'
+            stop
+         else
+            print*,'--> OK. Settings match composition.'
+         endif
+      endif
+
+      if (.not.force_cpp) then
+          print*,'*** Setting cpp & mugaz to computations in calc_cpp_mugaz.'
+          mugaz = mugaz_c
+          cpp = cpp_c
+      else
+          print*,'*** Setting cpp & mugaz to predefined values.'
+      endif
+
+
+      return
+    end subroutine calc_cpp_mugaz
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_rayleigh.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_rayleigh.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calc_rayleigh.F90	(revision 222)
@@ -0,0 +1,167 @@
+      subroutine calc_rayleigh
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Average the Rayleigh scattering in each band, weighting the 
+!     average by the blackbody function at temperature tstellar.
+!     Works for an arbitrary mix of gases (currently CO2, N2 and 
+!     H2 are possible).
+!     
+!     Authors
+!     ------- 
+!     Robin Wordsworth (2010)
+!     Jeremy Leconte (2012): Added option for variable gas. Improved water rayleigh (Bucholtz 1995).
+!
+!     Called by
+!     ---------
+!     setspv.F
+!     
+!     Calls
+!     -----
+!     none
+!     
+!==================================================================
+
+      use radinc_h, only: L_NSPECTV
+      use radcommon_h, only: WAVEV, BWNV, DWNV, tstellar, tauray, taurayvar, scalep
+      use gases_h
+
+      implicit none
+
+#include "comcstfi.h"
+#include "callkeys.h"
+
+      real*8 wl
+      integer N,Nfine,ifine,igas
+      parameter(Nfine=500.0)
+      real*8 :: P0 = 9.423D+6   ! Rayleigh scattering reference pressure in pascals.    
+
+      logical typeknown
+      real*8 tauvar,tauvarvar,tausum,tausumvar,tauwei,tauweivar,bwidth,bstart
+      double precision df
+
+      real*8 tauconsti(ngasmx)
+      real*8 tauvari(ngasmx)
+
+      integer icantbewrong
+
+      ! tau0/p0=tau/p (Hansen 1974)
+      ! Then calculate tau0 = (8*pi^3*p_1atm)/(3*N0^2) * 4*delta^2/(g*mugaz*lambda^4)
+      ! where delta=n-1 and N0 is an amagat
+
+      typeknown=.false.
+      do igas=1,ngasmx
+         if(igas.eq.vgas)then
+            print*,'variable gas is ',trim(gnom(igas)),' in Rayleigh scattering '
+	 endif
+	 if((igas/=vgas).and.(gfrac(igas).lt.5.e-2))then
+            print*,'Ignoring ',trim(gnom(igas)),' in Rayleigh scattering '// &
+            'as its mixing ratio is less than 0.05.' 
+            ! ignore variable gas in Rayleigh calculation
+            ! ignore gases of mixing ratio < 0.05 in Rayleigh calculation
+            tauconsti(igas) = 0.0
+         else
+            if(igas.eq.igas_CO2) then
+               tauconsti(igas) = (8.7/g)*1.527*scalep/P0
+            elseif(igas.eq.igas_N2)then
+               tauconsti(igas) = (9.81/g)*8.569E-3*scalep/(P0/93.0)
+            elseif(igas.eq.igas_H2O)then
+!               tauconsti(igas) = (10.0/g)*9.22E-3*scalep/101325.0 
+               tauconsti(igas) = 1.98017E-10/(g*mugaz*100.) 
+            elseif(igas.eq.igas_H2)then
+               tauconsti(igas) = (10.0/g)*0.0241*scalep/101325.0
+               !tauconsti(igas) = (10.0/g)*0.0487*scalep/(101325.0)
+               ! uses n=1.000132 from Optics, Fourth Edition.
+               ! was out by a factor 2!
+            elseif(igas.eq.igas_He)then
+               tauconsti(igas) = (10.0/g)*0.00086*scalep/101325.0
+            else
+               print*,'Error in calc_rayleigh: Gas species not recognised!'
+               call abort
+            endif
+
+            if((gfrac(igas).eq.1.0).and.(vgas.eq.0))then
+               print*,'Rayleigh scattering is for a pure ',trim(gnom(igas)),' atmosphere.'
+               typeknown=.true.
+            endif
+
+         endif
+      enddo
+
+      if(.not.typeknown)then
+         print*,'Rayleigh scattering is for a mixed gas atmosphere.'
+         typeknown=.true.
+      endif
+
+ 
+      do N=1,L_NSPECTV
+         
+         tausum = 0.0
+         tauwei = 0.0
+         tausumvar = 0.0
+         tauweivar = 0.0
+         bstart = 10000.0/BWNV(N+1)
+         bwidth = (10000.0/BWNV(N)) - (10000.0/BWNV(N+1))
+         do ifine=1,Nfine
+            wl=bstart+dble(ifine)*bwidth/Nfine
+
+            tauvar=0.0
+            tauvarvar=0.0
+            do igas=1,ngasmx
+               if((igas/=vgas).and.(gfrac(igas).lt.5.e-2))then
+                  ! ignore variable gas in Rayleigh calculation
+                  ! ignore gases of mixing ratio < 0.05 in Rayleigh calculation
+                  tauvari(igas)   = 0.0
+               else
+                  if(igas.eq.igas_CO2)then
+                     tauvari(igas) = (1.0+0.013/wl**2)/wl**4
+                  elseif(igas.eq.igas_N2)then
+                     tauvari(igas) = (1.0+0.0113/wl**2+0.00013/wl**4)/wl**4
+                  elseif(igas.eq.igas_H2O)then
+!                     tauvari(igas) = 1.0/wl**4 ! to be improved...
+                     tauvari(igas) = (5.7918E6/(2.38E2-1/wl**2)+1.679E5/(57.36E0-1/wl**2))**2/wl**4 
+                  elseif(igas.eq.igas_H2)then
+                     tauvari(igas) = 1.0/wl**4 
+                  elseif(igas.eq.igas_He)then
+                     tauvari(igas) = 1.0/wl**4 
+                  else
+                     print*,'Error in calc_rayleigh: Gas species not recognised!'
+                     call abort
+                  endif
+               endif
+
+               if(igas.eq.vgas) then
+                  tauvarvar=tauvarvar+tauconsti(igas)*tauvari(igas)
+                  tauvar=tauvar+0.0*0.0*gfrac(igas)
+               else
+                  tauvar=tauvar+tauconsti(igas)*tauvari(igas)*gfrac(igas)
+               endif
+
+            enddo
+
+            call blackl(dble(wl*1e-6),dble(tstellar),df)
+            df=df*bwidth/Nfine
+            tauwei=tauwei+df
+            tausum=tausum+tauvar*df
+            tauweivar=tauweivar+df
+            tausumvar=tausumvar+tauvarvar*df
+         
+         enddo
+         TAURAY(N)=tausum/tauwei
+         TAURAYVAR(N)=tausumvar/tauweivar
+         ! we multiply by scalep here (100) because plev, which is used in optcv,
+         ! is in units of mBar, so we need to convert.
+
+      end do
+
+      IF (L_NSPECTV > 6) THEN
+        icantbewrong = L_NSPECTV-6
+        print*,'At 1 atm and lambda = ',WAVEV(icantbewrong),' um'
+        print*,'tau_R = ',TAURAY(icantbewrong)*1013.25
+        print*,'sig_R = ',TAURAY(icantbewrong)*g*mugaz*1.67e-27*100, &
+               'cm^2 molecule^-1'
+      ENDIF
+
+    end subroutine calc_rayleigh
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calcenergy_kcm.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calcenergy_kcm.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/calcenergy_kcm.F90	(revision 222)
@@ -0,0 +1,79 @@
+subroutine calcenergy_kcm(Tsurf,T,Play,Plev,Qsurf,Q,muvar,Eatmtot)
+
+
+use params_h, only : Rc
+use watercommon_h, only : mH2O
+implicit none
+
+!     ----------------------------------------------------------------
+!     Purpose: Calculate total energy of the (steam) atmosphere
+!     Authour: R. Wordsworth (2011)
+!     ----------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+!#include "callkeys.h"
+
+
+
+  ! inputs
+  real Tsurf,T(1:nlayermx)
+  real Play(1:nlayermx),Plev(1:nlayermx+1)
+  real Qsurf,Q(1:nlayermx)
+  real muvar(1,nlayermx+1)
+
+  ! internal
+  integer il
+  real m_n,m_v,cp_n,cp_v,cp_a,Eatmlay
+  real s_c,rho_v,L
+  double precision p_v, s_v, nul
+  real VMR(1:nlayermx)
+
+  ! output
+  real Eatmtot
+
+  ! functions
+  double precision cp_neutral
+
+  m_n = mugaz/1000.
+  m_v = mH2O/1000.
+
+
+  do il=1,nlayermx
+     VMR(il)=Q(il)*(muvar(1,il+1)/mH2O)
+  end do
+
+
+  Eatmtot = 0.0
+  do il=1,nlayermx
+
+
+     cp_n = cp_neutral(dble(T(il)))
+     cp_v = (32.24+1.923d-3*T(il) + 1.055d-5*T(il)**2-3.511d-9*T(il)**3)/m_v
+     ! / by m_v makes it per kg not per mol
+
+     call psat_H2O(dble(T(il)),p_v)
+     p_v   = p_v*1d6
+     rho_v = real(p_v)*m_v/(real(Rc)*T(il))
+
+     call therm(dble(T(il)),dble(rho_v)*1d-3,nul,nul,nul,nul,nul,nul,nul,&
+                nul,nul,nul,s_v,nul)
+
+     s_c = 2.06 * log(T(il)/273.15)
+     s_v = s_v * 1d3
+     s_c = s_c * 1d3
+     L   = (real(s_v)-s_c)*T(il)
+
+     cp_a    = (1-VMR(il))*cp_n + VMR(il)*cp_v 
+     !cp_a    = (1-Q(il))*cp_n + Q(il)*cp_v 
+
+     Eatmlay = ( cp_a*T(il) + L*VMR(il) ) * (Plev(il)-Plev(il+1))/g
+
+     Eatmtot = Eatmtot + Eatmlay 
+  enddo
+
+  print*,'WARNING: E-calc currently assumes H2O saturation!'
+
+end subroutine calcenergy_kcm
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callcorrk.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callcorrk.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callcorrk.F90	(revision 222)
@@ -0,0 +1,877 @@
+      subroutine callcorrk(ngrid,nlayer,pq,nq,qsurf,           &
+          albedo,emis,mu0,pplev,pplay,pt,                      & 
+          tsurf,fract,dist_star,aerosol,muvar,                 &
+          dtlw,dtsw,fluxsurf_lw,                               &
+          fluxsurf_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,        &
+          OLR_nu,OSR_nu,                                       &
+          tau_col,cloudfrac,totcloudfrac,                      &
+          clearsky,firstcall,lastcall)
+
+      use radinc_h
+      use radcommon_h
+      use watercommon_h
+      use datafile_mod, only: datadir
+      use ioipsl_getincom 
+      use gases_h
+      use radii_mod, only : su_aer_radii,co2_reffrad,h2o_reffrad,dust_reffrad,h2so4_reffrad,back2lay_reffrad
+      use aerosol_mod, only : iaero_co2,iaero_h2o,iaero_dust,iaero_h2so4, iaero_back2lay
+      USE tracer_h
+
+      implicit none
+
+!==================================================================
+!
+!     Purpose
+!     -------
+!     Solve the radiative transfer using the correlated-k method for
+!     the gaseous absorption and the Toon et al. (1989) method for
+!     scatttering due to aerosols.
+!
+!     Authors
+!     ------- 
+!     Emmanuel 01/2001, Forget 09/2001
+!     Robin Wordsworth (2009)
+!
+!==================================================================
+
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+!-----------------------------------------------------------------------
+!     Declaration of the arguments (INPUT - OUTPUT) on the LMD GCM grid
+!     Layer #1 is the layer near the ground. 
+!     Layer #nlayermx is the layer at the top.
+
+      INTEGER,INTENT(IN) :: ngrid ! number of atmospheric columns
+      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
+      REAL,INTENT(IN) :: pq(ngrid,nlayer,nq) ! tracers (.../kg_of_air)
+      integer,intent(in) :: nq ! number of tracers
+      REAL,INTENT(IN) :: qsurf(ngrid,nq) ! tracer on surface (kg.m-2)
+      REAL,INTENT(IN) :: albedo(ngrid)   ! SW albedo
+      REAL,INTENT(IN) :: emis(ngrid)     ! LW emissivity
+      real,intent(in) :: mu0(ngrid) ! cosine of sun incident angle
+      REAL,INTENT(IN) :: pplev(ngrid,nlayermx+1)  ! inter-layer pressure (Pa)
+      REAL,INTENT(IN) :: pplay(ngrid,nlayermx)    ! mid-layer pressure (Pa)
+      REAL,INTENT(IN) :: pt(ngrid,nlayermx)  ! air temperature (K)
+      REAL,INTENT(IN) :: tsurf(ngrid)        ! surface temperature (K)
+      REAL,INTENT(IN) :: fract(ngrid)        ! fraction of day
+      REAL,INTENT(IN) :: dist_star           ! distance star-planet (AU)
+      REAL,INTENT(OUT) :: aerosol(ngrid,nlayermx,naerkind) ! aerosol tau (kg/kg)
+      real,intent(in) :: muvar(ngrid,nlayermx+1)
+      REAL,INTENT(OUT) :: dtlw(ngrid,nlayermx) ! heating rate (K/s) due to LW
+      REAL,INTENT(OUT) :: dtsw(ngrid,nlayermx) ! heating rate (K/s) due to SW
+      REAL,INTENT(OUT) :: fluxsurf_lw(ngrid)   ! incident LW flux to surf (W/m2)
+      REAL,INTENT(OUT) :: fluxsurf_sw(ngrid)   ! incident SW flux to surf (W/m2)
+      REAL,INTENT(OUT) :: fluxtop_lw(ngrid)    ! outgoing LW flux to space (W/m2)
+      REAL,INTENT(OUT) :: fluxabs_sw(ngrid)    ! SW flux absorbed by planet (W/m2)
+      REAL,INTENT(OUT) :: fluxtop_dn(ngrid)    ! incident top of atmosphere SW flux (W/m2)
+      REAL,INTENT(OUT) :: OLR_nu(ngrid,L_NSPECTI)! Outgoing LW radition in each band (Normalized to the band width (W/m2/cm-1)
+      REAL,INTENT(OUT) :: OSR_nu(ngrid,L_NSPECTV)! Outgoing SW radition in each band (Normalized to the band width (W/m2/cm-1)
+      REAL,INTENT(OUT) :: tau_col(ngrid) ! diagnostic from aeropacity
+!     for H2O cloud fraction in aeropacity
+      real,intent(in) :: cloudfrac(ngrid,nlayermx)
+      real,intent(out) :: totcloudfrac(ngrid)
+      logical,intent(in) :: clearsky
+      logical,intent(in) :: firstcall ! signals first call to physics
+      logical,intent(in) :: lastcall ! signals last call to physics
+
+!     Globally varying aerosol optical properties on GCM grid
+!     Not needed everywhere so not in radcommon_h
+      REAL :: QVISsQREF3d(ngrid,nlayermx,L_NSPECTV,naerkind)
+      REAL :: omegaVIS3d(ngrid,nlayermx,L_NSPECTV,naerkind)
+      REAL :: gVIS3d(ngrid,nlayermx,L_NSPECTV,naerkind)
+
+      REAL :: QIRsQREF3d(ngrid,nlayermx,L_NSPECTI,naerkind)
+      REAL :: omegaIR3d(ngrid,nlayermx,L_NSPECTI,naerkind)
+      REAL :: gIR3d(ngrid,nlayermx,L_NSPECTI,naerkind)
+
+!      REAL :: omegaREFvis3d(ngrid,nlayermx,naerkind)
+!      REAL :: omegaREFir3d(ngrid,nlayermx,naerkind) ! not sure of the point of these...
+
+      REAL,ALLOCATABLE,SAVE :: reffrad(:,:,:) ! aerosol effective radius (m)
+      REAL,ALLOCATABLE,SAVE :: nueffrad(:,:,:) ! aerosol effective variance
+
+!-----------------------------------------------------------------------
+!     Declaration of the variables required by correlated-k subroutines
+!     Numbered from top to bottom unlike in the GCM!
+
+      REAL*8 tmid(L_LEVELS),pmid(L_LEVELS)
+      REAL*8 tlevrad(L_LEVELS),plevrad(L_LEVELS)
+
+!     Optical values for the optci/cv subroutines
+      REAL*8 stel(L_NSPECTV),stel_fract(L_NSPECTV)
+      REAL*8 dtaui(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+      REAL*8 dtauv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+      REAL*8 cosbv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+      REAL*8 cosbi(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+      REAL*8 wbari(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+      REAL*8 wbarv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+      REAL*8 tauv(L_NLEVRAD,L_NSPECTV,L_NGAUSS)
+      REAL*8 taucumv(L_LEVELS,L_NSPECTV,L_NGAUSS)
+      REAL*8 taucumi(L_LEVELS,L_NSPECTI,L_NGAUSS)
+
+      REAL*8 tauaero(L_LEVELS+1,naerkind)
+      REAL*8 nfluxtopv,nfluxtopi,nfluxtop,fluxtopvdn
+      real*8 nfluxoutv_nu(L_NSPECTV) ! outgoing band-resolved VI flux at TOA (W/m2)
+      real*8 nfluxtopi_nu(L_NSPECTI) ! net band-resolved IR flux at TOA (W/m2)
+      real*8 fluxupi_nu(L_NLAYRAD,L_NSPECTI) ! for 1D diagnostic
+      REAL*8 fmneti(L_NLAYRAD),fmnetv(L_NLAYRAD)
+      REAL*8 fluxupv(L_NLAYRAD),fluxupi(L_NLAYRAD)
+      REAL*8 fluxdnv(L_NLAYRAD),fluxdni(L_NLAYRAD)
+      REAL*8 albi,albv,acosz
+
+      INTEGER ig,l,k,nw,iaer,irad
+      INTEGER icount
+
+      real szangle
+      logical global1d
+      save szangle,global1d
+      real*8 taugsurf(L_NSPECTV,L_NGAUSS-1)
+      real*8 taugsurfi(L_NSPECTI,L_NGAUSS-1)
+
+      real*8 qvar(L_LEVELS)          ! mixing ratio of variable component (mol/mol)
+
+!     Local aerosol optical properties for each column on RADIATIVE grid
+      real*8,save ::  QXVAER(L_LEVELS+1,L_NSPECTV,naerkind)
+      real*8,save ::  QSVAER(L_LEVELS+1,L_NSPECTV,naerkind)
+      real*8,save ::  GVAER(L_LEVELS+1,L_NSPECTV,naerkind)
+      real*8,save ::  QXIAER(L_LEVELS+1,L_NSPECTI,naerkind)
+      real*8,save ::  QSIAER(L_LEVELS+1,L_NSPECTI,naerkind)
+      real*8,save ::  GIAER(L_LEVELS+1,L_NSPECTI,naerkind)
+
+      !REAL :: QREFvis3d(ngrid,nlayermx,naerkind)
+      !REAL :: QREFir3d(ngrid,nlayermx,naerkind)
+      !save QREFvis3d, QREFir3d 
+      real, dimension(:,:,:), save, allocatable :: QREFvis3d
+      real, dimension(:,:,:), save, allocatable :: QREFir3d
+
+
+!     Misc.
+      logical nantest
+      real*8  tempv(L_NSPECTV)
+      real*8  tempi(L_NSPECTI)
+      real*8  temp,temp1,temp2,pweight
+      character(len=10) :: tmp1
+      character(len=10) :: tmp2
+
+!     for fixed water vapour profiles
+      integer i_var
+      real RH
+      real*8 pq_temp(nlayer)
+      real ptemp, Ttemp, qsat
+
+!      real(KIND=r8) :: pq_temp(nlayer) ! better F90 way.. DOESNT PORT TO F77!!!
+
+      !real ptime, pday
+      logical OLRz
+      real*8 NFLUXGNDV_nu(L_NSPECTV)
+
+
+      ! for weird cloud test
+      real pqtest(ngrid,nlayer,nq)
+
+      real maxrad, minrad
+            
+      real,external :: CBRT
+
+!     included by RW for runaway greenhouse 1D study
+      real vtmp(nlayermx)
+      REAL*8 muvarrad(L_LEVELS)
+
+!===============================================================
+!     Initialization on first call
+
+      qxvaer(:,:,:)=0.0
+      qsvaer(:,:,:)=0.0
+      gvaer(:,:,:) =0.0
+
+      qxiaer(:,:,:)=0.0
+      qsiaer(:,:,:)=0.0
+      giaer(:,:,:) =0.0
+
+      if(firstcall) then
+
+         !!! ALLOCATED instances are necessary because of CLFvarying
+         !!! strategy to call callcorrk twice in physiq...
+         IF(.not.ALLOCATED(QREFvis3d)) ALLOCATE(QREFvis3d(ngrid,nlayermx,naerkind))
+         IF(.not.ALLOCATED(QREFir3d)) ALLOCATE(QREFir3d(ngrid,nlayermx,naerkind))
+         ! Effective radius and variance of the aerosols
+         IF(.not.ALLOCATED(reffrad)) allocate(reffrad(ngrid,nlayer,naerkind))
+         IF(.not.ALLOCATED(nueffrad)) allocate(nueffrad(ngrid,nlayer,naerkind))
+
+         call system('rm -f surf_vals_long.out')
+
+         if(naerkind.gt.4)then
+            print*,'Code not general enough to deal with naerkind > 4 yet.'
+            call abort
+         endif
+         call su_aer_radii(ngrid,reffrad,nueffrad)
+	 
+	 
+
+!--------------------------------------------------
+!     set up correlated k
+         print*, "callcorrk: Correlated-k data base folder:",trim(datadir)
+         call getin("corrkdir",corrkdir)
+         print*, "corrkdir = ",corrkdir
+         write( tmp1, '(i3)' ) L_NSPECTI
+         write( tmp2, '(i3)' ) L_NSPECTV
+         banddir=trim(adjustl(tmp1))//'x'//trim(adjustl(tmp2))
+         banddir=trim(adjustl(corrkdir))//'/'//trim(adjustl(banddir))
+
+         call setspi            ! basic infrared properties
+         call setspv            ! basic visible properties
+         call sugas_corrk       ! set up gaseous absorption properties
+         call suaer_corrk       ! set up aerosol optical properties
+
+
+         if((igcm_h2o_vap.eq.0) .and. varactive)then
+            print*,'varactive in callcorrk but no h2o_vap tracer.'
+            stop
+         endif
+
+         OLR_nu(:,:) = 0.
+         OSR_nu(:,:) = 0.
+
+         if (ngrid.eq.1) then
+           PRINT*, 'Simulate global averaged conditions ?'
+           global1d = .false. ! default value
+           call getin("global1d",global1d)
+           write(*,*) "global1d = ",global1d
+           ! Test of incompatibility:
+           ! if global1d is true, there should not be any diurnal cycle
+           if (global1d.and.diurnal) then
+            print*,'if global1d is true, diurnal must be set to false'
+            stop
+           endif
+
+           if (global1d) then
+             PRINT *,'Solar Zenith angle (deg.) ?'
+             PRINT *,'(assumed for averaged solar flux S/4)'
+             szangle=60.0  ! default value
+             call getin("szangle",szangle)
+             write(*,*) "szangle = ",szangle
+           endif
+         endif
+
+      end if ! of if (firstcall)
+
+!=======================================================================
+!     Initialization on every call    
+
+!--------------------------------------------------
+!     Effective radius and variance of the aerosols
+      do iaer=1,naerkind
+
+         if ((iaer.eq.iaero_co2).and.tracer.and.(igcm_co2_ice.gt.0)) then ! treat condensed co2 particles.
+	    call co2_reffrad(ngrid,nq,pq,reffrad(1,1,iaero_co2))
+            print*,'Max. CO2 ice particle size = ',maxval(reffrad(1:ngrid,1:nlayermx,iaer))/1.e-6,' um'
+            print*,'Min. CO2 ice particle size = ',minval(reffrad(1:ngrid,1:nlayermx,iaer))/1.e-6,' um'
+	 end if
+         if ((iaer.eq.iaero_h2o).and.water) then ! treat condensed water particles. to be generalized for other aerosols
+	    call h2o_reffrad(ngrid,pq(1,1,igcm_h2o_ice),pt, &
+                             reffrad(1,1,iaero_h2o),nueffrad(1,1,iaero_h2o))
+            print*,'Max. H2O cloud particle size = ',maxval(reffrad(1:ngrid,1:nlayermx,iaer))/1.e-6,' um'
+            print*,'Min. H2O cloud particle size = ',minval(reffrad(1:ngrid,1:nlayermx,iaer))/1.e-6,' um'
+         endif
+         if(iaer.eq.iaero_dust)then
+	    call dust_reffrad(ngrid,reffrad(1,1,iaero_dust))
+            print*,'Dust particle size = ',reffrad(1,1,iaer)/1.e-6,' um'
+         endif
+         if(iaer.eq.iaero_h2so4)then
+	    call h2so4_reffrad(ngrid,reffrad(1,1,iaero_h2so4))
+            print*,'H2SO4 particle size =',reffrad(1,1,iaer)/1.e-6,' um'
+         endif
+          if(iaer.eq.iaero_back2lay)then
+	    call back2lay_reffrad(ngrid,reffrad(1,1,iaero_back2lay),nlayer,pplev)
+         endif
+     end do !iaer=1,naerkind
+
+
+!     how much light we get
+      do nw=1,L_NSPECTV
+         stel(nw)=stellarf(nw)/(dist_star**2)
+      end do
+
+      call aeroptproperties(ngrid,nlayer,reffrad,nueffrad,         &
+           QVISsQREF3d,omegaVIS3d,gVIS3d,                          &
+           QIRsQREF3d,omegaIR3d,gIR3d,                             &
+           QREFvis3d,QREFir3d)                                     ! get 3D aerosol optical properties
+
+      call aeropacity(ngrid,nlayer,nq,pplay,pplev,pq,aerosol,      &
+           reffrad,QREFvis3d,QREFir3d,                             & 
+           tau_col,cloudfrac,totcloudfrac,clearsky)                ! get aerosol optical depths
+	  
+!-----------------------------------------------------------------------
+!     Starting Big Loop over every GCM column
+      do ig=1,ngrid
+
+!=======================================================================
+!     Transformation of the GCM variables
+
+!-----------------------------------------------------------------------
+!     Aerosol optical properties Qext, Qscat and g
+!     The transformation in the vertical is the same as for temperature
+           
+!     shortwave
+            do iaer=1,naerkind
+               DO nw=1,L_NSPECTV 
+                  do l=1,nlayermx
+
+                     temp1=QVISsQREF3d(ig,nlayermx+1-l,nw,iaer)         &
+                         *QREFvis3d(ig,nlayermx+1-l,iaer)
+
+                     temp2=QVISsQREF3d(ig,max(nlayermx-l,1),nw,iaer)    &
+                         *QREFvis3d(ig,max(nlayermx-l,1),iaer)
+
+                     qxvaer(2*l,nw,iaer)  = temp1
+                     qxvaer(2*l+1,nw,iaer)=(temp1+temp2)/2
+
+                     temp1=temp1*omegavis3d(ig,nlayermx+1-l,nw,iaer)
+                     temp2=temp2*omegavis3d(ig,max(nlayermx-l,1),nw,iaer)
+
+                     qsvaer(2*l,nw,iaer)  = temp1
+                     qsvaer(2*l+1,nw,iaer)=(temp1+temp2)/2
+
+                     temp1=gvis3d(ig,nlayermx+1-l,nw,iaer)
+                     temp2=gvis3d(ig,max(nlayermx-l,1),nw,iaer)
+
+                     gvaer(2*l,nw,iaer)  = temp1
+                     gvaer(2*l+1,nw,iaer)=(temp1+temp2)/2
+
+                  end do
+
+                  qxvaer(1,nw,iaer)=qxvaer(2,nw,iaer)
+                  qxvaer(2*nlayermx+1,nw,iaer)=0.
+
+                  qsvaer(1,nw,iaer)=qsvaer(2,nw,iaer)
+                  qsvaer(2*nlayermx+1,nw,iaer)=0.
+
+                  gvaer(1,nw,iaer)=gvaer(2,nw,iaer)
+                  gvaer(2*nlayermx+1,nw,iaer)=0.
+
+               end do
+
+!     longwave
+               DO nw=1,L_NSPECTI 
+                  do l=1,nlayermx
+
+                     temp1=QIRsQREF3d(ig,nlayermx+1-l,nw,iaer)         &
+                          *QREFir3d(ig,nlayermx+1-l,iaer)
+
+                     temp2=QIRsQREF3d(ig,max(nlayermx-l,1),nw,iaer)    &
+                          *QREFir3d(ig,max(nlayermx-l,1),iaer)
+
+                     qxiaer(2*l,nw,iaer)  = temp1
+                     qxiaer(2*l+1,nw,iaer)=(temp1+temp2)/2
+
+                     temp1=temp1*omegair3d(ig,nlayermx+1-l,nw,iaer)
+                     temp2=temp2*omegair3d(ig,max(nlayermx-l,1),nw,iaer)
+
+                     qsiaer(2*l,nw,iaer)  = temp1
+                     qsiaer(2*l+1,nw,iaer)=(temp1+temp2)/2
+
+                     temp1=gir3d(ig,nlayermx+1-l,nw,iaer)
+                     temp2=gir3d(ig,max(nlayermx-l,1),nw,iaer)
+
+                     giaer(2*l,nw,iaer)  = temp1
+                     giaer(2*l+1,nw,iaer)=(temp1+temp2)/2
+
+                  end do
+
+                  qxiaer(1,nw,iaer)=qxiaer(2,nw,iaer)
+                  qxiaer(2*nlayermx+1,nw,iaer)=0.
+
+                  qsiaer(1,nw,iaer)=qsiaer(2,nw,iaer)
+                  qsiaer(2*nlayermx+1,nw,iaer)=0.
+
+                  giaer(1,nw,iaer)=giaer(2,nw,iaer)
+                  giaer(2*nlayermx+1,nw,iaer)=0.
+
+               end do
+            end do
+
+            ! test / correct for freaky s. s. albedo values
+            do iaer=1,naerkind
+               do k=1,L_LEVELS+1
+
+                  do nw=1,L_NSPECTV
+                     if(qsvaer(k,nw,iaer).gt.1.05*qxvaer(k,nw,iaer))then
+                        print*,'Serious problems with qsvaer values' 
+                        print*,'in callcorrk'
+                        call abort
+                     endif
+                     if(qsvaer(k,nw,iaer).gt.qxvaer(k,nw,iaer))then
+                        qsvaer(k,nw,iaer)=qxvaer(k,nw,iaer)
+                     endif
+                  end do
+
+                  do nw=1,L_NSPECTI 
+                     if(qsiaer(k,nw,iaer).gt.1.05*qxiaer(k,nw,iaer))then
+                        print*,'Serious problems with qsiaer values'
+                        print*,'in callcorrk'
+                        call abort
+                     endif
+                     if(qsiaer(k,nw,iaer).gt.qxiaer(k,nw,iaer))then
+                        qsiaer(k,nw,iaer)=qxiaer(k,nw,iaer)
+                     endif
+                  end do
+
+               end do
+            end do
+
+!-----------------------------------------------------------------------
+!     Aerosol optical depths
+            
+         do iaer=1,naerkind     ! a bug was here           
+            do k=0,nlayer-1
+               
+               pweight=(pplay(ig,L_NLAYRAD-k)-pplev(ig,L_NLAYRAD-k+1))/   &
+                        (pplev(ig,L_NLAYRAD-k)-pplev(ig,L_NLAYRAD-k+1))
+
+               temp=aerosol(ig,L_NLAYRAD-k,iaer)/QREFvis3d(ig,L_NLAYRAD-k,iaer)
+
+               tauaero(2*k+2,iaer)=max(temp*pweight,0.d0)
+               tauaero(2*k+3,iaer)=max(temp-tauaero(2*k+2,iaer),0.d0)
+!
+            end do
+            ! boundary conditions
+            tauaero(1,iaer)          = tauaero(2,iaer)
+            tauaero(L_LEVELS+1,iaer) = tauaero(L_LEVELS,iaer)
+            !tauaero(1,iaer)          = 0.
+            !tauaero(L_LEVELS+1,iaer) = 0.
+         end do
+
+!     Albedo and emissivity
+         albi=1-emis(ig)        ! longwave
+         albv=albedo(ig)        ! shortwave 
+
+      if(nosurf.and.(albv.gt.0.0))then
+         print*,'For open lower boundary in callcorrk must'
+         print*,'have surface albedo set to zero!'
+         call abort
+      endif
+
+      if ((ngrid.eq.1).and.(global1d)) then       ! fixed zenith angle 'szangle' in 1D simulations w/ globally-averaged sunlight
+         acosz = cos(pi*szangle/180.0)
+         print*,'acosz=',acosz,', szangle=',szangle
+      else
+         acosz=mu0(ig)          ! cosine of sun incident angle : 3D simulations or local 1D simulations using latitude
+      endif
+
+!!! JL13: in the following, I changed some indices in the interpolations so that the model rsults are less dependent on the number of layers
+!!!    the older verions are commented with the commetn !JL13index 
+
+
+!-----------------------------------------------------------------------
+!     Water vapour (to be generalised for other gases eventually)
+      
+      if(varactive)then
+
+         i_var=igcm_h2o_vap
+         do l=1,nlayer
+            qvar(2*l)   = pq(ig,nlayer+1-l,i_var)
+            qvar(2*l+1) = pq(ig,nlayer+1-l,i_var)    
+!JL13index            qvar(2*l+1) = (pq(ig,nlayer+1-l,i_var)+pq(ig,max(nlayer-l,1),i_var))/2    
+!JL13index            ! Average approximation as for temperature...
+         end do
+         qvar(1)=qvar(2)
+
+      elseif(varfixed)then
+
+         do l=1,nlayermx        ! here we will assign fixed water vapour profiles globally
+            RH = satval * ((pplay(ig,l)/pplev(ig,1) - 0.02) / 0.98)
+            if(RH.lt.0.0) RH=0.0
+            
+            ptemp=pplay(ig,l)
+            Ttemp=pt(ig,l)
+            call watersat(Ttemp,ptemp,qsat)
+
+            !pq_temp(l) = qsat      ! fully saturated everywhere
+            pq_temp(l) = RH * qsat ! ~realistic profile (e.g. 80% saturation at ground)
+         end do
+         
+         do l=1,nlayer
+            qvar(2*l)   = pq_temp(nlayer+1-l)
+            qvar(2*l+1) = (pq_temp(nlayer+1-l)+pq_temp(max(nlayer-l,1)))/2
+         end do
+         qvar(1)=qvar(2)
+
+         ! Lowest layer of atmosphere
+         RH = satval * (1 - 0.02) / 0.98
+         if(RH.lt.0.0) RH=0.0
+
+!         ptemp = pplev(ig,1)
+!         Ttemp = tsurf(ig)
+!         call watersat(Ttemp,ptemp,qsat)
+
+         qvar(2*nlayermx+1)= RH * qsat ! ~realistic profile (e.g. 80% saturation at ground)
+ 
+      else
+         do k=1,L_LEVELS
+            qvar(k) = 1.0D-7
+         end do
+      end if
+
+      if(.not.kastprof)then
+      ! IMPORTANT: Now convert from kg/kg to mol/mol
+         do k=1,L_LEVELS
+            qvar(k) = qvar(k)/(epsi+qvar(k)*(1.-epsi))
+         end do
+      end if
+
+!-----------------------------------------------------------------------
+!     kcm mode only
+      if(kastprof)then
+
+         ! initial values equivalent to mugaz
+         DO l=1,nlayer
+            muvarrad(2*l)   = mugaz
+            muvarrad(2*l+1) = mugaz
+         END DO
+
+         if(ngasmx.gt.1)then
+
+            DO l=1,nlayer
+               muvarrad(2*l)   = muvar(ig,nlayer+2-l)
+               muvarrad(2*l+1) = (muvar(ig,nlayer+2-l) + &
+                                muvar(ig,max(nlayer+1-l,1)))/2
+            END DO
+      
+            muvarrad(1) = muvarrad(2)
+            muvarrad(2*nlayermx+1)=muvar(ig,1)
+
+            print*,'Recalculating qvar with VARIABLE epsi for kastprof'
+            print*,'Assumes that the variable gas is H2O!!!'
+            print*,'Assumes that there is only one tracer'
+            !i_var=igcm_h2o_vap
+            i_var=1
+            if(nq.gt.1)then
+               print*,'Need 1 tracer only to run kcm1d.e' 
+               stop
+            endif
+            do l=1,nlayer
+               vtmp(l)=pq(ig,l,i_var)/(epsi+pq(ig,l,i_var)*(1.-epsi)) 
+               !vtmp(l)=pq(ig,l,i_var)*muvar(ig,l+1)/mH2O !JL to be changed
+            end do
+
+            do l=1,nlayer
+               qvar(2*l)   = vtmp(nlayer+1-l)
+               qvar(2*l+1) = vtmp(nlayer+1-l)
+!               qvar(2*l+1) = ( vtmp(nlayer+1-l) + vtmp(max(nlayer-l,1)) )/2
+            end do
+            qvar(1)=qvar(2)
+
+            print*,'Warning: reducing qvar in callcorrk.'
+            print*,'Temperature profile no longer consistent ', &
+                            'with saturated H2O. qsat=',satval
+            do k=1,L_LEVELS
+               qvar(k) = qvar(k)*satval
+            end do
+
+         endif
+      else ! if kastprof
+         DO l=1,nlayer
+            muvarrad(2*l)   = muvar(ig,nlayer+2-l)
+            muvarrad(2*l+1) = (muvar(ig,nlayer+2-l)+muvar(ig,max(nlayer+1-l,1)))/2
+         END DO
+      
+         muvarrad(1) = muvarrad(2)
+         muvarrad(2*nlayermx+1)=muvar(ig,1)         
+      endif
+      
+      ! Keep values inside limits for which we have radiative transfer coefficients
+      if(L_REFVAR.gt.1)then ! there was a bug here!
+         do k=1,L_LEVELS
+            if(qvar(k).lt.wrefvar(1))then
+               qvar(k)=wrefvar(1)+1.0e-8
+            elseif(qvar(k).gt.wrefvar(L_REFVAR))then
+               qvar(k)=wrefvar(L_REFVAR)-1.0e-8
+            endif
+         end do
+      endif
+
+!-----------------------------------------------------------------------
+!     Pressure and temperature
+
+      DO l=1,nlayer
+         plevrad(2*l)   = pplay(ig,nlayer+1-l)/scalep
+         plevrad(2*l+1) = pplev(ig,nlayer+1-l)/scalep
+         tlevrad(2*l)   = pt(ig,nlayer+1-l)
+         tlevrad(2*l+1) = (pt(ig,nlayer+1-l)+pt(ig,max(nlayer-l,1)))/2
+      END DO
+      
+      plevrad(1) = 0.
+      plevrad(2) = max(pgasmin,0.0001*plevrad(3))
+
+      tlevrad(1) = tlevrad(2)
+      tlevrad(2*nlayermx+1)=tsurf(ig)
+      
+      tmid(1) = tlevrad(2)
+      tmid(2) = tlevrad(2)
+      pmid(1) = plevrad(2)
+      pmid(2) = plevrad(2)
+      
+      DO l=1,L_NLAYRAD-1
+         tmid(2*l+1) = tlevrad(2*l)
+         tmid(2*l+2) = tlevrad(2*l)
+         pmid(2*l+1) = plevrad(2*l)
+         pmid(2*l+2) = plevrad(2*l)
+!JL13index         tmid(2*l+1) = tlevrad(2*l+1)
+!JL13index         tmid(2*l+2) = tlevrad(2*l+1)
+!JL13index         pmid(2*l+1) = plevrad(2*l+1)
+!JL13index         pmid(2*l+2) = plevrad(2*l+1)
+      END DO
+      pmid(L_LEVELS) = plevrad(L_LEVELS-1)
+      tmid(L_LEVELS) = tlevrad(L_LEVELS-1)
+!JL13index      pmid(L_LEVELS) = plevrad(L_LEVELS)
+!JL13index      tmid(L_LEVELS) = tlevrad(L_LEVELS)
+
+      ! test for out-of-bounds pressure
+      if(plevrad(3).lt.pgasmin)then
+         print*,'Minimum pressure is outside the radiative'
+         print*,'transfer kmatrix bounds, exiting.'
+         call abort
+      elseif(plevrad(L_LEVELS).gt.pgasmax)then
+         print*,'Maximum pressure is outside the radiative'
+         print*,'transfer kmatrix bounds, exiting.'
+         call abort
+      endif
+
+      ! test for out-of-bounds temperature
+      do k=1,L_LEVELS
+         if(tlevrad(k).lt.tgasmin)then
+            print*,'Minimum temperature is outside the radiative'
+            print*,'transfer kmatrix bounds'
+            print*,"k=",k," tlevrad(k)=",tlevrad(k)
+            print*,"tgasmin=",tgasmin
+            if (strictboundcorrk) then
+              call abort
+            else
+              print*,'***********************************************'
+              print*,'we allow model to continue with tlevrad=tgasmin' 
+              print*,'  ... we assume we know what you are doing ... '
+              print*,'  ... but do not let this happen too often ... '
+              print*,'***********************************************'
+              !tlevrad(k)=tgasmin
+            endif
+         elseif(tlevrad(k).gt.tgasmax)then
+            print*,'Maximum temperature is outside the radiative'
+            print*,'transfer kmatrix bounds, exiting.'
+            print*,"k=",k," tlevrad(k)=",tlevrad(k)
+            print*,"tgasmax=",tgasmax
+            if (strictboundcorrk) then
+              call abort
+            else
+              print*,'***********************************************'
+              print*,'we allow model to continue with tlevrad=tgasmax'  
+              print*,'  ... we assume we know what you are doing ... '
+              print*,'  ... but do not let this happen too often ... '
+              print*,'***********************************************'
+              !tlevrad(k)=tgasmax
+            endif
+         endif
+      enddo
+      do k=1,L_NLAYRAD+1
+         if(tmid(k).lt.tgasmin)then
+            print*,'Minimum temperature is outside the radiative'
+            print*,'transfer kmatrix bounds, exiting.'
+            print*,"k=",k," tmid(k)=",tmid(k)
+            print*,"tgasmin=",tgasmin
+            if (strictboundcorrk) then
+              call abort
+            else
+              print*,'***********************************************'
+              print*,'we allow model to continue with tmid=tgasmin'
+              print*,'  ... we assume we know what you are doing ... '
+              print*,'  ... but do not let this happen too often ... '
+              print*,'***********************************************'
+              tmid(k)=tgasmin
+            endif
+         elseif(tmid(k).gt.tgasmax)then
+            print*,'Maximum temperature is outside the radiative'
+            print*,'transfer kmatrix bounds, exiting.'
+            print*,"k=",k," tmid(k)=",tmid(k)
+            print*,"tgasmax=",tgasmax
+            if (strictboundcorrk) then
+              call abort
+            else
+              print*,'***********************************************'
+              print*,'we allow model to continue with tmid=tgasmin'
+              print*,'  ... we assume we know what you are doing ... '
+              print*,'  ... but do not let this happen too often ... '
+              print*,'***********************************************'
+              tmid(k)=tgasmax
+            endif
+         endif
+      enddo
+
+!=======================================================================
+!     Calling the main radiative transfer subroutines
+
+
+         Cmk= 0.01 * 1.0 / (glat(ig) * mugaz * 1.672621e-27) ! q_main=1.0 assumed
+	 glat_ig=glat(ig)
+
+!-----------------------------------------------------------------------
+!     Shortwave
+
+         if(fract(ig) .ge. 1.0e-4) then ! only during daylight!
+            if((ngrid.eq.1).and.(global1d))then
+               do nw=1,L_NSPECTV
+                  stel_fract(nw)= stel(nw)* 0.25 / acosz
+                                ! globally averaged = divide by 4
+                                ! but we correct for solar zenith angle
+               end do
+            else
+               do nw=1,L_NSPECTV
+                  stel_fract(nw)= stel(nw) * fract(ig)
+               end do
+            endif 
+            call optcv(dtauv,tauv,taucumv,plevrad,                 &
+                 qxvaer,qsvaer,gvaer,wbarv,cosbv,tauray,tauaero,   &
+                 tmid,pmid,taugsurf,qvar,muvarrad)
+
+            call sfluxv(dtauv,tauv,taucumv,albv,dwnv,wbarv,cosbv,  &
+                 acosz,stel_fract,gweight,                         &
+                 nfluxtopv,fluxtopvdn,nfluxoutv_nu,nfluxgndv_nu,              &
+                 fmnetv,fluxupv,fluxdnv,fzerov,taugsurf)
+
+         else                          ! during the night, fluxes = 0
+            nfluxtopv       = 0.0d0
+	    fluxtopvdn      = 0.0d0
+            nfluxoutv_nu(:) = 0.0d0
+            nfluxgndv_nu(:) = 0.0d0
+            do l=1,L_NLAYRAD
+               fmnetv(l)=0.0d0
+               fluxupv(l)=0.0d0
+               fluxdnv(l)=0.0d0
+            end do
+         end if
+
+!-----------------------------------------------------------------------
+!     Longwave
+
+         call optci(plevrad,tlevrad,dtaui,taucumi,                  &
+              qxiaer,qsiaer,giaer,cosbi,wbari,tauaero,tmid,pmid,    &
+              taugsurfi,qvar,muvarrad)
+
+         call sfluxi(plevrad,tlevrad,dtaui,taucumi,ubari,albi,      &
+              wnoi,dwni,cosbi,wbari,gweight,nfluxtopi,nfluxtopi_nu, & 
+              fmneti,fluxupi,fluxdni,fluxupi_nu,fzeroi,taugsurfi)
+
+!-----------------------------------------------------------------------
+!     Transformation of the correlated-k code outputs
+!     (into dtlw, dtsw, fluxsurf_lw, fluxsurf_sw, fluxtop_lw, fluxtop_sw)
+
+!     Flux incident at the top of the atmosphere
+         fluxtop_dn(ig)=fluxtopvdn 
+
+         fluxtop_lw(ig)  = real(nfluxtopi)
+         fluxabs_sw(ig)  = real(-nfluxtopv)
+         fluxsurf_lw(ig) = real(fluxdni(L_NLAYRAD))
+         fluxsurf_sw(ig) = real(fluxdnv(L_NLAYRAD))
+
+         if(fluxtop_dn(ig).lt.0.0)then
+            print*,'Achtung! fluxtop_dn has lost the plot!'
+            print*,'fluxtop_dn=',fluxtop_dn(ig)
+            print*,'acosz=',acosz
+            print*,'aerosol=',aerosol(ig,:,:)
+            print*,'temp=   ',pt(ig,:)
+            print*,'pplay=  ',pplay(ig,:)
+            call abort
+         endif
+
+!     Spectral output, for exoplanet observational comparison
+         if(specOLR)then
+            do nw=1,L_NSPECTI 
+               OLR_nu(ig,nw)=nfluxtopi_nu(nw)/DWNI(nw) !JL Normalize to the bandwidth
+            end do
+            do nw=1,L_NSPECTV 
+               !GSR_nu(ig,nw)=nfluxgndv_nu(nw)
+               OSR_nu(ig,nw)=nfluxoutv_nu(nw)/DWNV(nw) !JL Normalize to the bandwidth
+            end do
+         endif
+
+!     Finally, the heating rates
+
+         DO l=2,L_NLAYRAD
+            dtsw(ig,L_NLAYRAD+1-l)=(fmnetv(l)-fmnetv(l-1))  &
+                *glat(ig)/(cpp*scalep*(plevrad(2*l+1)-plevrad(2*l-1)))
+            dtlw(ig,L_NLAYRAD+1-l)=(fmneti(l)-fmneti(l-1))  &
+                *glat(ig)/(cpp*scalep*(plevrad(2*l+1)-plevrad(2*l-1)))
+         END DO      
+
+!     These are values at top of atmosphere
+         dtsw(ig,L_NLAYRAD)=(fmnetv(1)-nfluxtopv)           &
+             *glat(ig)/(cpp*scalep*(plevrad(3)-plevrad(1)))
+         dtlw(ig,L_NLAYRAD)=(fmneti(1)-nfluxtopi)           &
+             *glat(ig)/(cpp*scalep*(plevrad(3)-plevrad(1)))
+
+!     ---------------------------------------------------------------
+      end do                    ! end of big loop over every GCM column (ig = 1:ngrid)
+
+
+!-----------------------------------------------------------------------
+!     Additional diagnostics
+
+!     IR spectral output, for exoplanet observational comparison
+
+
+      if(lastcall.and.(ngrid.eq.1))then  ! could disable the 1D output, they are in the diagfi and diagspec... JL12
+
+           print*,'Saving scalar quantities in surf_vals.out...'
+           print*,'psurf = ', pplev(1,1),' Pa'
+           open(116,file='surf_vals.out')
+           write(116,*) tsurf(1),pplev(1,1),fluxtop_dn(1),         &
+                real(-nfluxtopv),real(nfluxtopi) 
+           close(116)
+
+!          I am useful, please don`t remove me!
+!           if(specOLR)then
+!               open(117,file='OLRnu.out')
+!               do nw=1,L_NSPECTI
+!                  write(117,*) OLR_nu(1,nw)
+!               enddo
+!               close(117)
+!
+!               open(127,file='OSRnu.out')
+!               do nw=1,L_NSPECTV
+!                  write(127,*) OSR_nu(1,nw)
+!               enddo
+!               close(127)
+!           endif
+
+!     OLR vs altitude: do it as a .txt file
+           OLRz=.false.
+           if(OLRz)then
+              print*,'saving IR vertical flux for OLRz...'
+              open(118,file='OLRz_plevs.out')
+              open(119,file='OLRz.out')
+              do l=1,L_NLAYRAD
+                 write(118,*) plevrad(2*l)
+                 do nw=1,L_NSPECTI
+                     write(119,*) fluxupi_nu(l,nw) 
+                  enddo
+              enddo 
+              close(118)
+              close(119)
+           endif
+
+      endif
+
+      ! see physiq.F for explanations about CLFvarying. This is temporary.
+      if (lastcall .and. .not.CLFvarying) then
+        IF( ALLOCATED( gasi ) ) DEALLOCATE( gasi )
+        IF( ALLOCATED( gasv ) ) DEALLOCATE( gasv )
+        IF( ALLOCATED( pgasref ) ) DEALLOCATE( pgasref )
+        IF( ALLOCATED( tgasref ) ) DEALLOCATE( tgasref )
+        IF( ALLOCATED( wrefvar ) ) DEALLOCATE( wrefvar )
+        IF( ALLOCATED( pfgasref ) ) DEALLOCATE( pfgasref )
+        IF ( ALLOCATED(reffrad)) DEALLOCATE(reffrad)
+        IF ( ALLOCATED(nueffrad)) DEALLOCATE(nueffrad)
+      endif
+
+
+    end subroutine callcorrk
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callkeys.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callkeys.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callkeys.h	(revision 222)
@@ -0,0 +1,118 @@
+!
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+!
+! Group commons according to their type for minimal performance impact
+
+      COMMON/callkeys_l/callrad,corrk,calldifv,UseTurbDiff,calladj      &
+     &   , co2cond,callsoil                                             &
+     &   , season,diurnal,tlocked,rings_shadow,lwrite                   &
+     &   , callstats,calleofdump                                        &
+     &   , enertest                                                     &
+     &   , callgasvis,continuum,H2Ocont_simple,graybody                 &
+     &   , radfixed                                                     &
+     &   , meanOLR, specOLR                                             &
+     &   , kastprof                                                     &
+     &   , nosurf, oblate                                               &     
+     &   , newtonian, testradtimes                                      &
+     &   , check_cpp_match, force_cpp                                   &
+     &   , rayleigh                                                     &
+     &   , stelbbody                                                    &
+     &   , nearco2cond                                                  &
+     &   , tracer, mass_redistrib, varactive, varfixed                  &
+     &   , sedimentation,water,watercond,waterrain                      &
+     &   , aeroco2,aeroh2o,aeroh2so4,aeroback2lay                       &
+     &   , aerofixco2,aerofixh2o                                        &
+     &   , hydrology, sourceevol                                        &
+     &   , CLFvarying                                                   &
+     &   , strictboundcorrk                                             &                                        
+     &   , ok_slab_ocean                                                &
+     &   , ok_slab_sic                                                  &
+     &   , ok_slab_heat_transp                                          
+
+
+      COMMON/callkeys_i/iaervar,iddist,iradia,startype
+      
+      COMMON/callkeys_r/topdustref,Nmix_co2,dusttau,Fat1AU,stelTbb,     &
+     &                  Tstrat,tplanet,obs_tau_col_tropo,               &
+     &                  obs_tau_col_strato,pres_bottom_tropo,           &
+     &                  pres_top_tropo,pres_bottom_strato,              &
+     &                  pres_top_strato,size_tropo,size_strato,satval,  &
+     &                  CLFfixval,n2mixratio,co2supsat,pceil,albedosnow,&
+     &                  maxicethick,Tsaldiff,tau_relax,cloudlvl,        &
+     &                  icetstep,intheat,flatten,Rmean,J2,MassPlanet
+      
+      logical callrad,corrk,calldifv,UseTurbDiff                        &
+     &   , calladj,co2cond,callsoil                                     &
+     &   , season,diurnal,tlocked,rings_shadow,lwrite                   &
+     &   , callstats,calleofdump                                        &
+     &   , callgasvis,continuum,H2Ocont_simple,graybody                 &
+     &   , strictboundcorrk                                             
+
+      logical enertest
+      logical nonideal
+      logical meanOLR
+      logical specOLR
+      logical kastprof
+      logical newtonian
+      logical check_cpp_match
+      logical force_cpp
+      logical testradtimes
+      logical rayleigh
+      logical stelbbody
+      logical ozone
+      logical nearco2cond
+      logical tracer
+      logical mass_redistrib
+      logical varactive
+      logical varfixed
+      logical radfixed
+      logical sedimentation
+      logical water,watercond,waterrain
+      logical aeroco2,aeroh2o,aeroh2so4,aeroback2lay
+      logical aerofixco2,aerofixh2o
+      logical hydrology
+      logical sourceevol
+      logical CLFvarying
+      logical nosurf
+      logical oblate
+      logical ok_slab_ocean
+      logical ok_slab_sic
+      logical ok_slab_heat_transp
+
+      integer iddist
+      integer iaervar
+      integer iradia
+      integer startype
+
+      real topdustref
+      real Nmix_co2
+      real dusttau
+      real Fat1AU
+      real stelTbb
+      real Tstrat
+      real tplanet
+      real obs_tau_col_tropo
+      real obs_tau_col_strato
+      real pres_bottom_tropo
+      real pres_top_tropo
+      real pres_bottom_strato
+      real pres_top_strato
+      real size_tropo
+      real size_strato
+      real satval
+      real CLFfixval
+      real n2mixratio
+      real co2supsat
+      real pceil
+      real albedosnow
+      real maxicethick
+      real Tsaldiff
+      real tau_relax
+      real cloudlvl
+      real icetstep
+      real intheat
+      real flatten
+      real Rmean
+      real J2
+      real MassPlanet
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callsedim.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callsedim.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/callsedim.F	(revision 222)
@@ -0,0 +1,159 @@
+      SUBROUTINE callsedim(ngrid,nlay, ptimestep,
+     &                pplev,zlev, pt, pdt,
+     &                pq, pdqfi, pdqsed,pdqs_sed,nq)
+
+      use radinc_h, only : naerkind
+      use radii_mod, only: h2o_reffrad
+      use aerosol_mod, only : iaero_h2o
+      USE tracer_h, only : igcm_co2_ice,igcm_h2o_ice,radius,rho_q
+
+      IMPLICIT NONE
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates sedimentation of aerosols depending on their
+!     density and radius.
+!     
+!     Authors
+!     -------
+!     F. Forget (1999)
+!     Tracer generalisation by E. Millour (2009)
+!     
+!==================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+c   arguments:
+c   ----------
+
+      integer,intent(in):: ngrid ! number of horizontal grid points
+      integer,intent(in):: nlay  ! number of atmospheric layers
+      real,intent(in):: ptimestep  ! physics time step (s)
+      real,intent(in):: pplev(ngrid,nlay+1) ! pressure at inter-layers (Pa)
+      real,intent(in):: pt(ngrid,nlay)      ! temperature at mid-layer (K)
+      real,intent(in):: pdt(ngrid,nlay) ! tendency on temperature
+      real,intent(in):: zlev(ngrid,nlay+1)  ! altitude at layer boundaries
+      integer,intent(in) :: nq ! number of tracers
+      real,intent(in) :: pq(ngrid,nlay,nq)  ! tracers (kg/kg)
+      real,intent(in) :: pdqfi(ngrid,nlay,nq)  ! tendency on tracers before
+                                               ! sedimentation (kg/kg.s-1)
+      
+      real,intent(out) :: pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
+      real,intent(out) :: pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, iq
+
+      ! for particles with varying radii:
+      real reffrad(ngrid,nlay,naerkind) ! particle radius (m) 
+      real nueffrad(ngrid,nlay,naerkind) ! aerosol effective radius variance
+
+      real zqi(ngrid,nlay,nq) ! to locally store tracers
+      real zt(ngrid,nlay) ! to locally store temperature (K)
+      real masse (ngrid,nlay) ! Layer mass (kg.m-2)
+      real epaisseur (ngrid,nlay) ! Layer thickness (m)
+      real wq(ngrid,nlay+1) ! displaced tracer mass (kg.m-2)
+c      real dens(ngrid,nlayermx) ! Mean density of the ice part. accounting for dust core
+
+
+      LOGICAL,SAVE :: firstcall=.true.
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+        firstcall=.false.
+        ! add some tests on presence of required tracers/aerosols:
+        if (water) then
+          if (igcm_h2o_ice.eq.0) then
+            write(*,*) "callsedim error: water=.true.",
+     &                 " but igcm_h2o_ice=0"
+          stop
+          endif
+          if (iaero_h2o.eq.0) then
+            write(*,*) "callsedim error: water=.true.",
+     &                 " but iaero_ho2=0"
+          stop
+          endif
+        endif
+      ENDIF ! of IF (firstcall)
+      
+!=======================================================================
+!     Preliminary calculation of the layer characteristics
+!     (mass (kg.m-2), thickness (m), etc.
+
+      do  l=1,nlay
+        do ig=1, ngrid
+          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g 
+          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
+          zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep
+        end do
+      end do
+
+!======================================================================
+! Calculate the transport due to sedimentation for each tracer
+! [This has been rearranged by L. Kerber to allow the sedimentation
+!  of general tracers.]
+ 
+      do iq=1,nq
+       if((radius(iq).gt.1.e-9).and.(iq.ne.igcm_co2_ice)) then   
+!         (no sedim for gases, and co2_ice sedim is done in condense_cloud)      
+
+! store locally updated tracers
+
+          do l=1,nlay 
+            do ig=1, ngrid
+              zqi(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+            enddo
+          enddo ! of do l=1,nlay
+        
+!======================================================================
+! Sedimentation 
+!======================================================================
+! Water          
+          if (water.and.(iq.eq.igcm_h2o_ice)) then
+            ! compute radii for h2o_ice 
+             call h2o_reffrad(ngrid,zqi(1,1,igcm_h2o_ice),zt,
+     &                reffrad(1,1,iaero_h2o),nueffrad(1,1,iaero_h2o))
+            ! call sedimentation for h2o_ice
+             call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
+     &            pplev,masse,epaisseur,zt,reffrad(1,1,iaero_h2o),
+     &            rho_q(iq),zqi(1,1,igcm_h2o_ice),wq)
+
+! General Case
+          else 
+             call newsedim(ngrid,nlay,1,ptimestep,
+     &            pplev,masse,epaisseur,zt,radius(iq),rho_q(iq),
+     &            zqi(1,1,iq),wq)
+          endif
+
+!=======================================================================
+!     Calculate the tendencies
+!======================================================================
+
+          do ig=1,ngrid
+!     Ehouarn: with new way of tracking tracers by name, this is simply
+            pdqs_sed(ig,iq) = wq(ig,1)/ptimestep
+          end do
+
+          DO l = 1, nlay
+            DO ig=1,ngrid
+              pdqsed(ig,l,iq)=(zqi(ig,l,iq)-
+     &        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+       endif ! of no gases no co2_ice
+      enddo ! of do iq=1,nq
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comcstfi.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comcstfi.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comcstfi.h	(revision 222)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+! INCLUDE "comcstfi.h"
+
+      common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+      common/comcstfi/avocado!,molrad,visc
+      
+      real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
+      real avocado!,molrad,visc
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comdiurn_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comdiurn_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comdiurn_h.F90	(revision 222)
@@ -0,0 +1,10 @@
+
+       module comdiurn_h
+
+       implicit none
+
+       real, allocatable, dimension(:) :: sinlon, coslon, sinlat, coslat
+       logical :: ldiurn
+
+       end module comdiurn_h
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comg1d.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comg1d.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comg1d.h	(revision 222)
@@ -0,0 +1,63 @@
+!.......................................................................
+!  le COMMON pour GRADS-1D
+!  (Utilise pour les sorties format Grads dans la version 1D du modele)
+!
+!  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
+!
+      INTEGER g1d_nvarmx
+      PARAMETER(g1d_nvarmx=1000)
+
+!         * g1d_nlayer     ---> nombre de couches verticales
+!         * g1d_nomfich    ---> nom du fichier grads
+!         * g1d_unitfich   ---> code du fichier grads
+!         * g1d_nomctl     ---> nom du fichier ctl
+!         * g1d_unitctl    ---> code du fichier ctl
+!         * g1d_premier    ---> variable logique pour dire si le fichier
+!                               est deja ouvert
+!         * g1d_irec       ---> indice de derniere ecriture
+!         * g1d_nvar       ---> nombre de variables deja definies a la
+!                               derniere ecriture
+!         * g1d_nomvar     ---> noms des vecteurs existants
+!         * g1d_dimvar     ---> taille des vecteurs
+!         * g1d_titrevar   ---> titres des vecteurs
+!         * g1d_tmp1       ---> caractere 
+!         * g1d_tmp2       ---> caractere 
+
+      INTEGER g1d_nlayer
+      CHARACTER*100 g1d_nomfich
+      INTEGER g1d_unitfich
+      CHARACTER*100 g1d_nomctl
+      INTEGER g1d_unitctl
+      LOGICAL g1d_premier
+      LOGICAL g2d_premier
+      INTEGER g1d_irec
+      INTEGER g2d_irec
+      INTEGER g2d_appel
+      INTEGER g1d_nvar
+      CHARACTER*100 g1d_nomvar
+      INTEGER g1d_dimvar
+      CHARACTER*100 g1d_titrevar
+      CHARACTER*100 g1d_tmp1,g1d_tmp2
+
+!     added by RW
+      integer saveG1D
+
+      COMMON/COMG1DI/g1d_nlayer                                         &
+     &             ,g1d_unitfich                                        &
+     &             ,g1d_unitctl                                         &
+     &             ,g1d_irec                                            &
+     &             ,g2d_irec                                            &
+     &             ,g2d_appel                                           &
+     &             ,g1d_nvar                                            &
+     &             ,saveG1D
+      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)                           &
+     &             ,g1d_nomfich                                         &
+     &             ,g1d_nomctl                                          &
+     &             ,g1d_nomvar(0:g1d_nvarmx)                            &
+     &             ,g1d_titrevar(0:g1d_nvarmx)                          &
+     &             ,g1d_tmp1                                            &
+     &             ,g1d_tmp2                                            
+      COMMON/COMG1DL/g1d_premier                                        &
+     &             ,g2d_premier
+!
+!.......................................................................
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comgeomfi_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comgeomfi_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comgeomfi_h.F90	(revision 222)
@@ -0,0 +1,10 @@
+
+       module comgeomfi_h
+
+       implicit none
+
+       REAL,ALLOCATABLE,DIMENSION(:) :: long,lati,area
+       REAL :: totarea, totarea_planet
+
+       end module comgeomfi_h
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comgeomphy.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comgeomphy.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comgeomphy.F90	(revision 222)
@@ -0,0 +1,23 @@
+module comgeomphy
+   real,save,allocatable :: airephy(:)
+   real,save,allocatable :: cuphy(:)
+   real,save,allocatable :: cvphy(:)
+   real,save,allocatable :: rlatd(:)
+   real,save,allocatable :: rlond(:)
+!$OMP THREADPRIVATE(airephy,cuphy,cvphy,rlatd,rlond)
+contains
+  
+  subroutine initcomgeomphy
+  USE mod_phys_lmdz_para, only: klon_omp
+  implicit none
+    
+ 
+    allocate(airephy(klon_omp))
+    allocate(cuphy(klon_omp))
+    allocate(cvphy(klon_omp))
+    allocate(rlatd(klon_omp))
+    allocate(rlond(klon_omp))
+
+  end subroutine initcomgeomphy
+  
+end module comgeomphy
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comhdiff.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comhdiff.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comhdiff.h	(revision 222)
@@ -0,0 +1,15 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/comdissipn.h,v 1.1.1.1 2008-03-27 12:53:06 lmdzadmin Exp $
+!
+!-----------------------------------------------------------------------
+! INCLUDE comdhdiff.h
+
+
+
+      COMMON/comhdiff/                                                  &
+     &     zmasqu(ip1jmp1),zmasqv(ip1jm),alpha_var,                     &     
+     &     unsfv(ip1jm),unsev(ip1jm),unsfu(ip1jmp1),unseu(ip1jmp1),     &
+     &     slab_upstream      
+
+      LOGICAL alpha_var,slab_upstream
+      REAL zmasqu,zmasqv,unsfv,unsev,unsfu,unseu
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comsaison_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comsaison_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comsaison_h.F90	(revision 222)
@@ -0,0 +1,12 @@
+
+       module comsaison_h
+
+       implicit none 
+
+       integer isaison
+       logical callsais
+       real dist_star,declin
+
+       real, allocatable, dimension(:) :: mu0,fract
+
+       end module comsaison_h
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comsoil_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comsoil_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/comsoil_h.F90	(revision 222)
@@ -0,0 +1,31 @@
+module comsoil_h
+
+implicit none
+! nsoilmx : number of subterranean layers
+!integer, parameter :: nsoilmx = 18 ! for z1=0.0002 m, depth = 18 m => mars case 
+!integer, parameter :: nsoilmx = 13 ! for z1=0.03 m, depth = 104.8 m => earth case
+  integer, parameter :: nsoilmx = 18
+
+  real,save,allocatable,dimension(:) :: layer      ! soil layer depths
+  real,save,allocatable,dimension(:) :: mlayer     ! soil mid-layer depths
+  real,save,allocatable,dimension(:,:) :: inertiedat ! soil thermal inertia
+  real,save :: volcapa    ! soil volumetric heat capacity
+       ! NB: volcapa is read fromn control(35) from physicq start file
+       !     in physdem (or set via tabfi, or initialized in
+       !                 soil_settings.F)
+
+contains
+
+  subroutine ini_comsoil_h(ngrid)
+  
+  implicit none
+  integer,intent(in) :: ngrid ! number of atmospheric columns
+  
+    if (.not.allocated(layer)) allocate(layer(nsoilmx)) !soil layer depths
+    if (.not.allocated(mlayer)) allocate(mlayer(0:nsoilmx-1)) ! soil mid-layer depths
+    if (.not.allocated(inertiedat)) allocate(inertiedat(ngrid,nsoilmx)) ! soil thermal inertia
+  
+  end subroutine ini_comsoil_h
+
+end module comsoil_h
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/condense_cloud.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/condense_cloud.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/condense_cloud.F90	(revision 222)
@@ -0,0 +1,527 @@
+      subroutine condense_cloud(ngrid,nlayer,nq,ptimestep, &
+          pcapcal,pplay,pplev,ptsrf,pt, &
+          pphi,pdt,pdu,pdv,pdtsrf,pu,pv,pq,pdq, &
+          piceco2,psolaralb,pemisurf, &
+          pdtc,pdtsrfc,pdpsrf,pduc,pdvc, &
+          pdqc)
+
+      use radinc_h, only : naerkind
+      use gases_h, only: gfrac, igas_co2
+      use radii_mod, only : co2_reffrad
+      use aerosol_mod, only : iaero_co2
+      USE surfdat_h, only: albedodat, albedice, emisice, emissiv
+      USE comgeomfi_h, only: lati
+      USE tracer_h, only: noms, rho_co2
+
+
+      implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Condense and/or sublime CO2 ice on the ground and in the
+!     atmosphere, and sediment the ice.
+!  
+!     Inputs
+!     ------
+!     ngrid                 Number of vertical columns
+!     nlayer                Number of layers
+!     pplay(ngrid,nlayer)   Pressure layers
+!     pplev(ngrid,nlayer+1) Pressure levels 
+!     pt(ngrid,nlayer)      Temperature (in K)
+!     ptsrf(ngrid)          Surface temperature
+!     
+!     pdt(ngrid,nlayermx)   Time derivative before condensation/sublimation of pt
+!     pdtsrf(ngrid)         Time derivative before condensation/sublimation of ptsrf
+!     pqsurf(ngrid,nq)      Sedimentation flux at the surface (kg.m-2.s-1)
+!     
+!     Outputs
+!     -------
+!     pdpsrf(ngrid)         \  Contribution of condensation/sublimation
+!     pdtc(ngrid,nlayermx)  /  to the time derivatives of Ps, pt, and ptsrf
+!     pdtsrfc(ngrid)       /
+!     
+!     Both
+!     ----
+!     piceco2(ngrid)        CO2 ice at the surface (kg/m2)
+!     psolaralb(ngrid)      Albedo at the surface
+!     pemisurf(ngrid)       Emissivity of the surface
+!
+!     Authors
+!     ------- 
+!     Francois Forget (1996)
+!     Converted to Fortran 90 and slightly modified by R. Wordsworth (2009)
+!     Includes simplifed nucleation by J. Leconte (2011)
+!     
+!==================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "callkeys.h"
+
+!-----------------------------------------------------------------------
+!     Arguments
+
+      INTEGER,INTENT(IN) :: ngrid
+      INTEGER,INTENT(IN) :: nlayer
+      INTEGER,INTENT(IN) :: nq
+      REAL,INTENT(IN) :: ptimestep 
+      REAL,INTENT(IN) :: pcapcal(ngrid)
+      REAL,INTENT(IN) :: pplay(ngrid,nlayer)
+      REAL,INTENT(IN) :: pplev(ngrid,nlayer+1)
+      REAL,INTENT(IN) :: ptsrf(ngrid)
+      REAL,INTENT(IN) :: pt(ngrid,nlayer)
+      REAL,INTENT(IN) :: pphi(ngrid,nlayer)
+      REAL,INTENT(IN) :: pdt(ngrid,nlayer)
+      REAL,INTENT(IN) :: pdu(ngrid,nlayer)
+      REAL,INTENT(IN) :: pdv(ngrid,nlayer)
+      REAL,INTENT(IN) :: pdtsrf(ngrid)
+      REAL,INTENT(IN) :: pu(ngrid,nlayer)
+      REAL,INTENT(IN) :: pv(ngrid,nlayer)
+      REAL,INTENT(IN) :: pq(ngrid,nlayer,nq)
+      REAL,INTENT(IN) :: pdq(ngrid,nlayer,nq)
+      REAL,INTENT(INOUT) :: piceco2(ngrid)
+      REAL,INTENT(OUT) :: psolaralb(ngrid)
+      REAL,INTENT(OUT) :: pemisurf(ngrid)
+      REAL,INTENT(OUT) :: pdtc(ngrid,nlayer)
+      REAL,INTENT(OUT) :: pdtsrfc(ngrid)
+      REAL,INTENT(OUT) :: pdpsrf(ngrid)
+      REAL,INTENT(OUT) :: pduc(ngrid,nlayer)
+      REAL,INTENT(OUT) :: pdvc(ngrid,nlayer)
+      REAL,INTENT(OUT) :: pdqc(ngrid,nlayer,nq)
+
+!-----------------------------------------------------------------------
+!     Local variables
+
+      INTEGER l,ig,icap,ilay,it,iq
+
+      REAL reffrad(ngrid,nlayer) ! radius (m) of the co2 ice particles
+      REAL*8 zt(ngrid,nlayermx)
+      REAL zq(ngrid,nlayermx,nq)
+      REAL zcpi
+      REAL ztcond (ngrid,nlayermx)
+      REAL ztnuc (ngrid,nlayermx)
+      REAL ztcondsol(ngrid) 
+      REAL zdiceco2(ngrid)
+      REAL zcondicea(ngrid,nlayermx), zcondices(ngrid)
+      REAL zfallice(ngrid), Mfallice(ngrid) 
+      REAL zmflux(nlayermx+1)
+      REAL zu(nlayermx),zv(nlayermx)
+      REAL ztsrf(ngrid)
+      REAL ztc(nlayermx), ztm(nlayermx+1) 
+      REAL zum(nlayermx+1) , zvm(nlayermx+1)
+      LOGICAL condsub(ngrid)
+      REAL subptimestep
+      Integer Ntime
+      real masse (ngrid,nlayermx), w(ngrid,nlayermx,nq)
+      real wq(ngrid,nlayermx+1)
+      real vstokes,reff
+
+!     Special diagnostic variables
+      real tconda1(ngrid,nlayermx)
+      real tconda2(ngrid,nlayermx)
+      real zdtsig (ngrid,nlayermx)
+      real zdt (ngrid,nlayermx)
+
+!-----------------------------------------------------------------------
+!     Saved local variables
+
+      REAL,SAVE :: latcond=5.9e5
+      REAL,SAVE :: ccond
+      REAL,SAVE :: cpice=1000.
+      REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: emisref
+
+      LOGICAL,SAVE :: firstcall=.true.
+      REAL,EXTERNAL :: SSUM
+
+      REAL,EXTERNAL :: CBRT
+
+      INTEGER,SAVE :: i_co2ice=0      ! co2 ice
+      CHARACTER(LEN=20) :: tracername ! to temporarily store text
+
+      integer igas
+
+      real ppco2
+
+!-----------------------------------------------------------------------
+!     Initializations
+
+      pdqc(1:ngrid,1:nlayer,1:nq)=0
+      pdtc(1:ngrid,1:nlayer)=0
+      zq(1:ngrid,1:nlayer,1:nq)=0
+      zt(1:ngrid,1:nlayer)=0
+
+!     Initialisation
+      IF (firstcall) THEN
+
+         ALLOCATE(emisref(ngrid)) !! this should be deallocated in lastcall...
+
+         ! find CO2 ice tracer
+         do iq=1,nq
+            tracername=noms(iq)
+            if (tracername.eq."co2_ice") then
+               i_co2ice=iq
+            endif
+         enddo
+         
+        write(*,*) "condense_cloud: i_co2ice=",i_co2ice       
+
+        if((i_co2ice.lt.1))then
+           print*,'In condens_cloud but no CO2 ice tracer, exiting.'
+           print*,'Still need generalisation to arbitrary species!'
+           stop
+        endif
+
+         ccond=cpp/(g*latcond)
+         print*,'In condens_cloud: ccond=',ccond,' latcond=',latcond
+
+!          Prepare special treatment if gas is not pure CO2
+             !if (addn2) then
+             !   m_co2   = 44.01E-3 ! CO2 molecular mass (kg/mol)   
+             !   m_noco2 = 28.02E-3 ! N2 molecular mass (kg/mol)  
+!               Compute A and B coefficient use to compute
+!               mean molecular mass Mair defined by
+!               1/Mair = q(ico2)/m_co2 + (1-q(ico2))/m_noco2
+!               1/Mair = A*q(ico2) + B
+             !   A = (1/m_co2 - 1/m_noco2)
+             !   B = 1/m_noco2
+             !endif
+
+!          Minimum CO2 mixing ratio below which mixing occurs with layer above: 
+           !qco2min =0.75  
+
+           firstcall=.false.
+      ENDIF
+      zcpi=1./cpp
+
+!-----------------------------------------------------------------------
+!     Calculation of CO2 condensation / sublimation 
+!
+!     Variables used:
+!     piceco2(ngrid)       amount of co2 ice on the ground  (kg/m2)
+!     zcondicea(ngrid,l)   condensation rate in layer l     (kg/m2/s)
+!     zcondices(ngrid)     condensation rate on the ground  (kg/m2/s)
+!     zfallice(ngrid)      flux of ice falling on surface   (kg/m2/s)
+!     pdtc(ngrid,nlayermx) dT/dt due to phase changes       (K/s)
+     
+
+!     Tendencies initially set to 0 (except pdtc)
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zcondicea(ig,l) = 0.
+            pduc(ig,l)  = 0
+            pdvc(ig,l)  = 0
+            pdqc(ig,l,i_co2ice)  = 0
+         END DO
+      END DO
+      
+      DO ig=1,ngrid
+         Mfallice(ig) = 0.
+         zfallice(ig) = 0.
+         zcondices(ig) = 0.
+         pdtsrfc(ig) = 0.
+         pdpsrf(ig) = 0.
+         condsub(ig) = .false.
+         zdiceco2(ig) = 0.
+      ENDDO
+
+!-----------------------------------------------------------------------
+!     Atmospheric condensation
+
+
+!     Compute CO2 Volume mixing ratio
+!     -------------------------------
+!      if (addn2) then
+!         DO l=1,nlayer
+!            DO ig=1,ngrid
+!              qco2=pq(ig,l,ico2)+pdq(ig,l,ico2)*ptimestep
+!!             Mean air molecular mass = 1/(q(ico2)/m_co2 + (1-q(ico2))/m_noco2)
+!              mmean=1/(A*qco2 +B)
+!              vmr_co2(ig,l) = qco2*mmean/m_co2 
+!            ENDDO
+!         ENDDO
+!      else
+!         DO l=1,nlayer
+!            DO ig=1,ngrid
+!              vmr_co2(ig,l)=0.5
+!            ENDDO
+!         ENDDO
+!      end if
+
+!     Forecast the atmospheric frost temperature 'ztcond' and nucleation temperature 'ztnuc'
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            ppco2=gfrac(igas_CO2)*pplay(ig,l)
+            call get_tcond_co2(ppco2,ztcond(ig,l))
+            call get_tnuc_co2(ppco2,ztnuc(ig,l))
+         ENDDO
+      ENDDO
+      
+!     Initialize zq and zt at the beginning of the sub-timestep loop
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zt(ig,l)=pt(ig,l)
+            zq(ig,l,i_co2ice)=pq(ig,l,i_co2ice)
+            IF( zq(ig,l,i_co2ice).lt.-1.e-6 ) THEN
+               print*,'Uh-oh, zq = ',zq(ig,l,i_co2ice),'at ig,l=',ig,l
+               if(l.eq.1)then
+                  print*,'Perhaps the atmosphere is collapsing on surface...?'
+               endif
+            END IF
+         ENDDO
+      ENDDO
+
+!     Calculate the mass of each atmospheric layer (kg.m-2)
+      do  ilay=1,nlayer
+         DO ig=1,ngrid
+            masse(ig,ilay)=(pplev(ig,ilay) - pplev(ig,ilay+1)) /g
+         end do
+      end do
+
+!     -----------------------------------------------
+!     START CONDENSATION/SEDIMENTATION SUB-TIME LOOP
+!     -----------------------------------------------
+      Ntime =  20               ! number of sub-timestep 
+      subptimestep = ptimestep/float(Ntime)           
+
+      DO it=1,Ntime
+
+!     Add the tendencies from other physical processes at each subtimstep
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               zt(ig,l)   = zt(ig,l)   + pdt(ig,l)   * subptimestep
+               zq(ig,l,i_co2ice) = zq(ig,l,i_co2ice) + pdq(ig,l,i_co2ice) * subptimestep
+            END DO
+         END DO
+
+
+!     Gravitational sedimentation
+            
+!     sedimentation computed from radius computed from q in module radii_mod
+	 call co2_reffrad(ngrid,nq,zq,reffrad)
+	 
+         do  ilay=1,nlayer
+            DO ig=1,ngrid
+
+               reff = reffrad(ig,ilay)
+
+               call stokes                      &
+                   (pplev(ig,ilay),pt(ig,ilay), &
+                    reff,vstokes,rho_co2)
+
+               !w(ig,ilay,i_co2ice) = 0.0
+               w(ig,ilay,i_co2ice) = vstokes *  subptimestep * &
+                   pplev(ig,ilay)/(r*pt(ig,ilay))
+
+            end do
+         end do
+
+!     Computing q after sedimentation
+
+         call vlz_fi(ngrid,zq(1,1,i_co2ice),2.,masse,w(1,1,i_co2ice),wq)
+
+
+!     Progressively accumulating the flux to the ground
+!     Mfallice is the total amount of ice fallen to the ground
+         DO ig=1,ngrid
+            Mfallice(ig) =  Mfallice(ig) + wq(ig,i_co2ice)
+         end do
+
+
+!     Condensation / sublimation in the atmosphere
+!     --------------------------------------------
+!     (calculation of zcondicea, zfallice and pdtc)
+!     (MODIFICATIONS FOR EARLY MARS: falling heat neglected, condensation
+!     of CO2 into tracer i_co2ice)
+
+         DO l=nlayer , 1, -1
+            DO ig=1,ngrid
+               pdtc(ig,l)=0.
+
+
+   !     ztcond-> ztnuc in test beneath to nucleate only when super saturation occurs(JL 2011)
+               IF ((zt(ig,l).LT.ztnuc(ig,l)).or.(zq(ig,l,i_co2ice).gt.1.E-10)) THEN 
+                  condsub(ig)=.true.
+                  pdtc(ig,l)   = (ztcond(ig,l) - zt(ig,l))/subptimestep
+                  pdqc(ig,l,i_co2ice) = pdtc(ig,l)*ccond*g
+
+!     Case when the ice from above sublimes entirely
+                  IF ((zq(ig,l,i_co2ice).lt.-pdqc(ig,l,i_co2ice)*subptimestep) &
+                      .AND. (zq(ig,l,i_co2ice).gt.0)) THEN
+
+                     pdqc(ig,l,i_co2ice) = -zq(ig,l,i_co2ice)/subptimestep
+                     pdtc(ig,l)   =-zq(ig,l,i_co2ice)/(ccond*g*subptimestep)
+
+                  END IF
+
+!     Temperature and q after condensation
+                  zt(ig,l)   = zt(ig,l)   + pdtc(ig,l)   * subptimestep
+                  zq(ig,l,i_co2ice) = zq(ig,l,i_co2ice) + pdqc(ig,l,i_co2ice) * subptimestep
+               END IF
+
+            ENDDO
+         ENDDO
+      ENDDO                     ! end of subtimestep loop
+
+!     Computing global tendencies after the subtimestep
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            pdtc(ig,l) = &
+              (zt(ig,l) - (pt(ig,l) + pdt(ig,l)*ptimestep))/ptimestep
+            pdqc(ig,l,i_co2ice) = &
+              (zq(ig,l,i_co2ice)-(pq(ig,l,i_co2ice)+pdq(ig,l,i_co2ice)*ptimestep))/ptimestep
+         END DO
+      END DO
+      DO ig=1,ngrid
+         zfallice(ig) = Mfallice(ig)/ptimestep
+      END DO
+
+
+!-----------------------------------------------------------------------
+!     Condensation/sublimation on the ground
+!     (calculation of zcondices and pdtsrfc)
+
+!     forecast of ground temperature ztsrf and frost temperature ztcondsol
+      DO ig=1,ngrid
+         ppco2=gfrac(igas_CO2)*pplay(ig,1)
+         call get_tcond_co2(ppco2,ztcondsol(ig))
+         
+         ztsrf(ig) = ptsrf(ig)
+
+         if((ztsrf(ig).le.ztcondsol(ig)+2.0).and.(ngrid.eq.1))then
+            print*,'CO2 is condensing on the surface in 1D. This atmosphere is doomed.'
+            print*,'T_surf = ',ztsrf,'K'
+            print*,'T_cond = ',ztcondsol,'K'
+            open(116,file='surf_vals.out')
+            write(116,*) 0.0, pplev(1,1), 0.0, 0.0
+            close(116)
+            call abort
+         endif
+
+         ztsrf(ig) = ptsrf(ig) + pdtsrf(ig)*ptimestep
+
+      ENDDO
+     
+      DO ig=1,ngrid
+         IF(ig.GT.ngrid/2+1) THEN
+            icap=2
+         ELSE
+            icap=1
+         ENDIF
+
+!     Loop over where we have condensation / sublimation
+         IF ((ztsrf(ig) .LT. ztcondsol(ig)) .OR.           &        ! ground condensation
+                    (zfallice(ig).NE.0.) .OR.              &        ! falling snow
+                    ((ztsrf(ig) .GT. ztcondsol(ig)) .AND.  &        ! ground sublimation
+                    ((piceco2(ig)+zfallice(ig)*ptimestep) .NE. 0.))) THEN
+            condsub(ig) = .true.
+
+!     Condensation or partial sublimation of CO2 ice
+            zcondices(ig)=pcapcal(ig)*(ztcondsol(ig)-ztsrf(ig)) &
+                /(latcond*ptimestep)         
+            pdtsrfc(ig) = (ztcondsol(ig) - ztsrf(ig))/ptimestep
+
+!     If the entire CO_2 ice layer sublimes
+!     (including what has just condensed in the atmosphere)
+            IF((piceco2(ig)/ptimestep+zfallice(ig)).LE. &
+                -zcondices(ig))THEN
+               zcondices(ig) = -piceco2(ig)/ptimestep - zfallice(ig)
+               pdtsrfc(ig)=(latcond/pcapcal(ig))*       &
+                   (zcondices(ig))
+            END IF
+
+!     Changing CO2 ice amount and pressure
+
+            zdiceco2(ig) = zcondices(ig) + zfallice(ig)
+            piceco2(ig)  = piceco2(ig) + zdiceco2(ig)*ptimestep
+            pdpsrf(ig)   = -zdiceco2(ig)*g
+
+            IF(ABS(pdpsrf(ig)*ptimestep).GT.pplev(ig,1)) THEN
+               PRINT*,'STOP in condens'
+               PRINT*,'condensing more than total mass'
+               PRINT*,'Grid point ',ig
+               PRINT*,'Ps = ',pplev(ig,1)
+               PRINT*,'d Ps = ',pdpsrf(ig)
+               STOP
+            ENDIF
+         END IF
+      ENDDO
+
+!     Surface albedo and emissivity of the ground below the snow (emisref)
+!     --------------------------------------------------------------------
+      DO ig=1,ngrid
+         IF(lati(ig).LT.0.) THEN
+            icap=2 ! Southern Hemisphere
+         ELSE
+            icap=1 ! Nortnern hemisphere
+         ENDIF
+
+         if(.not.piceco2(ig).ge.0.) THEN
+            if(piceco2(ig).le.-1.e-8) print*,   &
+                'WARNING in condense_co2cloud: piceco2(',ig,')=', piceco2(ig)
+            piceco2(ig)=0.
+         endif
+         if (piceco2(ig).gt.0) then
+            psolaralb(ig) = albedice(icap)
+            emisref(ig)   = emisice(icap)
+         else
+            psolaralb(ig) = albedodat(ig)
+            emisref(ig)   = emissiv
+            pemisurf(ig)  = emissiv
+         end if
+      end do
+
+      return
+    end subroutine condense_cloud
+
+!-------------------------------------------------------------------------
+    subroutine get_tcond_co2(p,tcond)
+!   Calculates the condensation temperature for CO2
+
+      implicit none
+
+#include "callkeys.h"
+
+      real p, peff, tcond
+      real, parameter :: ptriple=518000.0
+
+      peff=p
+
+      if(peff.lt.ptriple)then
+         tcond = (-3167.8)/(log(.01*peff)-23.23) ! Fanale's formula
+      else
+         tcond = 684.2-92.3*log(peff)+4.32*log(peff)**2 
+         ! liquid-vapour transition (based on CRC handbook 2003 data)
+      endif
+      return
+
+    end subroutine get_tcond_co2
+    
+    
+    
+ 
+!-------------------------------------------------------------------------
+    subroutine get_tnuc_co2(p,tnuc)
+!   Calculates the nucleation temperature for CO2, based on a simple super saturation criterion 
+!     (JL 2011)
+
+      implicit none
+
+#include "callkeys.h"
+
+      real p, peff, tnuc
+      real, parameter :: ptriple=518000.0
+
+      peff=p/co2supsat
+
+      if(peff.lt.ptriple)then
+         tnuc = (-3167.8)/(log(.01*peff)-23.23) ! Fanale's formula
+      else
+         tnuc = 684.2-92.3*log(peff)+4.32*log(peff)**2 
+         ! liquid-vapour transition (based on CRC handbook 2003 data)
+      endif
+      return
+
+    end subroutine get_tnuc_co2
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/convadj.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/convadj.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/convadj.F	(revision 222)
@@ -0,0 +1,418 @@
+      subroutine convadj(ngrid,nlay,nq,ptimestep,
+     &                   pplay,pplev,ppopsk,
+     &                   pu,pv,ph,pq,
+     &                   pdufi,pdvfi,pdhfi,pdqfi,
+     &                   pduadj,pdvadj,pdhadj,
+     &                   pdqadj)
+
+      USE tracer_h
+
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates dry convective adjustment. If one tracer is CO2,
+!     we take into account the molecular mass variation (e.g. when
+!     CO2 condenses) to trigger convection (F. Forget 01/2005)
+!
+!     Authors
+!     -------
+!     Original author unknown.
+!     Modif. 2005 by F. Forget.
+!     
+!==================================================================
+
+!     ------------
+!     Declarations
+!     ------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+!     Arguments
+!     ---------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL ph(ngrid,nlay),pdhfi(ngrid,nlay),pdhadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1),ppopsk(ngrid,nlay)
+      REAL pu(ngrid,nlay),pdufi(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvfi(ngrid,nlay),pdvadj(ngrid,nlay)
+
+!     Tracers
+      integer nq
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq)
+      real pdqadj(ngrid,nlay,nq)
+
+
+!     Local
+!     -----
+
+      INTEGER ig,i,l,l1,l2,jj
+      INTEGER jcnt, jadrs(ngrid)
+
+      REAL sig(nlayermx+1),sdsig(nlayermx),dsig(nlayermx)
+      REAL zu(ngrid,nlayermx),zv(ngrid,nlayermx)
+      REAL zh(ngrid,nlayermx)
+      REAL zu2(ngrid,nlayermx),zv2(ngrid,nlayermx)
+      REAL zh2(ngrid,nlayermx), zhc(ngrid,nlayermx)
+      REAL zhm,zsm,zdsm,zum,zvm,zalpha,zhmc
+
+!     Tracers
+      INTEGER iq,ico2
+      save ico2
+      REAL zq(ngrid,nlayermx,nq), zq2(ngrid,nlayermx,nq)
+      REAL zqm(nq),zqco2m
+      real m_co2, m_noco2, A , B
+      save A, B
+
+      real mtot1, mtot2 , mm1, mm2
+       integer l1ref, l2ref
+      LOGICAL vtest(ngrid),down,firstcall
+      save firstcall
+      data firstcall/.true./
+
+!     for conservation test
+      real masse,cadjncons
+
+      EXTERNAL SCOPY
+
+!     --------------
+!     Initialisation
+!     --------------
+
+      IF (firstcall) THEN 
+        ico2=0
+        if (tracer) then
+!     Prepare Special treatment if one of the tracers is CO2 gas
+           do iq=1,nq
+             if (noms(iq).eq."co2") then
+                print*,'dont go there'
+                stop
+                ico2=iq
+                m_co2 = 44.01E-3  ! CO2 molecular mass (kg/mol)   
+                m_noco2 = 33.37E-3  ! Non condensible mol mass (kg/mol)   
+!               Compute A and B coefficient use to compute
+!               mean molecular mass Mair defined by
+!               1/Mair = q(ico2)/m_co2 + (1-q(ico2))/m_noco2
+!               1/Mair = A*q(ico2) + B
+                A =(1/m_co2 - 1/m_noco2)
+                B=1/m_noco2
+             end if
+           enddo
+        endif
+        firstcall=.false.
+      ENDIF ! of IF (firstcall)
+
+      DO l=1,nlay
+         DO ig=1,ngrid
+            zh(ig,l)=ph(ig,l)+pdhfi(ig,l)*ptimestep
+            zu(ig,l)=pu(ig,l)+pdufi(ig,l)*ptimestep
+            zv(ig,l)=pv(ig,l)+pdvfi(ig,l)*ptimestep
+         ENDDO
+      ENDDO
+
+      if(tracer) then      
+        DO iq =1, nq
+         DO l=1,nlay
+           DO ig=1,ngrid
+              zq(ig,l,iq)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+      CALL scopy(ngrid*nlay,zh,1,zh2,1)
+      CALL scopy(ngrid*nlay,zu,1,zu2,1)
+      CALL scopy(ngrid*nlay,zv,1,zv2,1)
+      CALL scopy(ngrid*nlay*nq,zq,1,zq2,1)
+
+!     -----------------------------
+!     Detection of unstable columns
+!     -----------------------------
+!     If ph(above) < ph(below) we set vtest=.true.
+
+      DO ig=1,ngrid
+        vtest(ig)=.false.
+      ENDDO
+
+      if (ico2.ne.0) then
+!     Special case if one of the tracers is CO2 gas
+         DO l=1,nlay
+           DO ig=1,ngrid
+             zhc(ig,l) = zh2(ig,l)*(A*zq2(ig,l,ico2)+B)
+           ENDDO
+         ENDDO
+       else
+          CALL scopy(ngrid*nlay,zh2,1,zhc,1)
+       end if
+
+!     Find out which grid points are convectively unstable
+      DO l=2,nlay
+        DO ig=1,ngrid
+          IF(zhc(ig,l).LT.zhc(ig,l-1)) vtest(ig)=.true.
+        ENDDO
+      ENDDO
+
+!     Make a list of them
+      jcnt=0
+      DO ig=1,ngrid
+         IF(vtest(ig)) THEN
+            jcnt=jcnt+1
+            jadrs(jcnt)=ig
+         ENDIF
+      ENDDO
+
+
+!     ---------------------------------------------------------------
+!     Adjustment of the "jcnt" unstable profiles indicated by "jadrs"
+!     ---------------------------------------------------------------
+
+      DO jj = 1, jcnt   ! loop on every convective grid point
+
+          i = jadrs(jj)
+ 
+!     Calculate sigma in this column
+          DO l=1,nlay+1
+            sig(l)=pplev(i,l)/pplev(i,1)
+        
+          ENDDO
+         DO l=1,nlay
+            dsig(l)=sig(l)-sig(l+1)
+            sdsig(l)=ppopsk(i,l)*dsig(l)
+         ENDDO
+          l2 = 1
+
+!     Test loop upwards on l2
+
+          DO
+            l2 = l2 + 1
+            IF (l2 .GT. nlay) EXIT
+            IF (zhc(i, l2) .LT. zhc(i, l2-1)) THEN
+ 
+!     l2 is the highest level of the unstable column
+ 
+              l1 = l2 - 1
+              l  = l1
+              zsm = sdsig(l2)
+              zdsm = dsig(l2)
+              zhm = zh2(i, l2)
+              if(ico2.ne.0) zqco2m = zq2(i,l2,ico2)
+
+!     Test loop downwards
+
+              DO
+                zsm = zsm + sdsig(l)
+                zdsm = zdsm + dsig(l)
+                zhm = zhm + sdsig(l) * (zh2(i, l) - zhm) / zsm
+                if(ico2.ne.0) then
+                  zqco2m = 
+     &            zqco2m + dsig(l) * (zq2(i,l,ico2) - zqco2m) / zdsm
+                  zhmc = zhm*(A*zqco2m+B)
+                else 
+                  zhmc = zhm
+                end if
+ 
+!     do we have to extend the column downwards?
+ 
+                down = .false.
+                IF (l1 .ne. 1) then    !--  and then
+                  IF (zhmc .lt. zhc(i, l1-1)) then
+                    down = .true.
+                  END IF
+                END IF
+ 
+                ! this could be a problem...
+
+                if (down) then
+ 
+                  l1 = l1 - 1
+                  l  = l1
+ 
+                else
+ 
+!     can we extend the column upwards?
+ 
+                  if (l2 .eq. nlay) exit
+ 
+                  if (zhc(i, l2+1) .ge. zhmc) exit
+
+                  l2 = l2 + 1
+                  l  = l2
+
+                end if
+
+              enddo
+
+!     New constant profile (average value)
+
+
+              zalpha=0.
+              zum=0.
+              zvm=0.
+              do iq=1,nq
+                zqm(iq) = 0.
+              end do
+              DO l = l1, l2
+                if(ico2.ne.0) then
+                  zalpha=zalpha+
+     &            ABS(zhc(i,l)/(A+B*zqco2m) -zhm)*dsig(l)
+                else
+                  zalpha=zalpha+ABS(zh2(i,l)-zhm)*dsig(l)
+                endif
+                zh2(i, l) = zhm
+!     modifs by RDW !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+                zum=zum+dsig(l)*zu2(i,l)
+                zvm=zvm+dsig(l)*zv2(i,l)
+!                zum=zum+dsig(l)*zu(i,l)
+!                zvm=zvm+dsig(l)*zv(i,l)
+                do iq=1,nq
+                   zqm(iq) = zqm(iq)+dsig(l)*zq2(i,l,iq)
+!                   zqm(iq) = zqm(iq)+dsig(l)*zq(i,l,iq)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!     to conserve tracers/ KE, we must calculate zum, zvm and zqm using 
+!     the up-to-date column values. If we do not do this, there are cases 
+!     where convection stops at one level and starts at the next where we
+!     can break conservation of stuff (particularly tracers) significantly.
+
+                end do
+              ENDDO
+              zalpha=zalpha/(zhm*(sig(l1)-sig(l2+1)))
+              zum=zum/(sig(l1)-sig(l2+1))
+              zvm=zvm/(sig(l1)-sig(l2+1))
+              do iq=1,nq
+                 zqm(iq) = zqm(iq)/(sig(l1)-sig(l2+1))
+              end do
+
+              IF(zalpha.GT.1.) THEN
+                 zalpha=1.
+              ELSE
+!                IF(zalpha.LT.0.) STOP
+                 IF(zalpha.LT.1.e-4) zalpha=1.e-4
+              ENDIF
+
+              DO l=l1,l2
+                 zu2(i,l)=zu2(i,l)+zalpha*(zum-zu2(i,l))
+                 zv2(i,l)=zv2(i,l)+zalpha*(zvm-zv2(i,l))
+                 do iq=1,nq
+!                  zq2(i,l,iq)=zq2(i,l,iq)+zalpha*(zqm(iq)-zq2(i,l,iq)) 
+                   zq2(i,l,iq)=zqm(iq)
+                 end do
+              ENDDO
+              if (ico2.ne.0) then
+                DO l=l1, l2
+                  zhc(i,l) = zh2(i,l)*(A*zq2(i,l,ico2)+B)
+                ENDDO
+              end if
+
+
+              l2 = l2 + 1
+
+            END IF   ! End of l1 to l2 instability treatment
+                     ! We now continue to test from l2 upwards
+
+          ENDDO   ! End of upwards loop on l2
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!     check conservation
+         cadjncons=0.0
+         if(water)then
+         do l = 1, nlay
+            masse = (pplev(i,l) - pplev(i,l+1))/g
+            iq    = igcm_h2o_vap
+            cadjncons = cadjncons + 
+     &           masse*(zq2(i,l,iq)-zq(i,l,iq))/ptimestep 
+         end do
+         endif
+
+         if(cadjncons.lt.-1.e-6)then
+            print*,'convadj has just crashed...'
+            print*,'i  = ',i
+            print*,'l1 = ',l1
+            print*,'l2 = ',l2
+            print*,'cadjncons        = ',cadjncons
+         do l = 1, nlay
+            print*,'dsig         = ',dsig(l)
+         end do         
+         do l = 1, nlay
+            print*,'dsig         = ',dsig(l)
+         end do
+         do l = 1, nlay
+            print*,'sig         = ',sig(l)
+         end do
+         do l = 1, nlay
+            print*,'pplay(ig,:)         = ',pplay(i,l)
+         end do
+         do l = 1, nlay+1
+            print*,'pplev(ig,:)         = ',pplev(i,l)
+         end do
+         do l = 1, nlay
+            print*,'ph(ig,:)         = ',ph(i,l)
+         end do
+         do l = 1, nlay
+            print*,'ph(ig,:)         = ',ph(i,l)
+         end do
+         do l = 1, nlay
+            print*,'ph(ig,:)         = ',ph(i,l)
+         end do
+         do l = 1, nlay
+            print*,'zh(ig,:)         = ',zh(i,l)
+         end do
+         do l = 1, nlay
+            print*,'zh2(ig,:)        = ',zh2(i,l)
+         end do
+         do l = 1, nlay
+            print*,'zq(ig,:,vap)     = ',zq(i,l,igcm_h2o_vap)
+         end do
+         do l = 1, nlay
+            print*,'zq2(ig,:,vap)    = ',zq2(i,l,igcm_h2o_vap)
+         end do
+            print*,'zqm(vap)         = ',zqm(igcm_h2o_vap)
+            print*,'jadrs=',jadrs
+
+            call abort
+         endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      ENDDO
+
+      DO l=1,nlay
+        DO ig=1,ngrid
+          pdhadj(ig,l)=(zh2(ig,l)-zh(ig,l))/ptimestep
+          pduadj(ig,l)=(zu2(ig,l)-zu(ig,l))/ptimestep
+          pdvadj(ig,l)=(zv2(ig,l)-zv(ig,l))/ptimestep
+        ENDDO
+      ENDDO
+
+      if(tracer) then 
+        do iq=1, nq
+          do  l=1,nlay
+            DO ig=1,ngrid
+              pdqadj(ig,l,iq)=(zq2(ig,l,iq)-zq(ig,l,iq))/ptimestep 
+            end do 
+          end do 
+        end do 
+      end if
+
+
+!     output
+!      if (ngrid.eq.1) then
+!         ig=1
+!         iq =1 
+!         write(*,*)'**** l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)'  
+!         do l=nlay,1,-1
+!           write(*,*) l, pq(ig,l,iq),zq(ig,l,iq),zq2(ig,l,iq)
+!         end do
+!      end if
+
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cp_neutral.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cp_neutral.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cp_neutral.F90	(revision 222)
@@ -0,0 +1,37 @@
+double precision function cp_neutral(T)
+
+  use gases_h
+
+  implicit none
+
+  ! inputs
+  double precision T
+
+
+  ! this function has been disabled in gradients_kcm.F90 because it doesnt
+  ! work if you have gaseous mixtures. need to decide whether to generalise
+  ! it or simply remove entirely...
+
+  ! Cp_n : cf CO2 dans abe&matsui (1988)
+  !cp_neutral = (22.26+5.981d-2*T-3.501d-5*T**2+7.469d-9*T**3)/m_n
+
+  if(trim(gnom(1)).eq.'N2_')then
+     cp_neutral = 1040.0
+  elseif(trim(gnom(1)).eq.'H2_')then
+     cp_neutral = 14310.0
+  else
+     print*,'Gas not recognised in cp_neutral!'
+     call abort
+  endif
+
+  
+end function cp_neutral
+
+
+
+
+
+
+
+
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cpdet.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cpdet.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cpdet.F	(revision 222)
@@ -0,0 +1,123 @@
+! ADAPTATION GCM POUR CP(T)
+c======================================================================
+c S. Lebonnois, 10/2007:
+c
+c VENUS: Cp(T) = cpp*(T/T0)^nu 
+c avec T0=460. et nu=0.35
+c cpp=RCPD=cp0 = 1000.
+c R/RCPD = RKAPPA
+c
+c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
+c 
+c T et teta (temperature potentielle) sont liees par:
+c 
+c   integrale[teta a T](cp/T dT) = integrale[pref a p](R/p dp)
+c
+c Dans le cas de l'expression pour Venus, ca donne:
+c
+c   teta**nu = T**nu - nu * T0**nu * ln[ (p/pref)**RKAPPA ]
+c ou
+c   teta**nu = T**nu - nu * T0**nu * ln[pk/RCPD]
+c
+c On passe de T a teta par t2tpot(t,teta,pk)
+c On passe de teta a T par tpot2t(teta,t,pk)
+c
+c Pour DT <-> Dteta, on utilise: dteta = dT *(T/teta)**(nu-1)
+c -> routine dt2dtpot(dt,dteta,t,teta) 
+c (utilisee seulement pour le contregradient)
+c
+c======================================================================
+
+      FUNCTION cpdet(t)
+      IMPLICIT none
+#include "cpdet.h"
+
+      real cpdet,t
+
+      cpdet = cp0*(t/t0)**nu
+
+      return
+      end
+      
+c======================================================================
+c======================================================================
+
+      SUBROUTINE t2tpot(npoints,yt, yteta, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yt   --------input-R- Temperature
+c yteta-------output-R- Temperature potentielle
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+      
+      yteta = yt**nu - nu * t0**nu * log(ypk/cp0)
+      yteta = yteta**(1./nu)
+        
+
+      !yteta = yt/ypk
+
+
+      return
+      end
+
+c======================================================================
+c======================================================================
+
+      SUBROUTINE tpot2t(npoints,yteta, yt, ypk)
+      IMPLICIT none
+c======================================================================
+c Arguments:
+c
+c yteta--------input-R- Temperature potentielle
+c yt   -------output-R- Temperature
+c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c
+c======================================================================
+#include "cpdet.h"
+
+      integer npoints
+      REAL yt(npoints), yteta(npoints), ypk(npoints)
+
+      yt = yteta**nu + nu * t0**nu * log(ypk/cp0)
+      yt = yt**(1./nu)
+
+      !yt = yteta*ypk
+
+      return
+      end
+
+c$$$c======================================================================
+c$$$c======================================================================
+c$$$
+c$$$      SUBROUTINE dt2dtpot(npoints,ydt, ydteta, yt, yteta, ypk, ydpk)
+c$$$      IMPLICIT none
+c$$$c======================================================================
+c$$$c Arguments:
+c$$$c
+c$$$c ydt  --------input-R- D Temperature
+c$$$c ydteta------output-R- D Temperature potentielle
+c$$$c yt   --------input-R- Temperature
+c$$$c yteta--------input-R- Temperature potentielle
+c$$$c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
+c$$$c ydpk  -------input-R- D Fonction d'Exner
+c$$$c
+c$$$c======================================================================
+c$$$#include "cpdet.h"
+c$$$
+c$$$      integer npoints
+c$$$      REAL    ydt(npoints), ydteta(npoints), ydpk(npoints)
+c$$$      REAL    yt(npoints), yteta(npoints), ypk(npoints)
+c$$$      
+c$$$      ydteta =  yteta**(1.-nu)* (ydt * yt**(nu-1.) 
+c$$$     .                           - t0**nu * ydpk / ypk)
+c$$$        
+c$$$      return
+c$$$      end
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cpdet.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cpdet.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cpdet.h	(revision 222)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+! INCLUDE cpdet.h
+
+      real cp0,t0,nu
+!      parameter (cp0 = 1000.) !doit etre egal a cpp (dyn) et RCPD (phy)
+      parameter (cp0 = 800.) !doit etre egal a cpp (dyn) et RCPD (phy)
+!      parameter (t0  = 460.)
+      parameter (t0  = 480.)
+!      parameter (t0  = 300.)
+      parameter (nu  = 0.35)
+!      parameter (nu  = 1.0)
+!-----------------------------------------------------------------------
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cvmgp.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cvmgp.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cvmgp.F	(revision 222)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cvmgt.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cvmgt.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/cvmgt.F	(revision 222)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/datafile_mod.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/datafile_mod.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/datafile_mod.F90	(revision 222)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+      module datafile_mod
+!  Address of the directory containing tables of data needed by the UCM
+      implicit none
+
+      ! Default for Berserker @ UChicago:
+!      character(len=300) :: datadir='/home/rwordsworth/datagcm'
+      ! Default for Gnome Idataplex:
+!      character(len=300) :: datadir='/san/home/rdword/gcm/datagcm'
+      ! Default for LMD machines:
+      character(len=300) :: datadir='/u/rwlmd/datagcm'
+
+      end module datafile_mod
+!-----------------------------------------------------------------------
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/datareadnc.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/datareadnc.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/datareadnc.F	(revision 222)
@@ -0,0 +1,287 @@
+c=======================================================================
+      SUBROUTINE datareadnc(relief,filename,phisinit,alb,ith,
+     .                    zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c
+c
+c   Author: F. Hourdin      01/1997
+c   -------
+c
+c   Object: To read data from Martian surface to use in a GCM
+c   ------                from NetCDF file "surface.nc"
+c
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c     Outputs:
+c     --------
+c
+c=======================================================================
+c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
+c
+c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
+c
+c   360 valeurs en longitude (de -179.5 a 179.5)
+c   180 valeurs en latitudes (de 89.5 a -89.5)
+c
+c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
+c
+c   Il faut donc que ces donnees soient au format grille scalaire
+c               (imold+1 jmold+1)
+c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
+c
+c   On prend imd (d pour donnees!) 
+c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
+c                   (rlonud de -179 a -181)
+c           jmd = 179 
+c                   (rlatvd de 89 a -89)
+c=======================================================================
+
+      use datafile_mod, only: datadir
+! to use  'getin'
+      USE ioipsl_getincom 
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comconst.h"
+#include "netcdf.inc"
+
+c=======================================================================
+c   Declarations:
+C=======================================================================
+
+      INTEGER    imd,jmd,imdp1,jmdp1
+      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
+
+      INTEGER    iimp1
+      parameter    (iimp1=iim+1-1/iim)
+
+      character(len=3),intent(inout) :: relief*3
+      character(len=*),intent(in) :: filename ! surface.nc file
+      real,intent(out) :: phisinit(iimp1*jjp1) ! surface geopotential
+      real,intent(out) :: alb(iimp1*jjp1) ! albedo
+      real,intent(out) :: ith(iimp1*jjp1) ! thermal inertia
+      real,intent(out) :: zmea(imdp1*jmdp1)
+      real,intent(out) :: zstd(imdp1*jmdp1)
+      real,intent(out) :: zsig(imdp1*jmdp1)
+      real,intent(out) :: zgam(imdp1*jmdp1)
+      real,intent(out) :: zthe(imdp1*jmdp1)
+      
+      REAL        zdata(imd*jmdp1)
+      REAL        zdataS(imdp1*jmdp1)
+      REAL        pfield(iimp1*jjp1)
+
+      INTEGER   ierr
+
+      INTEGER   unit,nvarid
+
+      INTEGER    i,j,k
+
+      INTEGER klatdat,ngridmixgdat
+      PARAMETER (klatdat=180,ngridmixgdat=360)
+
+c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
+
+      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
+      REAL rlonud(imdp1),rlatvd(jmd)
+
+      CHARACTER*20 string
+      DIMENSION string(4)
+
+#include "fxyprim.h"
+
+      pi=2.*ASIN(1.)
+
+c=======================================================================
+c    rlonud, rlatvd
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF des donnees latitude et longitude
+c-----------------------------------------------------------------------
+      ierr = NF_OPEN (trim(datadir)//'/'//trim(adjustl(filename)),
+     &  NF_NOWRITE,unit)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(*,*)'Error : cannot open file '//trim(filename)
+        write(*,*)'(in phystd/datareadnc.F)'
+        write(*,*)'It should be in :',trim(datadir),'/'
+        write(*,*)'Check that your path to datagcm:',trim(datadir)
+        write(*,*)' is correct. You can change it in callphys.def with:'
+        write(*,*)' datadir = /absolute/path/to/datagcm'
+        write(*,*)'If necessary surface.nc (and other datafiles)'
+        write(*,*)' can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        STOP
+      ENDIF
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
+#endif
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
+#endif
+
+c-----------------------------------------------------------------------
+c    Passage au format boites scalaires
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c       longitude(imd)        -->      rlonud(imdp1) 
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do i=1,imd 
+          rlonud(i)=(longitude(i)+.5)*pi/180.
+      enddo
+
+c Repetition de la valeur im+1
+      rlonud(imdp1)=rlonud(1) + 2*pi
+
+c-----------------------------------------------------------------------
+c        latitude(jmdp1)         -->        rlonvd(jmd)
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do j=1,jmd 
+          rlatvd(j)=(latitude(j)-.5)*pi/180.
+      enddo
+
+c=======================================================================
+c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
+c=======================================================================
+
+      string(1) = 'albedo'
+      string(2) = 'thermal'
+      if (relief.ne.'pla') then
+        write(*,*) ' La topographie est celle de MOLA'
+        relief = 'MOL'
+          string(3) = 'z'//relief
+      else
+          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
+                            ! remise a 0 derriere
+      endif
+      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
+ 
+
+      DO k=1,4
+          write(*,*) 'string',k,string(k)
+          
+c-----------------------------------------------------------------------
+c    initialisation
+c-----------------------------------------------------------------------
+      call initial0(iimp1*jjp1,pfield)
+      call initial0(imd*jmdp1,zdata)
+      call initial0(imdp1*jmdp1,zdataS)
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF  
+c-----------------------------------------------------------------------
+
+      ierr = NF_INQ_VARID (unit, string(k), nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
+#endif
+
+c-----------------------------------------------------------------------
+c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
+c-----------------------------------------------------------------------
+      if (k.eq.4) then
+
+          call multscal(imd*jmdp1,zdata,1000.,zdata)
+          call multscal(imd,longitude,pi/180.,longitude)
+          call multscal(jmdp1,latitude,pi/180.,latitude)
+
+          call grid_noro1(360, 180, longitude, latitude, zdata,
+     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
+
+          !CALL dump2d(iip1,jjp1,zmea,'zmea')
+          !CALL dump2d(iip1,jjp1,zstd,'zstd')
+          !CALL dump2d(iip1,jjp1,zsig,'zsig')
+          !CALL dump2d(iip1,jjp1,zgam,'zgam')
+          !CALL dump2d(iip1,jjp1,zthe,'zthe')
+
+      endif
+
+c-----------------------------------------------------------------------
+c   Passage de zdata en grille (imdp1 jmdp1)
+c-----------------------------------------------------------------------
+      do j=1,jmdp1
+          do i=1,imd
+              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmixgdat*(j-1))
+          enddo
+          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmixgdat*(j-1))
+      enddo
+
+c-----------------------------------------------------------------------
+c    Interpolation
+c-----------------------------------------------------------------------
+      call interp_horiz(zdataS,pfield,imd,jmd,
+     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
+
+c-----------------------------------------------------------------------
+c    Periodicite    
+c-----------------------------------------------------------------------
+
+      do j=1,jjp1
+         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
+      enddo 
+ 
+c-----------------------------------------------------------------------
+c    Sauvegarde des champs    
+c-----------------------------------------------------------------------
+
+      if (k.eq.1) then                    ! albedo
+         do i=1,iimp1*jjp1
+              alb(i) = pfield(i)
+          enddo
+      elseif (k.eq.2) then                ! thermal
+         do i=1,iimp1*jjp1
+              ith(i) = pfield(i)
+          enddo
+      elseif (k.eq.3) then                ! relief
+        if (relief.eq.'pla') then
+              call initial0(iimp1*jjp1,phisinit)
+        else
+             do i=1,iimp1*jjp1
+                  phisinit(i) = pfield(i)
+              enddo
+        endif
+      endif
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    Traitement Phisinit
+c-----------------------------------------------------------------------
+
+      DO i=1,iimp1*jjp1
+            phisinit(i)=1000.*phisinit(i)
+      ENDDO
+      !CALL dump2d(iimp1,jjp1,phisinit,'Altitude en m')
+      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)
+
+c-----------------------------------------------------------------------
+c    FIN
+c-----------------------------------------------------------------------
+
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/def_var.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/def_var.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/def_var.F90	(revision 222)
@@ -0,0 +1,64 @@
+subroutine def_var(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)
+
+!print*,'in def_var.F90, dimids='
+!print*,dimids
+
+! 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: 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: 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: 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
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dimphy.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dimphy.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dimphy.F90	(revision 222)
@@ -0,0 +1,32 @@
+MODULE dimphy
+  
+  INTEGER,SAVE :: klon   ! number of atmospheric columns (for this OpenMP subgrid)
+  INTEGER,SAVE :: klev   ! number of atmospheric layers
+  INTEGER,SAVE :: klevp1 ! number of atmospheric layers+1
+  INTEGER,SAVE :: klevm1 ! number of atmospheric layers-1
+!  INTEGER,SAVE :: kflev
+
+!$OMP THREADPRIVATE(klon)
+
+CONTAINS
+  
+  SUBROUTINE Init_dimphy(klon0,klev0)
+  IMPLICIT NONE
+  
+    INTEGER, INTENT(in) :: klon0
+    INTEGER, INTENT(in) :: klev0
+    
+    klon=klon0
+    
+!$OMP MASTER 
+    klev=klev0
+    klevp1=klev+1
+    klevm1=klev-1
+!    kflev=klev
+!$OMP END MASTER    
+!$OMP BARRIER
+    
+  END SUBROUTINE Init_dimphy
+
+  
+END MODULE dimphy
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dimphys.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dimphys.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dimphys.h	(revision 222)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimphys.h'
+
+! ngridmx : number of horizontal grid points
+! note: the -1/jjm term will be 0; unless jj=1
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
+! nlayermx : number of atmospheric layers
+      integer, parameter :: nlayermx = llm 
+! nsoilmx : number of subterranean layers ! nsoilmx is now in comsoil_h
+      !integer, parameter :: nsoilmx = 4 ! for a test 
+      !integer, parameter :: nsoilmx = 18 ! for z1=0.0002 m, depth = 18 m => mars case 
+      !integer, parameter :: nsoilmx = 13 ! for z1=0.03 m, depth = 104.8 m => earth case
+!-----------------------------------------------------------------------
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dsolver.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dsolver.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dsolver.F	(revision 222)
@@ -0,0 +1,102 @@
+      SUBROUTINE DSOLVER(NL,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP,
+     *                   BSURF,RSF,XK1,XK2)
+
+C  GCM2.0  Feb 2003
+C
+C DOUBLE PRECISION VERSION OF SOLVER
+
+      PARAMETER (NMAX=201)
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL),
+     *          XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL)
+      DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
+C*********************************************************
+C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE    *
+C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS   *
+C* NO ASSUMPTION OF THE DEPENDENCE ON OPTICAL DEPTH OF   *
+C* C-PLUS OR C-MINUS HAS BEEN MADE.                      *
+C* NL     = NUMBER OF LAYERS IN THE MODEL                *
+C* CP     = C-PLUS EVALUATED AT TAO=0 (TOP)              *
+C* CM     = C-MINUS EVALUATED AT TAO=0 (TOP)             *
+C* CPM1   = C-PLUS  EVALUATED AT TAOSTAR (BOTTOM)        *
+C* CMM1   = C-MINUS EVALUATED AT TAOSTAR (BOTTOM)        *
+C* EP     = EXP(LAMDA*DTAU)                              *
+C* EM     = 1/EP                                         *
+C* E1     = EP + GAMA *EM                                *
+C* E2     = EP - GAMA *EM                                *
+C* E3     = GAMA*EP + EM                                 *
+C* E4     = GAMA*EP - EM                                 *
+C* BTOP   = THE DIFFUSE RADIATION INTO THE MODEL AT TOP  *
+C* BSURF  = THE DIFFUSE RADIATION INTO THE MODEL AT      *
+C*          THE BOTTOM: INCLUDES EMMISION AND REFLECTION *
+C*          OF THE UNATTENUATED PORTION OF THE DIRECT    *
+C*          BEAM. BSTAR+RSF*FO*EXP(-TAOSTAR/U0)          *
+C* RSF    = REFLECTIVITY OF THE SURFACE                  *
+C* XK1    = COEFFICIENT OF THE POSITIVE EXP TERM         *
+C* XK2    = COEFFICIENT OF THE NEGATIVE EXP TERM         *
+C*********************************************************
+
+C======================================================================C
+
+      L=2*NL
+ 
+C     ************MIXED COEFFICENTS**********
+C     THIS VERSION AVOIDS SINGULARITIES ASSOC.
+C     WITH W0=0 BY SOLVING FOR XK1+XK2, AND XK1-XK2.
+
+      AF(1) = 0.0
+      BF(1) = GAMA(1)+1.
+      CF(1) = GAMA(1)-1.
+      DF(1) = BTOP-CMM1(1)
+      N     = 0
+      LM2   = L-2
+
+C     EVEN TERMS
+ 
+      DO I=2,LM2,2
+        N     = N+1
+        AF(I) = (E1(N)+E3(N))*(GAMA(N+1)-1.)       
+        BF(I) = (E2(N)+E4(N))*(GAMA(N+1)-1.)
+        CF(I) = 2.0*(1.-GAMA(N+1)**2)
+        DF(I) = (GAMA(N+1)-1.) * (CPM1(N+1) - CP(N)) +
+     *            (1.-GAMA(N+1))* (CM(N)-CMM1(N+1))
+      END DO
+ 
+      N   = 0
+      LM1 = L-1
+      DO I=3,LM1,2
+        N     = N+1
+        AF(I) = 2.0*(1.-GAMA(N)**2)
+        BF(I) = (E1(N)-E3(N))*(1.+GAMA(N+1))
+        CF(I) = (E1(N)+E3(N))*(GAMA(N+1)-1.)
+        DF(I) = E3(N)*(CPM1(N+1) - CP(N)) + E1(N)*(CM(N) - CMM1(N+1))
+      END DO
+ 
+      AF(L) = E1(NL)-RSF*E3(NL)
+      BF(L) = E2(NL)-RSF*E4(NL)
+      CF(L) = 0.0
+      DF(L) = BSURF-CP(NL)+RSF*CM(NL)
+ 
+      CALL DTRIDGL(L,AF,BF,CF,DF,XK)
+ 
+C     ***UNMIX THE COEFFICIENTS****
+
+      DO 28 N=1,NL
+        XK1(N) = XK(2*N-1)+XK(2*N)
+        XK2(N) = XK(2*N-1)-XK(2*N)
+
+C       NOW TEST TO SEE IF XK2 IS REALLY ZERO TO THE LIMIT OF THE
+C       MACHINE ACCURACY  = 1 .E -30
+C       XK2 IS THE COEFFICEINT OF THE GROWING EXPONENTIAL AND MUST
+C       BE TREATED CAREFULLY
+
+        IF(XK2(N) .EQ. 0.0) GO TO 28
+c        IF (ABS (XK2(N)/XK(2*N-1)) .LT. 1.E-30) XK2(N)=0.0
+
+        IF (ABS (XK2(N)/(XK(2*N-1)+1.e-20)) .LT. 1.E-30) XK2(N)=0.0   ! For debug only (with -Ktrap=fp option)
+
+
+   28 CONTINUE
+ 
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dtridgl.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dtridgl.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/dtridgl.F	(revision 222)
@@ -0,0 +1,36 @@
+      SUBROUTINE DTRIDGL(L,AF,BF,CF,DF,XK)
+
+C  GCM2.0  Feb 2003
+
+C     DOUBLE PRECISION VERSION OF TRIDGL
+
+      PARAMETER (NMAX=201)
+      IMPLICIT REAL*8  (A-H,O-Z)
+      DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L)
+      DIMENSION AS(NMAX),DS(NMAX)
+
+C*    THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX
+C*    EQUATIONS. THE FORM OF THE EQUATIONS ARE:
+C*    A(I)*X(I-1) + B(I)*X(I) + C(I)*X(I+1) = D(I)
+C*    WHERE I=1,L  LESS THAN 103.
+C* ..............REVIEWED -CP........
+
+C======================================================================C
+
+      AS(L) = AF(L)/BF(L)
+      DS(L) = DF(L)/BF(L)
+
+      DO I=2,L
+        X         = 1./(BF(L+1-I) - CF(L+1-I)*AS(L+2-I))
+        AS(L+1-I) = AF(L+1-I)*X
+        DS(L+1-I) = (DF(L+1-I)-CF(L+1-I)*DS(L+2-I))*X
+      END DO
+ 
+      XK(1)=DS(1)
+      DO I=2,L
+        XKB   = XK(I-1)
+        XK(I) = DS(I)-AS(I)*XKB
+      END DO
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/evap.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/evap.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/evap.F	(revision 222)
@@ -0,0 +1,80 @@
+      subroutine evap(ngrid,nq,dtime,pt, pq, pdq, pdt,  
+     $     dqevap,dtevap, qevap, tevap) 
+        
+      use watercommon_h 
+      USE tracer_h
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Evaporation of all water in the atmopshere.
+!     
+!     Authors
+!     -------
+!     Adapted from the LMDTERRE code by B. Charnay (2010)
+!     Original author Z. X. Li (1993)
+!     
+!==================================================================
+
+      INTEGER ngrid,nq
+
+! Arguments:
+      REAL pt(ngrid,nlayermx) 
+      REAL pq(ngrid,nlayermx,nq) 
+      REAL pdt(ngrid,nlayermx) 
+      REAL pdq(ngrid,nlayermx,nq) 
+      REAL dqevap(ngrid,nlayermx)
+      REAL dtevap(ngrid,nlayermx)
+      REAL qevap(ngrid,nlayermx,nq)
+      REAL dtime
+ 
+! Local:
+      REAL tevap(ngrid,nlayermx) 
+      REAL zlvdcp
+      REAL zlsdcp
+      REAL zdelta
+      INTEGER l,ig
+
+!
+! Re-evaporer l'eau liquide nuageuse
+!
+
+      DO l=1,nlayermx
+        DO ig=1,ngrid
+         qevap(ig,l,igcm_h2o_vap)=pq(ig,l,igcm_h2o_vap)	
+     s          	          +pdq(ig,l,igcm_h2o_vap)*dtime
+         qevap(ig,l,igcm_h2o_ice)=pq(ig,l,igcm_h2o_ice)	
+     s                            +pdq(ig,l,igcm_h2o_ice)*dtime
+         tevap(ig,l)=pt(ig,l)+pdt(ig,l)*dtime
+	ENDDO
+      ENDDO
+
+      DO l = 1, nlayermx  
+      	DO ig = 1, ngrid
+         zlvdcp=RLVTT/RCPD!/(1.0+RVTMP2*qevap(ig,l,igcm_h2o_vap))
+         zlsdcp=RLSTT/RCPD!/(1.0+RVTMP2*qevap(ig,l,igcm_h2o_vap))
+         ! ignoring qevap term creates huge difference when qevap large!!!
+
+         zdelta = MAX(0.,SIGN(1.,T_h2O_ice_liq-tevap(ig,l))) ! what is this?
+                                                  ! for division between water / liquid
+	 dqevap(ig,l) = MAX(0.0,qevap(ig,l,igcm_h2o_ice))/dtime
+         dtevap(ig,l) = - dqevap(ig,l)*RLVTT/RCPD ! exactly as in largescale.F
+!         dtevap(ig,l) = - dqevap(ig,l)	
+!     s                       * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
+         qevap(ig,l,igcm_h2o_vap) = qevap(ig,l,igcm_h2o_vap)	
+     s     	                    +dqevap(ig,l)*dtime
+	 qevap(ig,l,igcm_h2o_ice) = 0.0
+         tevap(ig,l) = tevap(ig,l)+dtevap(ig,l)*dtime
+
+      	ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/forceWCfn.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/forceWCfn.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/forceWCfn.F	(revision 222)
@@ -0,0 +1,50 @@
+      subroutine forceWCfn(ngrid,nq,pplev,pt,dq,dqs)
+
+      USE tracer_h
+
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Force tracer conservation in a column for a given pair of 
+!     delta q, delta q_s
+!
+!     Authors
+!     ------- 
+!     R. Wordsworth
+!     
+!==================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+
+      INTEGER ngrid,nq
+
+      real masse, Wtot, Wdiff
+
+      real pplev(ngrid,nlayermx+1)
+      real pt(ngrid)
+
+      real dqs(ngrid,nq) 
+      real dq(ngrid,nlayermx,nq)
+
+      integer iq, ig, ilay
+
+      do iq=1,nq 
+        do ig=1,ngrid
+           Wtot = 0.0
+           do ilay=1,nlayermx
+              masse = (pplev(ig,ilay) - pplev(ig,ilay+1))/g
+              Wtot  = Wtot + masse*dq(ig,ilay,iq)
+           enddo
+           Wdiff = Wtot + dqs(ig,iq)
+         
+           dqs(ig,iq) = dqs(ig,iq) - Wdiff
+        enddo
+      enddo
+
+      end 
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gases_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gases_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gases_h.F90	(revision 222)
@@ -0,0 +1,34 @@
+      module gases_h
+
+      implicit none
+
+!======================================================================C
+!
+!     gases_h    
+!
+!     A F90-allocatable version for gases.h -- AS 12/2011
+!
+!======================================================================C
+
+      ! Set and allocated in su_gases.F90
+      integer :: ngasmx
+      integer :: vgas
+      character*20,allocatable,DIMENSION(:) :: gnom ! name of the gas
+      real,allocatable,DIMENSION(:) :: gfrac
+
+      ! in analogy with tracer.h ...
+      integer :: igas_H2
+      integer :: igas_He
+      integer :: igas_H2O
+      integer :: igas_CO2
+      integer :: igas_CO
+      integer :: igas_N2
+      integer :: igas_O2
+      integer :: igas_SO2
+      integer :: igas_H2S
+      integer :: igas_CH4
+      integer :: igas_NH3
+      integer :: igas_C2H2
+      integer :: igas_C2H6
+
+      end module gases_h
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gfluxi.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gfluxi.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gfluxi.F	(revision 222)
@@ -0,0 +1,226 @@
+      SUBROUTINE GFLUXI(NLL,TLEV,NW,DW,DTAU,TAUCUM,W0,COSBAR,UBARI,
+     *                  RSF,BTOP,BSURF,FTOPUP,FMIDP,FMIDM)
+
+C  THIS SUBROUTINE TAKES THE OPTICAL CONSTANTS AND BOUNDARY CONDITIONS
+C  FOR THE INFRARED FLUX AT ONE WAVELENGTH AND SOLVES FOR THE FLUXES AT
+C  THE LEVELS. THIS VERSION IS SET UP TO WORK WITH LAYER OPTICAL DEPTHS
+C  MEASURED FROM THE TOP OF EACH LAYER.  THE TOP OF EACH LAYER HAS  
+C  OPTICAL DEPTH ZERO.  IN THIS SUB LEVEL N IS ABOVE LAYER N. THAT IS LAYER N
+C  HAS LEVEL N ON TOP AND LEVEL N+1 ON BOTTOM. OPTICAL DEPTH INCREASES
+C  FROM TOP TO BOTTOM. SEE C.P. MCKAY, TGM NOTES.
+C THE TRI-DIAGONAL MATRIX SOLVER IS DSOLVER AND IS DOUBLE PRECISION SO MANY 
+C VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN DSOLVER
+C
+C NLL            = NUMBER OF LEVELS (NLAYERS + 1) MUST BE LESS THAT NL (101)
+C TLEV(L_LEVELS) = ARRAY OF TEMPERATURES AT GCM LEVELS
+C WAVEN          = WAVELENGTH FOR THE COMPUTATION
+C DW             = WAVENUMBER INTERVAL
+C DTAU(NLAYER)   = ARRAY OPTICAL DEPTH OF THE LAYERS
+C W0(NLEVEL)     = SINGLE SCATTERING ALBEDO
+C COSBAR(NLEVEL) = ASYMMETRY FACTORS, 0=ISOTROPIC
+C UBARI          = AVERAGE ANGLE, MUST BE EQUAL TO 0.5 IN IR
+C RSF            = SURFACE REFLECTANCE
+C BTOP           = UPPER BOUNDARY CONDITION ON IR INTENSITY (NOT FLUX)
+C BSURF          = SURFACE EMISSION = (1-RSFI)*PLANCK, INTENSITY (NOT FLUX)
+C FP(NLEVEL)     = UPWARD FLUX AT LEVELS
+C FM(NLEVEL)     = DOWNWARD FLUX AT LEVELS
+C FMIDP(NLAYER)  = UPWARD FLUX AT LAYER MIDPOINTS
+C FMIDM(NLAYER)  = DOWNWARD FLUX AT LAYER MIDPOINTS
+C
+C----------------------------------------------------------------------C
+
+      use radinc_h
+      use radcommon_h, only: planckir
+
+      implicit none
+
+#include "comcstfi.h"
+
+      INTEGER NLP
+      PARAMETER (NLP=101) ! MUST BE LARGER THAN NLEVEL 
+
+      INTEGER NLL, NLAYER, L, NW, NT, NT2
+      REAL*8  TERM, CPMID, CMMID
+      REAL*8  PLANCK
+      REAL*8  EM,EP
+      REAL*8  COSBAR(L_NLAYRAD), W0(L_NLAYRAD), DTAU(L_NLAYRAD)
+      REAL*8  TAUCUM(L_LEVELS), DTAUK
+      REAL*8  TLEV(L_LEVELS)
+      REAL*8  WAVEN, DW, UBARI, RSF
+      REAL*8  BTOP, BSURF, FMIDP(L_NLAYRAD), FMIDM(L_NLAYRAD)
+      REAL*8  B0(NLP),B1(NLP),ALPHA(NLP),LAMDA(NLP),XK1(NLP),XK2(NLP)
+      REAL*8  GAMA(NLP),CP(NLP),CM(NLP),CPM1(NLP),CMM1(NLP),E1(NLP)
+      REAL*8  E2(NLP),E3(NLP),E4(NLP)
+
+      REAL*8  FTOPUP, FLUXUP, FLUXDN
+
+      real*8 :: TAUMAX = L_TAUMAX 
+
+C======================================================================C
+ 
+C     WE GO WITH THE HEMISPHERIC CONSTANT APPROACH IN THE INFRARED
+ 
+
+      IF (NLL .GT. NLP) STOP 'PARAMETER NL TOO SMALL IN GFLUXI'
+
+      NLAYER = L_NLAYRAD
+
+      DO L=1,L_NLAYRAD-1
+
+!----------------------------------------------------
+! There is a problem when W0 = 1
+!         open(888,file='W0')
+!           if ((W0(L).eq.0.).or.(W0(L).eq.1.)) then
+!             write(888,*) W0(L), L, 'gfluxi'
+!           endif
+! Prevent this with an if statement:
+        if (W0(L).eq.1.D0) then
+           W0(L) = 0.99999D0
+        endif
+!----------------------------------------------------
+
+        ALPHA(L) = SQRT( (1.0D0-W0(L))/(1.0D0-W0(L)*COSBAR(L)) )
+        LAMDA(L) = ALPHA(L)*(1.0D0-W0(L)*COSBAR(L))/UBARI
+
+        NT    = int(TLEV(2*L)*NTfac)   - NTstar+1
+        NT2   = int(TLEV(2*L+2)*NTfac) - NTstar+1
+
+        B1(L) = (PLANCKIR(NW,NT2)-PLANCKIR(NW,NT))/DTAU(L)
+        B0(L) = PLANCKIR(NW,NT)
+      END DO
+
+C     Take care of special lower layer
+
+      L        = L_NLAYRAD
+
+      if (W0(L).eq.1.) then
+          W0(L) = 0.99999D0
+      end if
+
+      ALPHA(L) = SQRT( (1.0D0-W0(L))/(1.0D0-W0(L)*COSBAR(L)) )
+      LAMDA(L) = ALPHA(L)*(1.0D0-W0(L)*COSBAR(L))/UBARI
+
+      ! Tsurf is used for 1st layer source function
+      ! -- same results for most thin atmospheres
+      ! -- and stabilizes integrations
+      NT    = int(TLEV(2*L+1)*NTfac) - NTstar+1
+      !! For deep, opaque, thick first layers (e.g. Saturn)
+      !! what is below works much better, not unstable, ...
+      !! ... and actually fully accurate because 1st layer temp (JL) 
+      !NT    = int(TLEV(2*L)*NTfac) - NTstar+1
+      !! (or this one yields same results
+      !NT    = int( (TLEV(2*L)+TLEV(2*L+1))*0.5*NTfac ) - NTstar+1
+
+      NT2   = int(TLEV(2*L)*NTfac)   - NTstar+1
+      B1(L) = (PLANCKIR(NW,NT)-PLANCKIR(NW,NT2))/DTAU(L)
+      B0(L) = PLANCKIR(NW,NT2)
+
+      DO L=1,L_NLAYRAD
+        GAMA(L) = (1.0D0-ALPHA(L))/(1.0D0+ALPHA(L))
+        TERM    = UBARI/(1.0D0-W0(L)*COSBAR(L))
+
+C       CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C       BOTTOM OF THE LAYER.  THAT IS AT DTAU OPTICAL DEPTH
+
+        CP(L) = B0(L)+B1(L)*DTAU(L) +B1(L)*TERM
+        CM(L) = B0(L)+B1(L)*DTAU(L) -B1(L)*TERM
+
+C       CPM1 AND CMM1 ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C       AT THE TOP OF THE LAYER, THAT IS ZERO OPTICAL DEPTH
+
+        CPM1(L) = B0(L)+B1(L)*TERM
+        CMM1(L) = B0(L)-B1(L)*TERM
+      END DO
+ 
+C     NOW CALCULATE THE EXPONENTIAL TERMS NEEDED
+C     FOR THE TRIDIAGONAL ROTATED LAYERED METHOD
+C     WARNING IF DTAU(J) IS GREATER THAN ABOUT 35 (VAX)
+C     WE CLIP IT TO AVOID OVERFLOW.
+
+      DO L=1,L_NLAYRAD
+
+C       CLIP THE EXPONENTIAL HERE.
+
+        EP    = EXP( MIN((LAMDA(L)*DTAU(L)),TAUMAX))
+        EM    = 1.0D0/EP
+        E1(L) = EP+GAMA(L)*EM
+        E2(L) = EP-GAMA(L)*EM
+        E3(L) = GAMA(L)*EP+EM
+        E4(L) = GAMA(L)*EP-EM
+      END DO
+ 
+c     B81=BTOP  ! RENAME BEFORE CALLING DSOLVER - used to be to set
+c     B82=BSURF ! them to real*8 - but now everything is real*8
+c     R81=RSF   ! so this may not be necessary
+
+C     Double precision tridiagonal solver
+
+      CALL DSOLVER(NLAYER,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP,
+     *             BSURF,RSF,XK1,XK2)
+ 
+
+C     NOW WE CALCULATE THE FLUXES AT THE MIDPOINTS OF THE LAYERS.
+ 
+      DO L=1,L_NLAYRAD-1
+        DTAUK = TAUCUM(2*L+1)-TAUCUM(2*L)
+        EP    = EXP(MIN(LAMDA(L)*DTAUK,TAUMAX)) ! CLIPPED EXPONENTIAL 
+        EM    = 1.0D0/EP
+        TERM  = UBARI/(1.D0-W0(L)*COSBAR(L))
+
+C       CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C       BOTTOM OF THE LAYER.  THAT IS AT DTAU  OPTICAL DEPTH
+
+        CPMID    = B0(L)+B1(L)*DTAUK +B1(L)*TERM
+        CMMID    = B0(L)+B1(L)*DTAUK -B1(L)*TERM
+        FMIDP(L) = XK1(L)*EP + GAMA(L)*XK2(L)*EM + CPMID
+        FMIDM(L) = XK1(L)*EP*GAMA(L) + XK2(L)*EM + CMMID
+
+C       FOR FLUX WE INTEGRATE OVER THE HEMISPHERE TREATING INTENSITY CONSTANT
+
+        FMIDP(L) = FMIDP(L)*PI
+        FMIDM(L) = FMIDM(L)*PI
+      END DO
+ 
+C     And now, for the special bottom layer
+
+      L    = L_NLAYRAD
+
+      EP   = EXP(MIN((LAMDA(L)*DTAU(L)),TAUMAX)) ! CLIPPED EXPONENTIAL 
+      EM   = 1.0D0/EP
+      TERM = UBARI/(1.D0-W0(L)*COSBAR(L))
+
+C     CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C     BOTTOM OF THE LAYER.  THAT IS AT DTAU  OPTICAL DEPTH
+
+      CPMID    = B0(L)+B1(L)*DTAU(L) +B1(L)*TERM
+      CMMID    = B0(L)+B1(L)*DTAU(L) -B1(L)*TERM
+      FMIDP(L) = XK1(L)*EP + GAMA(L)*XK2(L)*EM + CPMID
+      FMIDM(L) = XK1(L)*EP*GAMA(L) + XK2(L)*EM + CMMID
+ 
+C     FOR FLUX WE INTEGRATE OVER THE HEMISPHERE TREATING INTENSITY CONSTANT
+
+      FMIDP(L) = FMIDP(L)*PI
+      FMIDM(L) = FMIDM(L)*PI
+
+C     FLUX AT THE PTOP LEVEL
+
+      EP   = 1.0D0
+      EM   = 1.0D0
+      TERM = UBARI/(1.0D0-W0(1)*COSBAR(1))
+
+C     CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C     BOTTOM OF THE LAYER.  THAT IS AT DTAU  OPTICAL DEPTH
+
+      CPMID  = B0(1)+B1(1)*TERM
+      CMMID  = B0(1)-B1(1)*TERM
+
+      FLUXUP = XK1(1)*EP + GAMA(1)*XK2(1)*EM + CPMID
+      FLUXDN = XK1(1)*EP*GAMA(1) + XK2(1)*EM + CMMID
+ 
+C     FOR FLUX WE INTEGRATE OVER THE HEMISPHERE TREATING INTENSITY CONSTANT
+
+      FTOPUP = (FLUXUP-FLUXDN)*PI
+
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gfluxv.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gfluxv.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gfluxv.F	(revision 222)
@@ -0,0 +1,319 @@
+      SUBROUTINE GFLUXV(DTDEL,TDEL,TAUCUMIN,WDEL,CDEL,UBAR0,F0PI,RSF,
+     *                  BTOP,BSURF,FMIDP,FMIDM,DIFFV,FLUXUP,FLUXDN)
+
+
+C  THIS SUBROUTINE TAKES THE OPTICAL CONSTANTS AND BOUNDARY CONDITIONS
+C  FOR THE VISIBLE  FLUX AT ONE WAVELENGTH AND SOLVES FOR THE FLUXES AT
+C  THE LEVELS. THIS VERSION IS SET UP TO WORK WITH LAYER OPTICAL DEPTHS
+C  MEASURED FROM THE TOP OF EACH LAYER.  (DTAU) TOP OF EACH LAYER HAS  
+C  OPTICAL DEPTH TAU(N).IN THIS SUB LEVEL N IS ABOVE LAYER N. THAT IS LAYER N
+C  HAS LEVEL N ON TOP AND LEVEL N+1 ON BOTTOM. OPTICAL DEPTH INCREASES
+C  FROM TOP TO BOTTOM. SEE C.P. MCKAY, TGM NOTES.
+C THIS SUBROUTINE DIFFERS FROM ITS IR COUNTERPART IN THAT HERE WE SOLVE FOR 
+C THE FLUXES DIRECTLY USING THE GENERALIZED NOTATION OF MEADOR AND WEAVOR
+C J.A.S., 37, 630-642, 1980.
+C THE TRI-DIAGONAL MATRIX SOLVER IS DSOLVER AND IS DOUBLE PRECISION SO MANY 
+C VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN DSOLVER
+C
+C NLL           = NUMBER OF LEVELS (NAYER + 1) THAT WILL BE SOLVED
+C NAYER         = NUMBER OF LAYERS (NOTE DIFFERENT SPELLING HERE)
+C WAVEN         = WAVELENGTH FOR THE COMPUTATION
+C DTDEL(NLAYER) = ARRAY OPTICAL DEPTH OF THE LAYERS
+C TDEL(NLL)     = ARRAY COLUMN OPTICAL DEPTH AT THE LEVELS
+C WDEL(NLEVEL)  = SINGLE SCATTERING ALBEDO
+C CDEL(NLL)     = ASYMMETRY FACTORS, 0=ISOTROPIC
+C UBARV         = AVERAGE ANGLE, 
+C UBAR0         = SOLAR ZENITH ANGLE
+C F0PI          = INCIDENT SOLAR DIRECT BEAM FLUX
+C RSF           = SURFACE REFLECTANCE
+C BTOP          = UPPER BOUNDARY CONDITION ON DIFFUSE FLUX
+C BSURF         = REFLECTED DIRECT BEAM = (1-RSFI)*F0PI*EDP-TAU/U
+C FP(NLEVEL)    = UPWARD FLUX AT LEVELS
+C FM(NLEVEL)    = DOWNWARD FLUX AT LEVELS
+C FMIDP(NLAYER) = UPWARD FLUX AT LAYER MIDPOINTS
+C FMIDM(NLAYER) = DOWNWARD FLUX AT LAYER MIDPOINTS
+C added Dec 2002
+C DIFFV         = downward diffuse solar flux at the surface
+C 
+!======================================================================!
+
+      use radinc_h
+
+      implicit none
+
+      INTEGER NLP
+      PARAMETER (NLP=101) ! MUST BE LARGER THAN NLEVEL
+
+      REAL*8 EM, EP
+      REAL*8 W0(L_NLAYRAD), COSBAR(L_NLAYRAD), DTAU(L_NLAYRAD)
+      REAL*8 TAU(L_NLEVRAD), WDEL(L_NLAYRAD), CDEL(L_NLAYRAD)
+      REAL*8 DTDEL(L_NLAYRAD), TDEL(L_NLEVRAD)
+      REAL*8 FMIDP(L_NLAYRAD), FMIDM(L_NLAYRAD)
+      REAL*8 LAMDA(NLP), ALPHA(NLP), XK1(NLP), XK2(NLP)
+      REAL*8 G1(NLP), G2(NLP), G3(NLP), GAMA(NLP), CP(NLP), CM(NLP)
+      REAL*8 CPM1(NLP)
+      REAL*8 CMM1(NLP), E1(NLP), E2(NLP), E3(NLP), E4(NLP), EXPTRM(NLP)
+      REAL*8 FLUXUP, FLUXDN
+      REAL*8 FACTOR, TAUCUMIN(L_LEVELS), TAUCUM(L_LEVELS)
+
+      integer NAYER, L, K
+      real*8  ubar0, f0pi, rsf, btop, bsurf, g4, denom, am, ap
+      real*8  taumax, taumid, cpmid, cmmid
+      real*8  diffv
+
+C======================================================================C
+
+
+
+
+      NAYER  = L_NLAYRAD
+      TAUMAX = L_TAUMAX    !Default is 35.0
+      
+!  Delta-Eddington Scaling
+
+
+      FACTOR    = 1.0D0 - WDEL(1)*CDEL(1)**2
+
+      TAU(1)    = TDEL(1)*FACTOR
+      TAUCUM(1) = 0.0D0
+      TAUCUM(2) = TAUCUMIN(2)*FACTOR
+      TAUCUM(3) = TAUCUM(2) +(TAUCUMIN(3)-TAUCUMIN(2))*FACTOR
+
+
+      DO L=1,L_NLAYRAD-1
+        FACTOR      = 1.0D0 - WDEL(L)*CDEL(L)**2
+        W0(L)       = WDEL(L)*(1.0D0-CDEL(L)**2)/FACTOR
+        COSBAR(L)   = CDEL(L)/(1.0D0+CDEL(L))
+
+        DTAU(L)     = DTDEL(L)*FACTOR
+        TAU(L+1)    = TAU(L)+DTAU(L)
+        K           = 2*(L+1)
+        TAUCUM(K)   = TAU(L+1)
+        TAUCUM(K+1) = TAUCUM(K) + (TAUCUMIN(K+1)-TAUCUMIN(K))*FACTOR
+      END DO
+
+!  Bottom layer
+
+      L             = L_NLAYRAD
+      FACTOR        = 1.0D0 - WDEL(L)*CDEL(L)**2
+      W0(L)         = WDEL(L)*(1.0D0-CDEL(L)**2)/FACTOR
+      COSBAR(L)     = CDEL(L)/(1.0D0+CDEL(L))
+      DTAU(L)       = DTDEL(L)*FACTOR
+      TAU(L+1)      = TAU(L)+DTAU(L)
+      TAUCUM(2*L+1) = TAU(L+1)
+
+      BSURF = RSF*UBAR0*F0PI*EXP(-MIN(TAU(L+1),TAUMAX)/UBAR0)
+      ! new definition of BSURF
+      ! the old one was false because it used tau, not tau'
+      ! tau' includes the contribution to the downward flux
+      ! of the radiation scattered in the forward direction
+
+C     WE GO WITH THE QUADRATURE APPROACH HERE.  THE "SQRT(3)" factors
+C     ARE THE UBARV TERM.
+
+      DO L=1,L_NLAYRAD
+
+        ALPHA(L)=SQRT( (1.0-W0(L))/(1.0-W0(L)*COSBAR(L) ) )
+
+C       SET OF CONSTANTS DETERMINED BY DOM 
+
+!     Quadrature method
+        G1(L)    = (SQRT(3.0)*0.5)*(2.0- W0(L)*(1.0+COSBAR(L)))
+        G2(L)    = (SQRT(3.0)*W0(L)*0.5)*(1.0-COSBAR(L))
+        G3(L)    = 0.5*(1.0-SQRT(3.0)*COSBAR(L)*UBAR0)
+
+!     ----- some other methods... (RDW) ------
+
+!     Eddington method
+!        G1(L)    =  0.25*(7.0 - W0(L)*(4.0 - 3.0*COSBAR(L)))
+!        G2(L)    = -0.25*(1.0 - W0(L)*(4.0 - 3.0*COSBAR(L)))
+!        G3(L)    =  0.25*(2.0 - 3.0*COSBAR(L)*UBAR0)
+
+!     delta-Eddington method
+!        G1(L)    =  (7.0 - 3.0*g^2 - W0(L)*(4.0 + 3.0*g) + W0(L)*g^2*(4*beta0 + 3*g)) / &
+!                             (4* (1 - g^2*()   ))  0.25*(7.0 - W0(L)*(4.0 - 3.0*COSBAR(L)))
+
+!     Hybrid modified Eddington-delta function method
+
+!     ----------------------------------------
+
+c     So they use Quadrature
+c     but the scaling is Eddington?
+
+        LAMDA(L) = SQRT(G1(L)**2 - G2(L)**2)
+        GAMA(L)  = (G1(L)-LAMDA(L))/G2(L)
+      END DO
+
+
+      DO L=1,L_NLAYRAD
+        G4    = 1.0-G3(L)
+        DENOM = LAMDA(L)**2 - 1./UBAR0**2
+ 
+C       THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C       THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN 
+C       THE SCATTERING GOES TO ZERO
+C       PREVENT THIS WITH AN IF STATEMENT
+
+        IF ( DENOM .EQ. 0.) THEN
+          DENOM=1.E-10
+        END IF
+
+
+        AM = F0PI*W0(L)*(G4   *(G1(L)+1./UBAR0) +G2(L)*G3(L) )/DENOM
+        AP = F0PI*W0(L)*(G3(L)*(G1(L)-1./UBAR0) +G2(L)*G4    )/DENOM
+
+C       CPM1 AND CMM1 ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C       AT THE TOP OF THE LAYER, THAT IS LOWER   OPTICAL DEPTH TAU(L)
+ 
+        CPM1(L) = AP*EXP(-TAU(L)/UBAR0)
+        CMM1(L) = AM*EXP(-TAU(L)/UBAR0)
+
+C       CP AND CM ARE THE CPLUS AND CMINUS TERMS EVALUATED AT THE
+C       BOTTOM OF THE LAYER.  THAT IS AT HIGHER OPTICAL DEPTH TAU(L+1)
+
+        CP(L) = AP*EXP(-TAU(L+1)/UBAR0)
+        CM(L) = AM*EXP(-TAU(L+1)/UBAR0)
+
+      END DO
+
+
+ 
+C     NOW CALCULATE THE EXPONENTIAL TERMS NEEDED
+C     FOR THE TRIDIAGONAL ROTATED LAYERED METHOD
+
+      DO L=1,L_NLAYRAD
+        EXPTRM(L) = MIN(TAUMAX,LAMDA(L)*DTAU(L))  ! CLIPPED EXPONENTIAL
+        EP = EXP(EXPTRM(L))
+
+        EM        = 1.0/EP
+        E1(L)     = EP+GAMA(L)*EM
+        E2(L)     = EP-GAMA(L)*EM
+        E3(L)     = GAMA(L)*EP+EM
+        E4(L)     = GAMA(L)*EP-EM
+      END DO
+
+      CALL DSOLVER(NAYER,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP,
+     *             BSURF,RSF,XK1,XK2)
+
+C     NOW WE CALCULATE THE FLUXES AT THE MIDPOINTS OF THE LAYERS.
+ 
+      DO L=1,L_NLAYRAD-1
+        EXPTRM(L) = MIN(TAUMAX,LAMDA(L)*(TAUCUM(2*L+1)-TAUCUM(2*L)))
+ 
+        EP = EXP(EXPTRM(L))
+
+        EM    = 1.0/EP
+        G4    = 1.0-G3(L)
+        DENOM = LAMDA(L)**2 - 1./UBAR0**2
+
+C       THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C       THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN 
+C       THE SCATTERING GOES TO ZERO
+C       PREVENT THIS WITH A IF STATEMENT
+
+
+        IF ( DENOM .EQ. 0.) THEN
+          DENOM=1.E-10
+        END IF
+
+        AM = F0PI*W0(L)*(G4   *(G1(L)+1./UBAR0) +G2(L)*G3(L) )/DENOM
+        AP = F0PI*W0(L)*(G3(L)*(G1(L)-1./UBAR0) +G2(L)*G4    )/DENOM
+
+C       CPMID AND CMMID  ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C       AT THE MIDDLE OF THE LAYER.
+
+        TAUMID   = TAUCUM(2*L+1)
+
+        CPMID = AP*EXP(-TAUMID/UBAR0)
+        CMMID = AM*EXP(-TAUMID/UBAR0)
+
+        FMIDP(L) = XK1(L)*EP + GAMA(L)*XK2(L)*EM + CPMID
+        FMIDM(L) = XK1(L)*EP*GAMA(L) + XK2(L)*EM + CMMID
+ 
+C       ADD THE DIRECT FLUX TO THE DOWNWELLING TERM
+
+        FMIDM(L)= FMIDM(L)+UBAR0*F0PI*EXP(-MIN(TAUMID,TAUMAX)/UBAR0)
+   
+      END DO
+ 
+C     FLUX AT THE Ptop layer
+
+      EP    = 1.0
+      EM    = 1.0
+      G4    = 1.0-G3(1)
+      DENOM = LAMDA(1)**2 - 1./UBAR0**2
+
+C     THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C     THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN 
+C     THE SCATTERING GOES TO ZERO
+C     PREVENT THIS WITH A IF STATEMENT
+
+      IF ( DENOM .EQ. 0.) THEN
+        DENOM=1.E-10
+      END IF
+
+      AM = F0PI*W0(1)*(G4   *(G1(1)+1./UBAR0) +G2(1)*G3(1) )/DENOM
+      AP = F0PI*W0(1)*(G3(1)*(G1(1)-1./UBAR0) +G2(1)*G4    )/DENOM
+
+C     CPMID AND CMMID  ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C     AT THE MIDDLE OF THE LAYER.
+
+      CPMID  = AP
+      CMMID  = AM
+
+      FLUXUP = XK1(1)*EP + GAMA(1)*XK2(1)*EM + CPMID
+      FLUXDN = XK1(1)*EP*GAMA(1) + XK2(1)*EM + CMMID
+
+C     ADD THE DIRECT FLUX TO THE DOWNWELLING TERM
+
+      fluxdn = fluxdn+UBAR0*F0PI*EXP(-MIN(TAUCUM(1),TAUMAX)/UBAR0)
+
+C     This is for the "special" bottom layer, where we take
+C     DTAU instead of DTAU/2.
+
+      L     = L_NLAYRAD 
+      EXPTRM(L) = MIN(TAUMAX,LAMDA(L)*(TAUCUM(L_LEVELS)-
+     *                                 TAUCUM(L_LEVELS-1)))
+
+      EP    = EXP(EXPTRM(L))
+      EM    = 1.0/EP
+      G4    = 1.0-G3(L)
+      DENOM = LAMDA(L)**2 - 1./UBAR0**2
+
+
+C     THERE IS A POTENTIAL PROBLEM HERE IF W0=0 AND UBARV=UBAR0
+C     THEN DENOM WILL VANISH. THIS ONLY HAPPENS PHYSICALLY WHEN 
+C     THE SCATTERING GOES TO ZERO
+C     PREVENT THIS WITH A IF STATEMENT
+
+
+      IF ( DENOM .EQ. 0.) THEN
+        DENOM=1.E-10
+      END IF
+
+      AM = F0PI*W0(L)*(G4   *(G1(L)+1./UBAR0) +G2(L)*G3(L) )/DENOM
+      AP = F0PI*W0(L)*(G3(L)*(G1(L)-1./UBAR0) +G2(L)*G4    )/DENOM
+
+C     CPMID AND CMMID  ARE THE CPLUS AND CMINUS TERMS EVALUATED
+C     AT THE MIDDLE OF THE LAYER.
+
+      TAUMID   = MIN(TAUCUM(L_LEVELS),TAUMAX)
+      CPMID    = AP*EXP(-MIN(TAUMID,TAUMAX)/UBAR0)
+      CMMID    = AM*EXP(-MIN(TAUMID,TAUMAX)/UBAR0)
+
+
+      FMIDP(L) = XK1(L)*EP + GAMA(L)*XK2(L)*EM + CPMID
+      FMIDM(L) = XK1(L)*EP*GAMA(L) + XK2(L)*EM + CMMID
+
+C  Save the diffuse downward flux for TEMPGR calculations
+
+      DIFFV = FMIDM(L)
+
+
+C     ADD THE DIRECT FLUX TO THE DOWNWELLING TERM
+
+      FMIDM(L)= FMIDM(L)+UBAR0*F0PI*EXP(-MIN(TAUMID,TAUMAX)/UBAR0)
+
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gradients_kcm.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gradients_kcm.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/gradients_kcm.F90	(revision 222)
@@ -0,0 +1,126 @@
+subroutine gradients_kcm(profil_flag,rho_v,rho_n,T,dTdp,dPvdp,dPndp)
+
+  use params_h
+  use gases_h
+  implicit none
+
+  ! inputs
+  integer profil_flag ! 0 = dry, 1 = moist, 2 = isothermal
+  double precision rho_v,rho_n,T
+
+  ! outputs
+  double precision dTdp,dPndp,dPvdp
+  double precision a_v
+
+  ! internal
+  !double precision cp_n,cp_v
+  double precision cp_v
+
+  double precision press, rho_plus, rho_minus, dVdT, rho_c
+  double precision dlnr,dlna,dpsat,dsv
+  double precision s_minus,s_plus
+  double precision s_v,s_c,L
+  double precision psat_plus,psat_minus,Pn
+  double precision nul
+
+  ! functions
+  double precision cp_neutral
+
+  !cp_n = cp_neutral(T)
+
+  select case(profil_flag)
+  case(2) ! isothermal
+
+     dTdp  = 0.
+     a_v   = rho_v/rho_n ! constant here
+     dPndp = 1/(1d0+m_n/m_v*a_v)
+     dPvdp = 1 - dPndp
+
+  case(1) ! moist
+
+     Pn = rho_n*T*rmn
+
+     if(ngasmx.eq.1)then
+        print*,'Cannot have moist adiabat with one gas...'
+        stop
+     endif
+
+     if(trim(gnom(ngasmx)).eq.'H2O')then
+
+        call psat_H2O(T-2d-1,psat_minus)
+        call psat_H2O(T+2d-1,psat_plus)
+        call psat_H2O(T,press)
+
+        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
+        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))
+
+        call therm(T-2d-1,rho_minus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
+                   nul,nul,press,s_minus,nul)
+        call therm(T+2d-1,rho_plus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
+                   nul,nul,press,s_plus,nul)
+        s_c = 2.06 * log(T/273.15)
+
+        s_plus  = s_plus  * 1d3
+        s_minus = s_minus * 1d3
+        s_c     = s_c     * 1d3 ! convert to SI
+
+        if(T.lt.280.0)then 
+           dpsat = press*1d6 * ( 1730.63*log(10.) / (T-39.714)**2 )
+        else
+           call tdpsdt(T,dpsat)
+           dpsat = dpsat * 1d6 / T
+        endif
+
+     elseif(trim(gnom(ngasmx)).eq.'NH3')then
+
+        call psat_NH3(T-2d-1,psat_minus)
+        call psat_NH3(T+2d-1,psat_plus)
+        call psat_NH3(T,press)
+
+        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
+        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))
+
+        call latheat_NH3(T-2d-1,nul,s_minus)
+        call latheat_NH3(T+2d-1,nul,s_plus)
+        call latheat_NH3(T,s_c,nul)
+
+        dpsat = press*1d6 * (-2*1.5609d-4*T + 0.1236)
+
+     endif
+
+     dsv  = (s_plus-s_minus)/4d-1  ! dsv*T = ds / d ln[T]
+     s_v  = (s_plus+s_minus)/2d0
+     dlnr = T/rho_v * (rho_plus-rho_minus)/4d-1  ! d ln[rho_v] / d ln[T]
+
+     if(rho_n/rho_v.lt.1e-5)then
+        dlna = -T*dsv/(s_v-s_c)
+     else
+        a_v  = rho_v/rho_n
+        dlna = (rmn*dlnr - cp_n + rmn - a_v*T*dsv)/(a_v*(s_v-s_c)+rmn)  
+        ! d ln[alpha_v] / d ln[T]
+        ! note cp_n + rmn = cv_n, which is what's required
+     endif
+
+     dTdp  = 1d0 / (dpsat + rho_n*rmn*(1d0 + dlnr - dlna)) ! c.f. Marcq S2.2.2
+     dPvdp = dTdp * dpsat
+     dPndp = 1d0 - dPvdp ! from p = p_v + p_n
+
+  case(0) ! dry
+
+     cp_v=0.0
+     if(trim(gnom(ngasmx)).eq.'H2O')then
+        cp_v = (32.24+1.923d-3*T+1.055d-5*T**2-3.511d-9*T**3)/m_v
+     elseif(trim(gnom(ngasmx)).eq.'NH3')then
+        cp_v = 2.058d3
+     elseif(trim(gnom(ngasmx)).eq.'CH4')then
+        cp_v = 2.226d3
+     endif
+
+     dTdp  = 1/(rho_n*cp_n+rho_v*cp_v)
+     dPndp = 1/(1d0+m_n/m_v*rho_v/rho_n)
+     dPvdp = 1/(1d0+m_v/m_n*rho_n/rho_v)
+      
+  end select
+
+
+end subroutine gradients_kcm
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/hydrol.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/hydrol.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/hydrol.F90	(revision 222)
@@ -0,0 +1,390 @@
+subroutine hydrol(ngrid,nq,ptimestep,rnat,tsurf,          &
+     qsurf,dqsurf,dqs_hyd,pcapcal,                &
+     albedo0,albedo,mu0,pdtsurf,pdtsurf_hyd,hice, &
+     pctsrf_sic,sea_ice)
+
+  use ioipsl_getincom 
+  use watercommon_h, only: T_h2O_ice_liq, RLFTT, rhowater, mx_eau_sol
+  USE surfdat_h
+  use comdiurn_h
+  USE comgeomfi_h
+  USE tracer_h
+  use slab_ice_h
+
+  implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculate the surface hydrology and albedo changes.
+!     
+!     Authors
+!     ------- 
+!     Adapted from LMDTERRE by B. Charnay (2010). Further 
+!     modifications by R. Wordsworth (2010).
+!     
+!     Called by
+!     ---------
+!     physiq.F
+!     
+!     Calls
+!     -----
+!     none
+!
+!     Notes
+!     -----
+!     rnat is terrain type: 0-ocean; 1-continent
+!     
+!==================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+      integer ngrid,nq
+
+!     Inputs
+!     ------
+      real albedoice
+      save albedoice
+
+      real snowlayer
+      parameter (snowlayer=33.0)        ! 33 kg/m^2 of snow, equal to a layer of 3.3 cm 
+      real oceantime
+      parameter (oceantime=10*24*3600)
+
+      logical,save :: oceanbulkavg ! relax ocean temperatures to a GLOBAL mean value?
+      logical,save :: activerunoff ! enable simple runoff scheme?
+      logical,save :: oceanalbvary ! ocean albedo varies with the diurnal cycle?
+
+!     Arguments
+!     ---------
+      real rnat(ngrid) ! I changed this to integer (RW)
+      real,dimension(:),allocatable,save :: runoff
+      real totalrunoff, tsea, oceanarea
+      save oceanarea
+
+      real ptimestep
+      real mu0(ngrid)
+      real qsurf(ngrid,nq), tsurf(ngrid)
+      real dqsurf(ngrid,nq), pdtsurf(ngrid)
+      real hice(ngrid)
+      real albedo0(ngrid), albedo(ngrid)
+      real pctsrf_sic(ngrid), sea_ice(ngrid)
+
+      real oceanarea2
+
+!     Output
+!     ------
+      real dqs_hyd(ngrid,nq)
+      real pdtsurf_hyd(ngrid)
+
+!     Local
+!     -----
+      real a,b,E
+      integer ig,iq, icap ! wld like to remove icap
+      real fsnoi, subli, fauxo
+      real twater(ngrid)
+      real pcapcal(ngrid)
+      real hicebis(ngrid)
+      real zqsurf(ngrid,nq)
+      real ztsurf(ngrid)
+      real albedo_sic, alb_ice
+      real zfra
+
+      integer, save :: ivap, iliq, iice
+
+      logical, save :: firstcall
+
+      data firstcall /.true./
+
+
+      if(firstcall)then
+
+         oceanbulkavg=.false.
+         oceanalbvary=.false.
+         write(*,*)"Activate runnoff into oceans?"
+         activerunoff=.false.
+         call getin("activerunoff",activerunoff)
+         write(*,*)" activerunoff = ",activerunoff
+	 
+	 
+	 
+         if (activerunoff) ALLOCATE(runoff(ngrid))
+
+         ivap=igcm_h2o_vap
+         iliq=igcm_h2o_vap
+         iice=igcm_h2o_ice
+        
+         write(*,*) "hydrol: ivap=",ivap
+         write(*,*) "        iliq=",iliq
+         write(*,*) "        iice=",iice
+
+!     Here's the deal: iice is used in place of igcm_h2o_ice both on the 
+!                      surface and in the atmosphere. ivap is used in
+!                      place of igcm_h2o_vap ONLY in the atmosphere, while
+!                      iliq is used in place of igcm_h2o_vap ONLY on the 
+!                      surface.
+
+!                      Soon to be extended to the entire water cycle...
+
+!     Ice albedo = snow albedo for now
+         albedoice=albedosnow
+
+!     Total ocean surface area
+         oceanarea=0.
+         do ig=1,ngrid
+            if(nint(rnat(ig)).eq.0)then
+               oceanarea=oceanarea+area(ig)
+            endif
+         enddo
+
+         if(oceanbulkavg.and.(oceanarea.le.0.))then
+            print*,'How are we supposed to average the ocean'
+            print*,'temperature, when there are no oceans?'
+            call abort
+         endif
+
+         if(activerunoff.and.(oceanarea.le.0.))then
+            print*,'You have enabled runoff, but you have no oceans.'
+            print*,'Where did you think the water was going to go?'
+            call abort
+         endif
+         
+         firstcall = .false.
+      endif
+
+!     add physical tendencies already calculated
+!     ------------------------------------------
+
+      do ig=1,ngrid
+         ztsurf(ig) = tsurf(ig) + ptimestep*pdtsurf(ig)
+         pdtsurf_hyd(ig)=0.0
+         do iq=1,nq
+            zqsurf(ig,iq) = qsurf(ig,iq) + ptimestep*dqsurf(ig,iq)
+         enddo    
+      enddo
+ 
+      do ig=1,ngrid
+         do iq=1,nq
+            dqs_hyd(ig,iq) = 0.0
+         enddo
+      enddo
+
+      do ig = 1, ngrid
+
+!     Ocean
+!     -----
+         if(nint(rnat(ig)).eq.0)then
+
+!     re-calculate oceanic albedo
+!            if(diurnal.and.oceanalbvary)then
+!               fauxo      = ( 1.47 - ACOS( mu0(ig) ) )/0.15 ! where does this come from (Benjamin)?
+!               albedo(ig) = 1.1*( .03 + .630/( 1. + fauxo*fauxo))
+!               albedo(ig) = MAX(MIN(albedo(ig),0.60),0.04)
+!            else
+               albedo(ig) = alb_ocean ! modif Benjamin
+!            end if
+
+
+          if(ok_slab_ocean) then
+
+! Fraction neige (hauteur critique 45kg/m2~15cm)
+            zfra = MAX(0.0,MIN(1.0,zqsurf(ig,iice)/45.0))
+! Albedo glace
+            alb_ice=alb_ice_max-(alb_ice_max-alb_ice_min) &
+            *exp(-sea_ice(ig)/h_alb_ice)
+! Albedo glace+neige
+            albedo_sic= albedosnow*zfra + alb_ice*(1.0-zfra)
+
+! Albedo final
+            albedo(ig) = pctsrf_sic(ig)*albedo_sic + (1.-pctsrf_sic(ig))*alb_ocean
+!     oceanic ice height, just for diagnostics
+            hice(ig)    = MIN(10.,sea_ice(ig)/rhowater)
+          else !ok_slab_ocean
+
+
+!     calculate oceanic ice height including the latent heat of ice formation
+!     hice is the height of oceanic ice with a maximum of maxicethick.
+            hice(ig)    = zqsurf(ig,iice)/rhowater ! update hice to include recent snowfall
+
+!            twater(ig)  = tsurf(ig) + ptimestep*zdtsurf(ig) &
+            twater(ig)  = ztsurf(ig) - hice(ig)*RLFTT*rhowater/pcapcal(ig)
+            ! this is temperature water would have if we melted entire ocean ice layer
+            hicebis(ig) = hice(ig)
+            hice(ig)    = 0.
+
+            if(twater(ig) .lt. T_h2O_ice_liq)then
+               E=min((T_h2O_ice_liq+Tsaldiff-twater(ig))*pcapcal(ig),RLFTT*rhowater*maxicethick)
+               hice(ig)        = E/(RLFTT*rhowater)
+               hice(ig)        = max(hice(ig),0.0)
+               hice(ig)        = min(hice(ig),maxicethick)
+               pdtsurf_hyd(ig) = (hice(ig) - hicebis(ig))*RLFTT*rhowater/pcapcal(ig)/ptimestep              
+               albedo(ig)      = albedoice
+
+!               if (zqsurf(ig,iice).ge.snowlayer) then
+!                  albedo(ig) = albedoice
+!               else
+!                  albedo(ig) = albedoocean &
+!                       + (albedosnow - albedoocean)*zqsurf(ig,iice)/snowlayer
+!               endif
+
+            else
+
+               pdtsurf_hyd(ig) = -hicebis(ig)*RLFTT*rhowater/pcapcal(ig)/ptimestep                
+               albedo(ig)      = alb_ocean
+
+            endif
+
+            zqsurf(ig,iliq) = zqsurf(ig,iliq)-(hice(ig)*rhowater-zqsurf(ig,iice))
+            zqsurf(ig,iice) = hice(ig)*rhowater
+
+          endif!(ok_slab_ocean)
+
+
+!     Continent
+!     ---------
+         elseif (nint(rnat(ig)).eq.1) then
+
+!     melt the snow
+            if(ztsurf(ig).gt.T_h2O_ice_liq)then
+               if(zqsurf(ig,iice).gt.1.0e-8)then
+
+                  a     = (ztsurf(ig)-T_h2O_ice_liq)*pcapcal(ig)/RLFTT
+                  b     = zqsurf(ig,iice)
+                  fsnoi = min(a,b)
+
+                  zqsurf(ig,iice) = zqsurf(ig,iice) - fsnoi
+                  zqsurf(ig,iliq) = zqsurf(ig,iliq) + fsnoi
+
+!                 thermal effects
+                  pdtsurf_hyd(ig) = -fsnoi*RLFTT/pcapcal(ig)/ptimestep  
+
+               endif
+            else
+
+!     freeze the water
+               if(zqsurf(ig,iliq).gt.1.0e-8)then
+
+                  a     = -(ztsurf(ig)-T_h2O_ice_liq)*pcapcal(ig)/RLFTT
+                  b     = zqsurf(ig,iliq)
+                  
+                  fsnoi = min(a,b)
+
+                  zqsurf(ig,iice) = zqsurf(ig,iice) + fsnoi
+                  zqsurf(ig,iliq) = zqsurf(ig,iliq) - fsnoi
+
+!                 thermal effects
+                  pdtsurf_hyd(ig) = +fsnoi*RLFTT/pcapcal(ig)/ptimestep  
+
+               endif
+            endif
+            
+!     deal with runoff
+            if(activerunoff)then
+
+               runoff(ig) = max(zqsurf(ig,iliq) - mx_eau_sol, 0.0)
+               if(ngrid.gt.1)then ! runoff only exists in 3D
+                  if(runoff(ig).ne.0.0)then
+                     zqsurf(ig,iliq) = mx_eau_sol
+!                    runoff is added to ocean at end
+                  endif
+               end if
+
+            endif
+
+!     re-calculate continental albedo
+            albedo(ig) = albedo0(ig) ! albedo0 = base values
+            if (zqsurf(ig,iice).ge.snowlayer) then
+               albedo(ig) = albedosnow
+            else
+               albedo(ig) = albedo0(ig) &
+                    + (albedosnow - albedo0(ig))*zqsurf(ig,iice)/snowlayer
+            endif
+
+         else
+
+            print*,'Surface type not recognised in hydrol.F!'
+            print*,'Exiting...'
+            call abort
+
+         endif
+
+      end do ! ig=1,ngrid
+
+!     perform crude bulk averaging of temperature in ocean
+!     ----------------------------------------------------
+      if(oceanbulkavg)then
+
+         oceanarea2=0.       
+         DO ig=1,ngrid
+            if((nint(rnat(ig)).eq.0).and.(hice(ig).eq.0.))then
+               oceanarea2=oceanarea2+area(ig)*pcapcal(ig)
+            end if
+         END DO
+       
+         tsea=0.
+         DO ig=1,ngrid
+            if((nint(rnat(ig)).eq.0).and.(hice(ig).eq.0.))then       
+               tsea=tsea+ztsurf(ig)*area(ig)*pcapcal(ig)/oceanarea2
+            end if
+         END DO
+
+         DO ig=1,ngrid
+            if((nint(rnat(ig)).eq.0).and.(hice(ig).eq.0))then
+               pdtsurf_hyd(ig) = pdtsurf_hyd(ig) + (tsea-ztsurf(ig))/oceantime
+            end if
+         END DO
+
+         print*,'Mean ocean temperature               = ',tsea,' K'
+
+      endif
+
+!     shove all the runoff water into the ocean
+!     -----------------------------------------
+      if(activerunoff)then
+
+         totalrunoff=0.
+         do ig=1,ngrid
+            if (nint(rnat(ig)).eq.1) then
+               totalrunoff = totalrunoff + area(ig)*runoff(ig)
+            endif
+         enddo
+         
+         do ig=1,ngrid
+            if (nint(rnat(ig)).eq.0) then
+               zqsurf(ig,iliq) = zqsurf(ig,iliq) + &
+                    totalrunoff/oceanarea
+            endif
+         enddo
+
+      endif         
+
+
+!     Re-add the albedo effects of CO2 ice if necessary
+!     -------------------------------------------------
+      if(co2cond)then
+
+         icap=1
+         do ig=1,ngrid
+            if (qsurf(ig,igcm_co2_ice).gt.0) then
+               albedo(ig) = albedice(icap)
+            endif
+         enddo
+         
+      endif
+
+
+      do ig=1,ngrid
+         dqs_hyd(ig,iliq)=(zqsurf(ig,iliq) - qsurf(ig,iliq))/ptimestep
+         dqs_hyd(ig,iice)=(zqsurf(ig,iice) - qsurf(ig,iice))/ptimestep
+      enddo
+
+      if (activerunoff) then
+        call writediagfi(ngrid,'runoff','Runoff amount',' ',2,runoff)
+      endif
+
+      return
+    end subroutine hydrol
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ini_archive.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ini_archive.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ini_archive.F	(revision 222)
@@ -0,0 +1,530 @@
+c=======================================================================
+      subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi,
+     &                       tab_cntrl_dyn)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:  ecriture de l'entete du fichier "start_archive"
+c   -----
+c
+c	 Proche de iniwrite.F
+c
+c	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
+c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
+c	 du RUN + ptotal et cotoicetotal)
+c
+c			tab_cntrl(50+l)=tab_cntrl_fi(l)
+c
+c   Arguments:
+c   ---------
+c
+c	Inputs:
+c   ------
+c
+c       nid            unite logique du fichier "start_archive"
+c       idayref        Valeur du jour initial a mettre dans
+c                      l'entete du fichier "start_archive"
+c       phis           geopotentiel au sol
+c       ith            soil thermal inertia
+c       tab_cntrl_fi   tableau des param physiques
+c
+
+c=======================================================================
+
+      USE comsoil_h
+!      use control_mod
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "serre.h"
+!#include "control.h"
+
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c   Local:
+c   ------
+      INTEGER	length,l
+      parameter (length = 100)
+      REAL		tab_cntrl(length) ! tableau des parametres du run
+      INTEGER	loop
+      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
+      INTEGER	setdim
+      INTEGER	ind1,indlast
+
+c   Arguments:
+c   ----------
+      INTEGER*4	idayref
+      REAL		phis(ip1jmp1)
+      real ith(ip1jmp1,nsoilmx)
+      REAL		tab_cntrl_fi(length)
+      REAL tab_cntrl_dyn(length)
+
+!Mars --------Ajouts-----------
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3) !, dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_llmp1,idim_llm
+      INTEGER idim_tim
+      INTEGER idim_nsoilmx ! "subsurface_layers" dimension ID #
+      INTEGER nid,nvarid
+      real sig_s(llm),s(llm)
+
+      pi  = 2. * ASIN(1.)
+
+
+c-----------------------------------------------------------------------
+c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      
+      tab_cntrl(1:50)=tab_cntrl_dyn(1:50)
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!      tab_cntrl(1)  = FLOAT(iim) ! nombre de points en longitude
+!      tab_cntrl(2)  = FLOAT(jjm) ! nombre de points en latitude
+!      tab_cntrl(3)  = FLOAT(llm) ! nombre de couches
+!      tab_cntrl(4)  = FLOAT(idayref) ! jour 0
+!      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
+!      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
+!      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
+!      tab_cntrl(8)  = cpp 
+!      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
+!      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
+!      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
+!      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
+!      tab_cntrl(12) = etot0 ! energie totale    !
+!      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
+!      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
+!      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
+!      tab_cntrl(16) = ang0 ! moment cinetique  !
+!      tab_cntrl(17) = pa
+!      tab_cntrl(18) = preff
+
+c    .....    parametres  pour le zoom      ......   
+
+!      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
+!      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
+!      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
+!      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
+
+!      IF ( fxyhypb )   THEN
+!       tab_cntrl(23) = 1.
+!       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+!       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+!      ELSE
+!       tab_cntrl(23) = 0.
+!       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+!       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+!       tab_cntrl(26) = 0.
+!       IF ( ysinus)  tab_cntrl(26) = 1.
+!      ENDIF
+
+c-----------------------------------------------------------------------
+c   Copie du tableau des parametres de controle du RUN  (physique)
+c		dans le tableau tab_cntrl
+c-----------------------------------------------------------------------
+
+      DO l=1,50
+         tab_cntrl(50+l)=tab_cntrl_fi(l)
+      ENDDO
+
+c=======================================================================
+c	Ecriture NetCDF de l''entete du fichier "start_archive"
+c=======================================================================
+
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 21,
+     &                       "Fichier start_archive")
+c
+c Definir les dimensions du fichiers:
+c
+c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+
+      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
+      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid,"interlayer", llmp1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
+
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+
+c-----------------------------------------------------------------------
+c  Ecriture du tableau des parametres du run
+c-----------------------------------------------------------------------
+
+      call def_var(nid,"Time","Time","days since 00:00:00",1,
+     .            idim_tim,nvarid,ierr)
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des longitudes et latitudes
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des niveaux verticaux
+c-----------------------------------------------------------------------
+
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
+     .                       "Coef A: niveaux pression hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 35,
+     .                       "Coefficient B niveaux sigma hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
+     .      "Coef AS: hybrid pressure in midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .      "Coef BS: hybrid sigma midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+c
+c ----------------------
+
+      ierr = NF_REDEF (nid)
+#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_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c ------------------------------------------------------------------
+c  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#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
+c----------------------
+       ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#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
+c--------------------------
+      ierr = NF_REDEF (nid)
+#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",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil.h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+!---------------------
+! soil thermal inertia
+!---------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      dims3(1)=idim_rlonv
+      dims3(2)=idim_rlatu
+      dims3(3)=idim_nsoilmx
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     &                        "Soil thermal inertia")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
+     &                        "J.s-1/2.m-2.K-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture du geopentiel au sol
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+
+      PRINT*,'ini_archive: iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'ini_archive: rad,omeg,g,mugaz,kappa',
+     s rad,omeg,g,tab_cntrl_fi(8),kappa
+      PRINT*,'ini_archive: daysec,dtvr',daysec,dtvr
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniaerosol.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniaerosol.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniaerosol.F	(revision 222)
@@ -0,0 +1,74 @@
+      SUBROUTINE iniaerosol()
+
+
+      use radinc_h, only: naerkind
+      use aerosol_mod
+
+      IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Initialization related to aerosols 
+c   (CO2 aerosols, dust, water, chemical species, ice...)   
+c
+c   author: Laura Kerber, S. Guerlet
+c   ------
+c        
+c=======================================================================
+
+
+#include "callkeys.h"
+      integer ia
+
+      ia=0
+      if (aeroco2) then
+         ia=ia+1
+         iaero_co2=ia
+      endif
+      write(*,*) '--- CO2 aerosol = ', iaero_co2
+ 
+      if (aeroh2o) then
+         ia=ia+1
+         iaero_h2o=ia
+      endif
+      write(*,*) '--- H2O aerosol = ', iaero_h2o
+
+      if (dusttau.gt.0) then
+         ia=ia+1
+         iaero_dust=ia
+      endif
+      write(*,*) '--- Dust aerosol = ', iaero_dust
+
+      if (aeroh2so4) then
+         ia=ia+1
+         iaero_h2so4=ia
+      endif
+      write(*,*) '--- H2SO4 aerosol = ', iaero_h2so4
+      
+      if (aeroback2lay) then
+         ia=ia+1
+         iaero_back2lay=ia
+      endif
+      write(*,*) '--- Two-layer aerosol = ', iaero_back2lay
+
+      write(*,*) '=== Number of aerosols= ', ia
+      
+! For the zero aerosol case, we currently make a dummy co2 aerosol which is zero everywhere.
+! (See aeropacity.F90 for how this works). A better solution would be to turn off the 
+! aerosol machinery in the no aerosol case, but this would be complicated. LK
+
+      if (ia.eq.0) then  !For the zero aerosol case. 
+         ia = 1
+         noaero = .true.
+         iaero_co2=ia
+      endif
+
+      if (ia.ne.naerkind) then
+          print*, 'Aerosols counted not equal to naerkind'
+          print*, 'Compile with tag -s',ia,'to run'
+          print*, 'or change options in callphys.def'
+          print*, 'Abort in iniaerosol.F'
+          call abort
+      endif
+
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/inifis.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/inifis.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/inifis.F	(revision 222)
@@ -0,0 +1,718 @@
+      SUBROUTINE inifis(ngrid,nlayer,nq,
+     $           day_ini,pdaysec,ptimestep,
+     $           plat,plon,parea,
+     $           prad,pg,pr,pcpp)
+
+      use radinc_h, only : naerkind
+      use datafile_mod, only: datadir
+      use comdiurn_h, only: sinlat, coslat, sinlon, coslon
+      use comgeomfi_h, only: long, lati, area, totarea, totarea_planet
+      use comsoil_h, only: ini_comsoil_h
+      use control_mod, only: ecritphy
+      use planetwide_mod, only: planetwide_sumval
+
+!=======================================================================
+!
+!   purpose:
+!   -------
+!
+!   Initialisation for the physical parametrisations of the LMD 
+!   Generic Model.
+!
+!   author: Frederic Hourdin 15 / 10 /93
+!   -------
+!   modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
+!             Ehouarn Millour (oct. 2008) tracers are now identified
+!              by their names and may not be contiguously
+!              stored in the q(:,:,:,:) array
+!             E.M. (june 2009) use getin routine to load parameters
+!
+!
+!   arguments:
+!   ----------
+!
+!   input:
+!   ------
+!
+!    ngrid                 Size of the horizontal grid.
+!                          All internal loops are performed on that grid.
+!    nlayer                Number of vertical layers.
+!    pdayref               Day of reference for the simulation
+!    pday                  Number of days counted from the North. Spring
+!                          equinoxe.
+!
+!=======================================================================
+!
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+      use datafile_mod, only: datadir
+! to use  'getin'
+      USE ioipsl_getincom 
+      IMPLICIT NONE
+#include "dimensions.h"
+#include "dimphys.h"
+#include "planete.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+
+      REAL,INTENT(IN) :: prad,pg,pr,pcpp,pdaysec,ptimestep
+ 
+      INTEGER,INTENT(IN) :: ngrid,nlayer,nq
+      REAL,INTENT(IN) :: plat(ngrid),plon(ngrid),parea(ngrid)
+      integer day_ini
+      INTEGER ig,ierr
+ 
+      EXTERNAL iniorbit,orbite
+      EXTERNAL SSUM
+      REAL SSUM
+ 
+      CHARACTER ch1*12
+      CHARACTER ch80*80
+
+      logical chem, h2o
+      logical :: parameter, doubleq=.false.
+
+      real psurf,pN2 ! added by RW for Gliese 581d N2+CO2
+
+      rad=prad
+      daysec=pdaysec
+      dtphys=ptimestep
+      cpp=pcpp
+      g=pg
+      r=pr
+      rcp=r/cpp
+
+      avocado = 6.02214179e23   ! added by RW
+
+! --------------------------------------------------------
+!     The usual Tests
+!     --------------
+      IF (nlayer.NE.nlayermx) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'nlayer     = ',nlayer
+         PRINT*,'nlayermx   = ',nlayermx
+         STOP
+      ENDIF
+
+      ! read in 'ecritphy' (frequency of calls to physics, in dynamical steps)
+      ! (also done in dyn3d/defrun_new but not in LMDZ.COMMON)
+      call getin("ecritphy",ecritphy)
+
+! --------------------------------------------------------------
+!  Reading the "callphys.def" file controlling some key options
+! --------------------------------------------------------------
+     
+      ! check that 'callphys.def' file is around
+      OPEN(99,file='callphys.def',status='old',form='formatted'
+     &     ,iostat=ierr)
+      CLOSE(99)
+      
+      IF(ierr.EQ.0) THEN
+         PRINT*
+         PRINT*
+         PRINT*,'--------------------------------------------'
+         PRINT*,' inifis: Parametres pour la physique (callphys.def)'
+         PRINT*,'--------------------------------------------'
+
+         write(*,*) "Directory where external input files are:"
+         ! default 'datadir' is set in "datadir_mod"
+         call getin("datadir",datadir) ! default path
+         write(*,*) " datadir = ",trim(datadir)
+
+         write(*,*) "Run with or without tracer transport ?"
+         tracer=.false. ! default value
+         call getin("tracer",tracer)
+         write(*,*) " tracer = ",tracer
+
+         write(*,*) "Run with or without atm mass update ",
+     &      " due to tracer evaporation/condensation?"
+         mass_redistrib=.false. ! default value
+         call getin("mass_redistrib",mass_redistrib)
+         write(*,*) " mass_redistrib = ",mass_redistrib
+
+         write(*,*) "Diurnal cycle ?"
+         write(*,*) "(if diurnal=false, diurnal averaged solar heating)"
+         diurnal=.true. ! default value
+         call getin("diurnal",diurnal)
+         write(*,*) " diurnal = ",diurnal
+
+         write(*,*) "Seasonal cycle ?"
+         write(*,*) "(if season=false, Ls stays constant, to value ",
+     &   "set in 'start'"
+         season=.true. ! default value
+         call getin("season",season)
+         write(*,*) " season = ",season
+
+         write(*,*) "Tidally resonant rotation ?"
+         tlocked=.false. ! default value
+         call getin("tlocked",tlocked)
+         write(*,*) "tlocked = ",tlocked
+
+         write(*,*) "Saturn ring shadowing ?"
+         rings_shadow = .false.
+         call getin("rings_shadow", rings_shadow)
+         write(*,*) "rings_shadow = ", rings_shadow
+         
+         write(*,*) "Compute latitude-dependent gravity field?"
+         oblate = .false.
+         call getin("oblate", oblate)
+         write(*,*) "oblate = ", oblate
+
+         write(*,*) "Flattening of the planet (a-b)/a "
+         flatten = 0.0
+         call getin("flatten", flatten)
+         write(*,*) "flatten = ", flatten
+         
+
+         write(*,*) "Needed if oblate=.true.: J2"
+         J2 = 0.0
+         call getin("J2", J2)
+         write(*,*) "J2 = ", J2
+         
+         write(*,*) "Needed if oblate=.true.: Planet mass (*1e24 kg)"
+         MassPlanet = 0.0
+         call getin("MassPlanet", MassPlanet)
+         write(*,*) "MassPlanet = ", MassPlanet         
+
+         write(*,*) "Needed if oblate=.true.: Planet mean radius (m)"
+         Rmean = 0.0
+         call getin("Rmean", Rmean)
+         write(*,*) "Rmean = ", Rmean
+         
+! Test of incompatibility:
+! if tlocked, then diurnal should be false
+         if (tlocked.and.diurnal) then
+           print*,'If diurnal=true, we should turn off tlocked.'
+           stop
+         endif
+
+         write(*,*) "Tidal resonance ratio ?"
+         nres=0          ! default value
+         call getin("nres",nres)
+         write(*,*) "nres = ",nres
+
+         write(*,*) "Write some extra output to the screen ?"
+         lwrite=.false. ! default value
+         call getin("lwrite",lwrite)
+         write(*,*) " lwrite = ",lwrite
+
+         write(*,*) "Save statistics in file stats.nc ?"
+         callstats=.true. ! default value
+         call getin("callstats",callstats)
+         write(*,*) " callstats = ",callstats
+
+         write(*,*) "Test energy conservation of model physics ?"
+         enertest=.false. ! default value
+         call getin("enertest",enertest)
+         write(*,*) " enertest = ",enertest
+
+         write(*,*) "Check to see if cpp values used match gases.def ?"
+         check_cpp_match=.true. ! default value
+         call getin("check_cpp_match",check_cpp_match)
+         write(*,*) " check_cpp_match = ",check_cpp_match
+
+         write(*,*) "call radiative transfer ?"
+         callrad=.true. ! default value
+         call getin("callrad",callrad)
+         write(*,*) " callrad = ",callrad
+
+         write(*,*) "call correlated-k radiative transfer ?"
+         corrk=.true. ! default value
+         call getin("corrk",corrk)
+         write(*,*) " corrk = ",corrk
+
+         write(*,*) "prohibit calculations outside corrk T grid?"
+         strictboundcorrk=.true. ! default value
+         call getin("strictboundcorrk",strictboundcorrk)
+         write(*,*) "strictboundcorrk = ",strictboundcorrk
+
+         write(*,*) "call gaseous absorption in the visible bands?",
+     &              "(matters only if callrad=T)"
+         callgasvis=.false. ! default value
+         call getin("callgasvis",callgasvis)
+         write(*,*) " callgasvis = ",callgasvis
+        
+         write(*,*) "call continuum opacities in radiative transfer ?",
+     &              "(matters only if callrad=T)"
+         continuum=.true. ! default value
+         call getin("continuum",continuum)
+         write(*,*) " continuum = ",continuum
+
+         write(*,*) "use analytic function for H2O continuum ?"
+         H2Ocont_simple=.false. ! default value
+         call getin("H2Ocont_simple",H2Ocont_simple)
+         write(*,*) " H2Ocont_simple = ",H2Ocont_simple
+ 
+         write(*,*) "call turbulent vertical diffusion ?"
+         calldifv=.true. ! default value
+         call getin("calldifv",calldifv)
+         write(*,*) " calldifv = ",calldifv
+
+         write(*,*) "use turbdiff instead of vdifc ?"
+         UseTurbDiff=.true. ! default value
+         call getin("UseTurbDiff",UseTurbDiff)
+         write(*,*) " UseTurbDiff = ",UseTurbDiff
+
+         write(*,*) "call convective adjustment ?"
+         calladj=.true. ! default value
+         call getin("calladj",calladj)
+         write(*,*) " calladj = ",calladj
+
+         write(*,*) "call CO2 condensation ?"
+         co2cond=.false. ! default value
+         call getin("co2cond",co2cond)
+         write(*,*) " co2cond = ",co2cond
+! Test of incompatibility
+         if (co2cond.and.(.not.tracer)) then
+            print*,'We need a CO2 ice tracer to condense CO2'
+            call abort
+         endif 
+ 
+         write(*,*) "CO2 supersaturation level ?"
+         co2supsat=1.0 ! default value
+         call getin("co2supsat",co2supsat)
+         write(*,*) " co2supsat = ",co2supsat
+
+         write(*,*) "Radiative timescale for Newtonian cooling ?"
+         tau_relax=30. ! default value
+         call getin("tau_relax",tau_relax)
+         write(*,*) " tau_relax = ",tau_relax
+         tau_relax=tau_relax*24*3600 ! convert Earth days --> seconds
+
+         write(*,*)"call thermal conduction in the soil ?"
+         callsoil=.true. ! default value
+         call getin("callsoil",callsoil)
+         write(*,*) " callsoil = ",callsoil
+         
+         write(*,*)"Rad transfer is computed every iradia",
+     &             " physical timestep"
+         iradia=1 ! default value
+         call getin("iradia",iradia)
+         write(*,*)" iradia = ",iradia
+       
+         write(*,*)"Rayleigh scattering ?"
+         rayleigh=.false.
+         call getin("rayleigh",rayleigh)
+         write(*,*)" rayleigh = ",rayleigh
+
+         write(*,*) "Use blackbody for stellar spectrum ?"
+         stelbbody=.false. ! default value
+         call getin("stelbbody",stelbbody)
+         write(*,*) " stelbbody = ",stelbbody
+
+         write(*,*) "Stellar blackbody temperature ?"
+         stelTbb=5800.0 ! default value
+         call getin("stelTbb",stelTbb)
+         write(*,*) " stelTbb = ",stelTbb
+
+         write(*,*)"Output mean OLR in 1D?"
+         meanOLR=.false.
+         call getin("meanOLR",meanOLR)
+         write(*,*)" meanOLR = ",meanOLR
+
+         write(*,*)"Output spectral OLR in 3D?"
+         specOLR=.false.
+         call getin("specOLR",specOLR)
+         write(*,*)" specOLR = ",specOLR
+
+         write(*,*)"Operate in kastprof mode?"
+         kastprof=.false.
+         call getin("kastprof",kastprof)
+         write(*,*)" kastprof = ",kastprof
+
+         write(*,*)"Uniform absorption in radiative transfer?"
+         graybody=.false.
+         call getin("graybody",graybody)
+         write(*,*)" graybody = ",graybody
+
+! Slab Ocean 
+         write(*,*) "Use slab-ocean ?"
+         ok_slab_ocean=.false.         ! default value
+         call getin("ok_slab_ocean",ok_slab_ocean)
+         write(*,*) "ok_slab_ocean = ",ok_slab_ocean
+
+         write(*,*) "Use slab-sea-ice ?"
+         ok_slab_sic=.true.         ! default value
+         call getin("ok_slab_sic",ok_slab_sic)
+         write(*,*) "ok_slab_sic = ",ok_slab_sic
+
+         write(*,*) "Use heat transport for the ocean ?"
+         ok_slab_heat_transp=.true.   ! default value
+         call getin("ok_slab_heat_transp",ok_slab_heat_transp)
+         write(*,*) "ok_slab_heat_transp = ",ok_slab_heat_transp
+
+
+
+! Test of incompatibility:
+! if kastprof used, we must be in 1D
+         if (kastprof.and.(ngrid.gt.1)) then
+           print*,'kastprof can only be used in 1D!'
+           call abort
+         endif
+
+         write(*,*)"Stratospheric temperature for kastprof mode?"
+         Tstrat=167.0
+         call getin("Tstrat",Tstrat)
+         write(*,*)" Tstrat = ",Tstrat
+
+         write(*,*)"Remove lower boundary?"
+         nosurf=.false.
+         call getin("nosurf",nosurf)
+         write(*,*)" nosurf = ",nosurf
+
+! Tests of incompatibility:
+         if (nosurf.and.callsoil) then
+           print*,'nosurf not compatible with soil scheme!'
+           print*,'... got to make a choice!'
+           call abort
+         endif
+
+         write(*,*)"Add an internal heat flux?",
+     .             "... matters only if callsoil=F"
+         intheat=0.
+         call getin("intheat",intheat)
+         write(*,*)" intheat = ",intheat
+
+         write(*,*)"Use Newtonian cooling for radiative transfer?"
+         newtonian=.false.
+         call getin("newtonian",newtonian)
+         write(*,*)" newtonian = ",newtonian
+
+! Tests of incompatibility:
+         if (newtonian.and.corrk) then
+           print*,'newtonian not compatible with correlated-k!'
+           call abort
+         endif
+         if (newtonian.and.calladj) then
+           print*,'newtonian not compatible with adjustment!'
+           call abort
+         endif
+         if (newtonian.and.calldifv) then
+           print*,'newtonian not compatible with a boundary layer!'
+           call abort
+         endif
+
+         write(*,*)"Test physics timescale in 1D?"
+         testradtimes=.false.
+         call getin("testradtimes",testradtimes)
+         write(*,*)" testradtimes = ",testradtimes
+
+! Test of incompatibility:
+! if testradtimes used, we must be in 1D
+         if (testradtimes.and.(ngrid.gt.1)) then
+           print*,'testradtimes can only be used in 1D!'
+           call abort
+         endif
+
+         write(*,*)"Default planetary temperature?"
+         tplanet=215.0
+         call getin("tplanet",tplanet)
+         write(*,*)" tplanet = ",tplanet
+
+         write(*,*)"Which star?"
+         startype=1 ! default value = Sol
+         call getin("startype",startype)
+         write(*,*)" startype = ",startype
+
+         write(*,*)"Value of stellar flux at 1 AU?"
+         Fat1AU=1356.0 ! default value = Sol today
+         call getin("Fat1AU",Fat1AU)
+         write(*,*)" Fat1AU = ",Fat1AU
+
+
+! TRACERS:
+
+         write(*,*)"Varying H2O cloud fraction?"
+         CLFvarying=.false.     ! default value
+         call getin("CLFvarying",CLFvarying)
+         write(*,*)" CLFvarying = ",CLFvarying
+
+         write(*,*)"Value of fixed H2O cloud fraction?"
+         CLFfixval=1.0                ! default value
+         call getin("CLFfixval",CLFfixval)
+         write(*,*)" CLFfixval = ",CLFfixval
+
+         write(*,*)"fixed radii for Cloud particles?"
+         radfixed=.false. ! default value
+         call getin("radfixed",radfixed)
+         write(*,*)" radfixed = ",radfixed
+
+         if(kastprof)then
+            radfixed=.true.
+         endif  
+
+	 write(*,*)"Number mixing ratio of CO2 ice particles:"
+         Nmix_co2=1.e6 ! default value
+         call getin("Nmix_co2",Nmix_co2)
+         write(*,*)" Nmix_co2 = ",Nmix_co2
+
+!         write(*,*)"Number of radiatively active aerosols:"
+!         naerkind=0. ! default value
+!         call getin("naerkind",naerkind)
+!         write(*,*)" naerkind = ",naerkind
+
+         write(*,*)"Opacity of dust (if used):"
+         dusttau=0. ! default value
+         call getin("dusttau",dusttau)
+         write(*,*)" dusttau = ",dusttau
+
+         write(*,*)"Radiatively active CO2 aerosols?"
+         aeroco2=.false.     ! default value
+         call getin("aeroco2",aeroco2)
+         write(*,*)" aeroco2 = ",aeroco2
+
+         write(*,*)"Fixed CO2 aerosol distribution?"
+         aerofixco2=.false.     ! default value
+         call getin("aerofixco2",aerofixco2)
+         write(*,*)" aerofixco2 = ",aerofixco2
+
+         write(*,*)"Radiatively active water ice?"
+         aeroh2o=.false.     ! default value
+         call getin("aeroh2o",aeroh2o)
+         write(*,*)" aeroh2o = ",aeroh2o
+
+         write(*,*)"Fixed H2O aerosol distribution?"
+         aerofixh2o=.false.     ! default value
+         call getin("aerofixh2o",aerofixh2o)
+         write(*,*)" aerofixh2o = ",aerofixh2o
+
+         write(*,*)"Radiatively active sulfuric acid aersols?"
+         aeroh2so4=.false.     ! default value
+         call getin("aeroh2so4",aeroh2so4)
+         write(*,*)" aeroh2so4 = ",aeroh2so4
+	 
+!=================================
+
+	 write(*,*)"Radiatively active two-layer aersols?"
+         aeroback2lay=.false.     ! default value
+         call getin("aeroback2lay",aeroback2lay)
+         write(*,*)" aeroback2lay = ",aeroback2lay
+
+         write(*,*)"TWOLAY AEROSOL: total optical depth ",
+     &              "in the tropospheric layer (visible)"
+         obs_tau_col_tropo=8.D0
+         call getin("obs_tau_col_tropo",obs_tau_col_tropo)
+         write(*,*)" obs_tau_col_tropo = ",obs_tau_col_tropo
+
+         write(*,*)"TWOLAY AEROSOL: total optical depth ",
+     &              "in the stratospheric layer (visible)"
+         obs_tau_col_strato=0.08D0
+         call getin("obs_tau_col_strato",obs_tau_col_strato)
+         write(*,*)" obs_tau_col_strato = ",obs_tau_col_strato
+
+         write(*,*)"TWOLAY AEROSOL: pres_bottom_tropo? in pa"
+         pres_bottom_tropo=66000.0
+         call getin("pres_bottom_tropo",pres_bottom_tropo)
+         write(*,*)" pres_bottom_tropo = ",pres_bottom_tropo
+
+         write(*,*)"TWOLAY AEROSOL: pres_top_tropo? in pa"
+         pres_top_tropo=18000.0
+         call getin("pres_top_tropo",pres_top_tropo)
+         write(*,*)" pres_top_tropo = ",pres_top_tropo
+
+         write(*,*)"TWOLAY AEROSOL: pres_bottom_strato? in pa"
+         pres_bottom_strato=2000.0
+         call getin("pres_bottom_strato",pres_bottom_strato)
+         write(*,*)" pres_bottom_strato = ",pres_bottom_strato
+
+         write(*,*)"TWOLAY AEROSOL: pres_top_strato? in pa"
+         pres_top_strato=100.0
+         call getin("pres_top_strato",pres_top_strato)
+         write(*,*)" pres_top_strato = ",pres_top_strato
+
+         write(*,*)"TWOLAY AEROSOL: particle size in the ",
+     &              "tropospheric layer, in meters"
+         size_tropo=2.e-6
+         call getin("size_tropo",size_tropo)
+         write(*,*)" size_tropo = ",size_tropo
+
+         write(*,*)"TWOLAY AEROSOL: particle size in the ",
+     &              "stratospheric layer, in meters"
+         size_strato=1.e-7
+         call getin("size_strato",size_strato)
+         write(*,*)" size_strato = ",size_strato
+
+!=================================
+
+         write(*,*)"Cloud pressure level (with kastprof only):"
+         cloudlvl=0. ! default value
+         call getin("cloudlvl",cloudlvl)
+         write(*,*)" cloudlvl = ",cloudlvl
+
+         write(*,*)"Is the variable gas species radiatively active?"
+         Tstrat=167.0
+         varactive=.false.
+         call getin("varactive",varactive)
+         write(*,*)" varactive = ",varactive
+
+         write(*,*)"Is the variable gas species distribution set?"
+         varfixed=.false.
+         call getin("varfixed",varfixed)
+         write(*,*)" varfixed = ",varfixed
+
+         write(*,*)"What is the saturation % of the variable species?"
+         satval=0.8
+         call getin("satval",satval)
+         write(*,*)" satval = ",satval
+
+
+! Test of incompatibility:
+! if varactive, then varfixed should be false
+         if (varactive.and.varfixed) then
+           print*,'if varactive, varfixed must be OFF!'
+           stop
+         endif
+
+         write(*,*) "Gravitationnal sedimentation ?"
+         sedimentation=.false. ! default value
+         call getin("sedimentation",sedimentation)
+         write(*,*) " sedimentation = ",sedimentation
+
+         write(*,*) "Compute water cycle ?"
+         water=.false. ! default value
+         call getin("water",water)
+         write(*,*) " water = ",water
+         
+! Test of incompatibility:
+! if water is true, there should be at least a tracer
+         if (water.and.(.not.tracer)) then
+           print*,'if water is ON, tracer must be ON too!'
+           stop
+         endif
+
+         write(*,*) "Include water condensation ?"
+         watercond=.false. ! default value
+         call getin("watercond",watercond)
+         write(*,*) " watercond = ",watercond
+
+! Test of incompatibility:
+! if watercond is used, then water should be used too
+         if (watercond.and.(.not.water)) then
+           print*,'if watercond is used, water should be used too'
+           stop
+         endif
+
+         write(*,*) "Include water precipitation ?"
+         waterrain=.false. ! default value
+         call getin("waterrain",waterrain)
+         write(*,*) " waterrain = ",waterrain
+
+         write(*,*) "Include surface hydrology ?"
+         hydrology=.false. ! default value
+         call getin("hydrology",hydrology)
+         write(*,*) " hydrology = ",hydrology
+
+         write(*,*) "Evolve surface water sources ?"
+         sourceevol=.false. ! default value
+         call getin("sourceevol",sourceevol)
+         write(*,*) " sourceevol = ",sourceevol
+
+         write(*,*) "Ice evolution timestep ?"
+         icetstep=100.0 ! default value
+         call getin("icetstep",icetstep)
+         write(*,*) " icetstep = ",icetstep
+
+         write(*,*) "Snow albedo ?"
+         albedosnow=0.5         ! default value
+         call getin("albedosnow",albedosnow)
+         write(*,*) " albedosnow = ",albedosnow
+
+         write(*,*) "Maximum ice thickness ?"
+         maxicethick=2.0         ! default value
+         call getin("maxicethick",maxicethick)
+         write(*,*) " maxicethick = ",maxicethick
+
+         write(*,*) "Freezing point of seawater ?"
+         Tsaldiff=-1.8          ! default value
+         call getin("Tsaldiff",Tsaldiff)
+         write(*,*) " Tsaldiff = ",Tsaldiff
+
+         write(*,*) "Does user want to force cpp and mugaz?"
+         force_cpp=.false. ! default value
+         call getin("force_cpp",force_cpp)
+         write(*,*) " force_cpp = ",force_cpp
+
+         if (force_cpp) then
+           mugaz = -99999.
+           PRINT *,'MEAN MOLECULAR MASS in g mol-1 ?'
+           call getin("mugaz",mugaz)
+           IF (mugaz.eq.-99999.) THEN
+               PRINT *, "mugaz must be set if force_cpp = T"
+               STOP
+           ELSE
+               write(*,*) "mugaz=",mugaz
+           ENDIF
+           cpp = -99999.
+           PRINT *,'SPECIFIC HEAT CAPACITY in J K-1 kg-1 ?'
+           call getin("cpp",cpp)
+           IF (cpp.eq.-99999.) THEN
+               PRINT *, "cpp must be set if force_cpp = T"
+               STOP
+           ELSE
+               write(*,*) "cpp=",cpp
+           ENDIF
+!         else
+!           mugaz=8.314*1000./pr
+         endif
+         call su_gases
+         call calc_cpp_mugaz
+
+         PRINT*,'--------------------------------------------'
+         PRINT*
+         PRINT*
+      ELSE
+         write(*,*)
+         write(*,*) 'Cannot read file callphys.def. Is it here ?'
+         stop
+      ENDIF
+
+8000  FORMAT(t5,a12,l8)
+8001  FORMAT(t5,a12,i8)
+
+      PRINT*
+      PRINT*,'inifis: daysec',daysec
+      PRINT*
+      PRINT*,'inifis: The radiative transfer is computed:'
+      PRINT*,'           each ',iradia,' physical time-step'
+      PRINT*,'        or each ',iradia*dtphys,' seconds'
+      PRINT*
+
+
+!-----------------------------------------------------------------------
+!     Some more initialization:
+!     ------------------------
+
+      ! ALLOCATE ARRAYS IN comgeomfi_h
+      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(ngrid))
+      IF (.not. ALLOCATED(long)) ALLOCATE(long(ngrid))
+      IF (.not. ALLOCATED(area)) ALLOCATE(area(ngrid))
+
+      CALL SCOPY(ngrid,plon,1,long,1)
+      CALL SCOPY(ngrid,plat,1,lati,1)
+      CALL SCOPY(ngrid,parea,1,area,1)
+      totarea=SSUM(ngrid,area,1)
+      call planetwide_sumval(area,totarea_planet)
+
+      !! those are defined in comdiurn_h.F90
+      IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(ngrid))
+      IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(ngrid))
+      IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(ngrid))
+      IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(ngrid))
+
+      DO ig=1,ngrid
+         sinlat(ig)=sin(plat(ig))
+         coslat(ig)=cos(plat(ig))
+         sinlon(ig)=sin(plon(ig))
+         coslon(ig)=cos(plon(ig))
+      ENDDO
+
+      pi=2.*asin(1.) ! NB: pi is a common in comcstfi.h
+
+      ! allocate "comsoil_h" arrays
+      call ini_comsoil_h(ngrid)
+      
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniorbit.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniorbit.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniorbit.F	(revision 222)
@@ -0,0 +1,121 @@
+      SUBROUTINE iniorbit
+     $     (papoastr,pperiastr,pyear_day,pperi_day,pobliq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:
+c   -------
+c     Frederic Hourdin      22 Fevrier 1991
+c
+c   Objet:
+c   ------
+c    Initialisation du sous programme orbite qui calcule
+c    a une date donnee de l'annee de duree year_day commencant
+c    a l'equinoxe de printemps et dont le periastre se situe
+c    a la date peri_day, la distance au soleil et la declinaison.
+c
+c   Interface:
+c   ----------
+c   - Doit etre appele avant d'utiliser orbite.
+c   - initialise une partie du common planete.h
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   apoastr       \   apoastron and periastron of the orbit in AU
+c   periastr      /   
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c   Arguments:
+c   ----------
+
+      REAL papoastr,pperiastr,pyear_day,pperi_day,pobliq
+
+c   Local:
+c   ------
+
+      REAL zxref,zanom,zz,zx0,zdx
+      INTEGER iter
+
+c-----------------------------------------------------------------------
+
+      pi=2.*asin(1.)
+
+      apoastr =papoastr
+      periastr=pperiastr
+      year_day=pyear_day
+      obliquit=pobliq
+      peri_day=pperi_day
+
+
+      !!!! SPARADRAP TEMPORAIRE !!!!
+      !!!! SPARADRAP TEMPORAIRE !!!!
+      !!!! We hope that all cases are above 25 Mkm [OK with Gliese 581d]
+      IF ( apoastr .gt. 25.) THEN
+        PRINT*,'!!!!! WARNING !!!!!'
+        PRINT*,'!!!!! YOU ARE ABOUT TO WITNESS A DIRT HACK !!!!!'
+        PRINT*,'This must be an old start file.'
+        PRINT*,'The code changed 19/03/2012: we now use AU.'
+        PRINT*,'So I am assuming units are in Mkm here'
+        PRINT*,'and I am performing a conversion towards AU.'
+        periastr = periastr / 149.598 ! Mkm to AU
+        apoastr = apoastr / 149.598 ! Mkm to AU
+      ENDIF
+      !!!! SPARADRAP TEMPORAIRE !!!!
+      !!!! SPARADRAP TEMPORAIRE !!!!
+
+ 
+      PRINT*,'Periastron in AU  ',periastr
+      PRINT*,'Apoastron in AU  ',apoastr 
+      PRINT*,'Obliquity in degrees  :',obliquit
+
+
+      e_elips=(apoastr-periastr)/(periastr+apoastr)
+      p_elips=0.5*(periastr+apoastr)*(1-e_elips*e_elips)
+
+      print*,'e_elips',e_elips
+      print*,'p_elips',p_elips
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(year_day-pperi_day)/year_day
+      zanom=2.*pi*(zz-nint(zz))
+      zxref=abs(zanom)
+      PRINT*,'zanom  ',zanom
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = zxref
+c  methode de Newton
+
+      zx0=zxref+e_elips*sin(zxref)
+      DO 110 iter=1,100
+         zdx=-(zx0-e_elips*sin(zx0)-zxref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-12)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+      PRINT*,'zx0   ',zx0
+
+c zteta est la longitude solaire
+
+      timeperi=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+      PRINT*,'Solar longitude of periastron timeperi = ',timeperi
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniphysiq.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniphysiq.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniphysiq.F90	(revision 222)
@@ -0,0 +1,78 @@
+subroutine iniphysiq(ngrid,nlayer, punjours, pdayref,ptimestep,          &
+                     plat,plon,parea,pcu,pcv,                            &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+use dimphy, only : klev ! number of atmospheric levels
+use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
+                                       ! (on full grid)
+use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
+                               klon_omp_begin, & ! start index of local omp subgrid
+                               klon_omp_end, & ! end index of local omp subgrid
+                               klon_mpi_begin, & ! start indes of columns (on local mpi grid)
+                               klon_mpi
+use comgeomphy, only : airephy, & ! physics grid area (m2)
+                       cuphy, & ! cu coeff. (u_covariant = cu * u)
+                       cvphy, & ! cv coeff. (v_covariant = cv * v)
+                       rlond, & ! longitudes
+                       rlatd ! latitudes
+use infotrac, only : nqtot ! number of advected tracers
+
+implicit none
+
+real,intent(in) :: prad ! radius of the planet (m)
+real,intent(in) :: pg ! gravitational acceleration (m/s2)
+real,intent(in) :: pr ! ! reduced gas constant R/mu
+real,intent(in) :: pcpp ! specific heat Cp
+real,intent(in) :: punjours ! length (in s) of a standard day
+integer,intent(in) :: ngrid ! number of horizontal grid points in the physics (full grid)
+integer,intent(in) :: nlayer ! number of atmospheric layers
+real,intent(in) :: plat(klon_mpi) ! latitudes of the physics grid
+real,intent(in) :: plon(klon_mpi) ! longitudes of the physics grid
+real,intent(in) :: parea(klon_mpi) ! area (m2)
+real,intent(in) :: pcu(klon_mpi) ! cu coeff. (u_covariant = cu * u)
+real,intent(in) :: pcv(klon_mpi) ! cv coeff. (v_covariant = cv * v)
+integer,intent(in) :: pdayref ! reference day of for the simulation
+real,intent(in) :: ptimestep !physics time step (s)
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer :: ibegin,iend,offset
+character(len=20) :: modname='iniphysiq'
+character(len=80) :: abort_message
+
+IF (nlayer.NE.klev) THEN
+  write(*,*) 'STOP in ',trim(modname)
+  write(*,*) 'Problem with dimensions :'
+  write(*,*) 'nlayer     = ',nlayer
+  write(*,*) 'klev   = ',klev
+  abort_message = ''
+  CALL abort_gcm (modname,abort_message,1)
+ENDIF
+
+IF (ngrid.NE.klon_glo) THEN
+  write(*,*) 'STOP in ',trim(modname)
+  write(*,*) 'Problem with dimensions :'
+  write(*,*) 'ngrid     = ',ngrid
+  write(*,*) 'klon   = ',klon_glo
+  abort_message = ''
+  CALL abort_gcm (modname,abort_message,1)
+ENDIF
+
+!$OMP PARALLEL PRIVATE(ibegin,iend) 
+!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
+      
+offset=0
+airephy(1:klon_omp)=parea(offset+klon_omp_begin:offset+klon_omp_end)
+cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
+cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
+rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
+rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+call inifis(klon_omp,nlayer,nqtot,pdayref,punjours,ptimestep, &
+            rlatd,rlond,airephy,prad,pg,pr,pcpp)
+
+!$OMP END PARALLEL
+
+
+end subroutine iniphysiq
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniphysiq.F90.orig
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniphysiq.F90.orig	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniphysiq.F90.orig	(revision 222)
@@ -0,0 +1,77 @@
+subroutine iniphysiq(ngrid,nlayer, punjours, pdayref,ptimestep,          &
+                     plat,plon,parea,pcu,pcv,                            &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+use dimphy, only : klev ! number of atmospheric levels
+use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
+                                       ! (on full grid)
+use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
+                               klon_omp_begin, & ! start index of local omp subgrid
+                               klon_omp_end, & ! end index of local omp subgrid
+                               klon_mpi_begin ! start indes of columns (on local mpi grid)
+use comgeomphy, only : airephy, & ! physics grid area (m2)
+                       cuphy, & ! cu coeff. (u_covariant = cu * u)
+                       cvphy, & ! cv coeff. (v_covariant = cv * v)
+                       rlond, & ! longitudes
+                       rlatd ! latitudes
+use infotrac, only : nqtot ! number of advected tracers
+
+implicit none
+
+real,intent(in) :: prad ! radius of the planet (m)
+real,intent(in) :: pg ! gravitational acceleration (m/s2)
+real,intent(in) :: pr ! ! reduced gas constant R/mu
+real,intent(in) :: pcpp ! specific heat Cp
+real,intent(in) :: punjours ! length (in s) of a standard day
+integer,intent(in) :: ngrid ! number of horizontal grid points in the physics (full grid)
+integer,intent(in) :: nlayer ! number of atmospheric layers
+real,intent(in) :: plat(ngrid) ! latitudes of the physics grid
+real,intent(in) :: plon(ngrid) ! longitudes of the physics grid
+real,intent(in) :: parea(klon_glo) ! area (m2)
+real,intent(in) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
+real,intent(in) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
+integer,intent(in) :: pdayref ! reference day of for the simulation
+real,intent(in) :: ptimestep !physics time step (s)
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer :: ibegin,iend,offset
+character(len=20) :: modname='iniphysiq'
+character(len=80) :: abort_message
+
+IF (nlayer.NE.klev) THEN
+  write(*,*) 'STOP in ',trim(modname)
+  write(*,*) 'Problem with dimensions :'
+  write(*,*) 'nlayer     = ',nlayer
+  write(*,*) 'klev   = ',klev
+  abort_message = ''
+  CALL abort_gcm (modname,abort_message,1)
+ENDIF
+
+IF (ngrid.NE.klon_glo) THEN
+  write(*,*) 'STOP in ',trim(modname)
+  write(*,*) 'Problem with dimensions :'
+  write(*,*) 'ngrid     = ',ngrid
+  write(*,*) 'klon   = ',klon_glo
+  abort_message = ''
+  CALL abort_gcm (modname,abort_message,1)
+ENDIF
+
+!$OMP PARALLEL PRIVATE(ibegin,iend) 
+!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
+      
+offset=klon_mpi_begin-1
+airephy(1:klon_omp)=parea(offset+klon_omp_begin:offset+klon_omp_end)
+cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
+cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
+rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
+rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+call inifis(klon_omp,nlayer,nqtot,pdayref,punjours,ptimestep, &
+            rlatd,rlond,airephy,prad,pg,pr,pcpp)
+
+!$OMP END PARALLEL
+
+
+end subroutine iniphysiq
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/inistats.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/inistats.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/inistats.F	(revision 222)
@@ -0,0 +1,118 @@
+      subroutine inistats(ierr)
+
+      use mod_phys_lmdz_para, only : is_master
+      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
+
+      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)=-10.*log(presnivs(l)/preff)   
+      enddo
+
+      if (is_master) then
+      ! only the master needs do this
+
+      ierr = NF_CREATE("stats.nc",IOR(NF_CLOBBER,NF_64BIT_OFFSET),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",
+     &            "days 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)
+#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)
+
+      endif ! of if (is_master)
+      end subroutine inistats
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/init_phys_lmdz.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/init_phys_lmdz.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/init_phys_lmdz.F90	(revision 222)
@@ -0,0 +1,27 @@
+!
+! $Id$
+!
+SUBROUTINE init_phys_lmdz(iim,jjp1,llm,nb_proc,distrib)
+  USE mod_phys_lmdz_omp_data, only: klon_omp
+  USE mod_grid_phy_lmdz, only: nbp_lev
+  USE mod_phys_lmdz_para, only: init_phys_lmdz_para
+  USE mod_grid_phy_lmdz, only: init_grid_phy_lmdz
+  USE dimphy, ONLY : init_dimphy
+
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: llm
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+
+    CALL init_grid_phy_lmdz(iim,jjp1,sum(distrib),llm)
+    CALL init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL init_dimphy(klon_omp,nbp_lev)
+
+!$OMP END PARALLEL
+ 
+END SUBROUTINE init_phys_lmdz  
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/init_phys_lmdz.F90.orig
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/init_phys_lmdz.F90.orig	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/init_phys_lmdz.F90.orig	(revision 222)
@@ -0,0 +1,27 @@
+!
+! $Id$
+!
+SUBROUTINE init_phys_lmdz(iim,jjp1,llm,nb_proc,distrib)
+  USE mod_phys_lmdz_omp_data, only: klon_omp
+  USE mod_grid_phy_lmdz, only: nbp_lev
+  USE mod_phys_lmdz_para, only: init_phys_lmdz_para
+  USE mod_grid_phy_lmdz, only: init_grid_phy_lmdz
+  USE dimphy, ONLY : init_dimphy
+
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: llm
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+
+    CALL init_grid_phy_lmdz(iim,jjp1,llm)
+    CALL init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL init_dimphy(klon_omp,nbp_lev)
+
+!$OMP END PARALLEL
+ 
+END SUBROUTINE init_phys_lmdz  
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/initracer.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/initracer.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/initracer.F	(revision 222)
@@ -0,0 +1,348 @@
+      SUBROUTINE initracer(ngrid,nq,nametrac)
+
+      use surfdat_h
+      USE comgeomfi_h
+      USE tracer_h
+      IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Initialization related to tracer 
+c   (transported dust, water, chemical species, ice...)
+c
+c   Name of the tracer
+c
+c   Test of dimension :
+c   Initialize COMMON tracer in tracer.h, using tracer names provided
+c   by the argument nametrac
+c
+c   author: F.Forget
+c   ------
+c            Ehouarn Millour (oct. 2008) identify tracers by their names
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+      integer :: ngrid,nq
+
+!      real qsurf(ngrid,nq)       ! tracer on surface (e.g.  kg.m-2)
+!      real co2ice(ngrid)           ! co2 ice mass on surface (e.g.  kg.m-2)
+      character(len=20) :: txt ! to store some text
+      integer iq,ig,count
+      real r0_lift , reff_lift
+!      logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+
+      character*20 nametrac(nq)   ! name of the tracer from dynamics
+
+
+c-----------------------------------------------------------------------
+c  radius(nq)      ! aerosol particle radius (m)
+c  rho_q(nq)       ! tracer densities (kg.m-3)
+c  qext(nq)        ! Single Scat. Extinction coeff at 0.67 um
+c  alpha_lift(nq)  ! saltation vertical flux/horiz flux ratio (m-1)
+c  alpha_devil(nq) ! lifting coeeficient by dust devil
+c  rho_dust          ! Mars dust density
+c  rho_ice           ! Water ice density
+c  doubleq           ! if method with mass (iq=1) and number(iq=2) mixing ratio
+c  varian            ! Characteristic variance of log-normal distribution
+c-----------------------------------------------------------------------
+
+       !! we allocate once for all arrays in common in tracer_h.F90
+       !! (supposedly those are not used before call to initracer)
+       IF (.NOT.ALLOCATED(noms)) ALLOCATE(noms(nq))
+       ALLOCATE(mmol(nq))
+       ALLOCATE(radius(nq))
+       ALLOCATE(rho_q(nq))
+       ALLOCATE(qext(nq))
+       ALLOCATE(alpha_lift(nq))
+       ALLOCATE(alpha_devil(nq))
+       ALLOCATE(qextrhor(nq))
+       ALLOCATE(igcm_dustbin(nq))
+       !! initialization
+       alpha_lift(:)=0.
+       alpha_devil(:)=0.
+
+! Initialization: get tracer names from the dynamics and check if we are
+!                 using 'old' tracer convention ('q01',q02',...)
+!                 or new convention (full tracer names)
+      ! check if tracers have 'old' names
+
+! copy tracer names from dynamics
+        do iq=1,nq
+          noms(iq)=nametrac(iq)
+        enddo
+
+
+! Identify tracers by their names: (and set corresponding values of mmol)
+      ! 0. initialize tracer indexes to zero:
+      ! NB: igcm_* indexes are commons in 'tracer.h'
+      do iq=1,nq
+        igcm_dustbin(iq)=0
+      enddo
+      igcm_dust_mass=0
+      igcm_dust_number=0
+      igcm_h2o_vap=0
+      igcm_h2o_ice=0
+      igcm_co2=0
+      igcm_co=0
+      igcm_o=0
+      igcm_o1d=0
+      igcm_o2=0
+      igcm_o3=0
+      igcm_h=0
+      igcm_h2=0
+      igcm_oh=0
+      igcm_ho2=0
+      igcm_h2o2=0
+      igcm_n2=0
+      igcm_ar=0
+      igcm_ar_n2=0
+      igcm_co2_ice=0
+
+      write(*,*) 'initracer: noms() ', noms
+
+
+      !print*,'Setting dustbin = 0 in initracer.F'
+      !dustbin=0
+
+      ! 1. find dust tracers
+      count=0
+!      if (dustbin.gt.0) then
+!        do iq=1,nq
+!          txt=" "
+!          write(txt,'(a4,i2.2)')'dust',count+1   
+!          if (noms(iq).eq.txt) then
+!            count=count+1
+!            igcm_dustbin(count)=iq
+!            mmol(iq)=100.
+!          endif
+!        enddo !do iq=1,nq
+!      endif ! of if (dustbin.gt.0)
+
+
+!      if (doubleq) then
+!        do iq=1,nq
+!          if (noms(iq).eq."dust_mass") then
+!            igcm_dust_mass=iq
+!            count=count+1
+!          endif
+!          if (noms(iq).eq."dust_number") then
+!            igcm_dust_number=iq
+!            count=count+1
+!          endif
+!        enddo
+!      endif ! of if (doubleq)
+      ! 2. find chemistry and water tracers
+      do iq=1,nq
+        if (noms(iq).eq."co2") then
+          igcm_co2=iq
+          mmol(igcm_co2)=44.
+          count=count+1
+!          write(*,*) 'co2: count=',count
+        endif
+        if (noms(iq).eq."co2_ice") then
+          igcm_co2_ice=iq
+          mmol(igcm_co2_ice)=44.
+          count=count+1
+!          write(*,*) 'co2_ice: count=',count
+        endif
+        if (noms(iq).eq."h2o_vap") then
+          igcm_h2o_vap=iq
+          mmol(igcm_h2o_vap)=18.
+          count=count+1
+!          write(*,*) 'h2o_vap: count=',count
+        endif
+        if (noms(iq).eq."h2o_ice") then
+          igcm_h2o_ice=iq
+          mmol(igcm_h2o_ice)=18.
+          count=count+1
+!          write(*,*) 'h2o_ice: count=',count
+        endif
+      enddo ! of do iq=1,nq
+      
+      ! check that we identified all tracers:
+      if (count.ne.nq) then
+        write(*,*) "initracer: found only ",count," tracers"
+        write(*,*) "               expected ",nq
+        do iq=1,count
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+!        stop
+      else
+        write(*,*) "initracer: found all expected tracers, namely:"
+        do iq=1,nq
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+      endif
+
+
+c------------------------------------------------------------
+c     Initialisation tracers ....
+c------------------------------------------------------------
+      call zerophys(nq,rho_q)
+
+      rho_dust=2500.  ! Mars dust density (kg.m-3)
+      rho_ice=920.    ! Water ice density (kg.m-3)
+      rho_co2=1620.   ! CO2 ice density (kg.m-3)
+
+
+
+c$$$      if (doubleq) then
+c$$$c       "doubleq" technique 
+c$$$c       -------------------
+c$$$c      (transport of mass and number mixing ratio)
+c$$$c       iq=1: Q mass mixing ratio, iq=2: N number mixing ratio
+c$$$
+c$$$        if( (nq.lt.2).or.(water.and.(nq.lt.3)) ) then
+c$$$          write(*,*)'initracer: nq is too low : nq=', nq
+c$$$          write(*,*)'water= ',water,' doubleq= ',doubleq   
+c$$$        end if
+c$$$
+c$$$        varian=0.637    ! Characteristic variance    
+c$$$        qext(igcm_dust_mass)=3.04   ! reference extinction at 0.67 um for ref dust
+c$$$        qext(igcm_dust_number)=3.04 ! reference extinction at 0.67 um for ref dust
+c$$$        rho_q(igcm_dust_mass)=rho_dust
+c$$$        rho_q(igcm_dust_number)=rho_dust
+c$$$
+c$$$c       Intermediate calcul for computing geometric mean radius r0
+c$$$c       as a function of mass and number mixing ratio Q and N
+c$$$c       (r0 = (r3n_q * Q/ N)
+c$$$        r3n_q = exp(-4.5*varian**2)*(3./4.)/(pi*rho_dust)
+c$$$
+c$$$c       Intermediate calcul for computing effective radius reff
+c$$$c       from geometric mean radius r0
+c$$$c       (reff = ref_r0 * r0)
+c$$$        ref_r0 = exp(2.5*varian**2)
+c$$$        
+c$$$c       lifted dust :
+c$$$c       '''''''''''
+c$$$        reff_lift = 3.e-6      !  Effective radius of lifted dust (m)
+c$$$        alpha_devil(igcm_dust_mass)=9.e-9   !  dust devil lift mass coeff
+c$$$        alpha_lift(igcm_dust_mass)=3.0e-15  !  Lifted mass coeff
+c$$$
+c$$$        r0_lift = reff_lift/ref_r0
+c$$$        alpha_devil(igcm_dust_number)=r3n_q*
+c$$$     &                        alpha_devil(igcm_dust_mass)/r0_lift**3
+c$$$        alpha_lift(igcm_dust_number)=r3n_q*
+c$$$     &                        alpha_lift(igcm_dust_mass)/r0_lift**3
+c$$$
+c$$$c       Not used:
+c$$$        radius(igcm_dust_mass) = 0.
+c$$$        radius(igcm_dust_number) = 0.
+c$$$
+c$$$      else
+
+
+c$$$       if (dustbin.gt.1) then
+c$$$        print*,'ATTENTION:',
+c$$$     $   ' properties of dust need input in initracer !!!'
+c$$$        stop
+c$$$
+c$$$       else if (dustbin.eq.1) then
+c$$$
+c$$$c       This will be used for 1 dust particle size:
+c$$$c       ------------------------------------------
+c$$$        radius(igcm_dustbin(1))=3.e-6
+c$$$        Qext(igcm_dustbin(1))=3.04
+c$$$        alpha_lift(igcm_dustbin(1))=0.0e-6
+c$$$        alpha_devil(igcm_dustbin(1))=7.65e-9
+c$$$        qextrhor(igcm_dustbin(1))=(3./4.)*Qext(igcm_dustbin(1))
+c$$$     &                         /(rho_dust*radius(igcm_dustbin(1)))
+c$$$        rho_q(igcm_dustbin(1))=rho_dust
+c$$$
+c$$$       endif
+c$$$!      end if    ! (doubleq)
+
+c     Initialization for water vapor
+c     ------------------------------
+      if(water) then
+         radius(igcm_h2o_vap)=0.
+         Qext(igcm_h2o_vap)=0.
+         alpha_lift(igcm_h2o_vap) =0.
+         alpha_devil(igcm_h2o_vap)=0.
+	 qextrhor(igcm_h2o_vap)= 0.
+
+c       "Dryness coefficient" controlling the evaporation and
+c        sublimation from the ground water ice (close to 1)
+c        HERE, the goal is to correct for the fact
+c        that the simulated permanent water ice polar caps
+c        is larger than the actual cap and the atmospheric
+c        opacity not always realistic.
+
+
+!         if(ngrid.eq.1)
+
+
+!     to be modified for BC+ version?
+
+         !! this is defined in surfdat_h.F90
+         IF (.not.ALLOCATED(dryness)) ALLOCATE(dryness(ngrid))
+         IF (.not.ALLOCATED(watercaptag)) ALLOCATE(watercaptag(ngrid))
+
+         do ig=1,ngrid
+           if (ngrid.ne.1) watercaptag(ig)=.false.
+           dryness(ig) = 1.
+         enddo
+
+
+
+
+!         IF (caps) THEN
+c Perennial H20 north cap defined by watercaptag=true (allows surface to be
+c hollowed by sublimation in vdifc).
+!         do ig=1,ngrid
+!           if (lati(ig)*180./pi.gt.84) then
+!             if (ngrid.ne.1) watercaptag(ig)=.true.
+!             dryness(ig) = 1.
+c Use the following cap definition for high spatial resolution (latitudinal bin <= 5 deg)
+c	      if (lati(ig)*180./pi.lt.85.and.long(ig).ge.0) then
+c	        if (ngrid.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+c             if (lati(ig)*180./pi.ge.85) then
+c               if (ngrid.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+!           endif  ! (lati>80 deg)
+!         end do ! (ngrid)
+!        ENDIF ! (caps)
+
+!         if(iceparty.and.(nq.ge.2)) then
+
+           radius(igcm_h2o_ice)=3.e-6
+           rho_q(igcm_h2o_ice)=rho_ice
+           Qext(igcm_h2o_ice)=0.
+!           alpha_lift(igcm_h2o_ice) =0.
+!           alpha_devil(igcm_h2o_ice)=0.
+           qextrhor(igcm_h2o_ice)= (3./4.)*Qext(igcm_h2o_ice) 
+     $       / (rho_ice*radius(igcm_h2o_ice))
+
+
+
+!         elseif(iceparty.and.(nq.lt.2)) then
+!            write(*,*) 'nq is too low : nq=', nq
+!            write(*,*) 'water= ',water,' iceparty= ',iceparty
+!         endif
+
+      end if  ! (water)
+
+c     Output for records:
+c     ~~~~~~~~~~~~~~~~~~
+      write(*,*)
+      Write(*,*) '******** initracer : dust transport parameters :'
+      write(*,*) 'alpha_lift = ', alpha_lift
+      write(*,*) 'alpha_devil = ', alpha_devil
+      write(*,*) 'radius  = ', radius
+!      if(doubleq) then
+!        write(*,*) 'reff_lift (um) =  ', reff_lift
+!        write(*,*) 'size distribution variance  = ', varian
+!        write(*,*) 'r3n_q , ref_r0 : ', r3n_q , ref_r0
+!      end if
+      write(*,*) 'Qext  = ', qext 
+      write(*,*)
+
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite.F	(revision 222)
@@ -0,0 +1,356 @@
+      SUBROUTINE iniwrite(nid,idayref,phis)
+
+      use comsoil_h, only: mlayer, nsoilmx
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   'Initialize' the diagfi.nc file: write down dimensions as well
+c   as time-independent fields (e.g: geopotential, mesh area, ...)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+
+      integer,intent(in) :: nid        ! NetCDF file ID
+      INTEGER*4,intent(in) :: idayref  ! date (initial date for this run)
+      real,intent(in) :: phis(ip1jmp1) ! surface geopotential
+
+c   Local:
+c   ------
+      INTEGER length,l
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! run parameters are stored in this array
+      INTEGER ierr
+
+      integer :: nvarid,idim_index,idim_rlonu,idim_rlonv
+      integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm
+      integer :: idim_nsoilmx ! "subsurface_layers" dimension ID #
+      integer, dimension(2) :: id  
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      tab_cntrl(1)  = real(iim)
+      tab_cntrl(2)  = real(jjm)
+      tab_cntrl(3)  = real(llm)
+      tab_cntrl(4)  = real(idayref)
+      tab_cntrl(5)  = rad
+      tab_cntrl(6)  = omeg
+      tab_cntrl(7)  = g
+      tab_cntrl(8)  = mugaz
+      tab_cntrl(9)  = rcp
+      tab_cntrl(10) = daysec
+      tab_cntrl(11) = dtphys
+      tab_cntrl(12) = etot0
+      tab_cntrl(13) = ptot0
+      tab_cntrl(14) = ztot0
+      tab_cntrl(15) = stot0
+      tab_cntrl(16) = ang0
+c
+c    ..........    P.Le Van  ( ajout le 8/04/96 )    .........
+c         .....        parametres  pour le zoom          ......   
+      tab_cntrl(17)  = clon
+      tab_cntrl(18)  = clat
+      tab_cntrl(19)  = grossismx
+      tab_cntrl(20)  = grossismy
+c
+c     .....   ajout  le 6/05/97 et le 15/10/97  .......
+c
+      IF ( fxyhypb )   THEN
+        tab_cntrl(21) = 1.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+      ELSE
+        tab_cntrl(21) = 0.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+        tab_cntrl(24) = 0.
+        IF( ysinus )  tab_cntrl(24) = 1.
+      ENDIF
+
+c    .........................................................
+
+! Define dimensions
+    
+      ierr = NF_REDEF (nid)
+
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "interlayer", (llm+1), idim_llmp1)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+c
+      ierr = NF_ENDDEF(nid)
+
+c  Contol parameters for this run
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, 
+     .       idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, 
+     .       idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                       "Control parameters")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c --------------------------
+c  longitudes and latitudes
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_DOUBLE, 1, idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlonu", NF_FLOAT, 1, idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
+     .                       "Longitudes at u nodes")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu/pi*180)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_rlatu,nvarid)
+#else
+      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#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
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#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
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#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",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_DOUBLE, 1, idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "rlatv", NF_FLOAT, 1, idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
+     .                       "Latitudes at v nodes")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv/pi*180)
+#endif
+c
+c --------------------------
+c  Vertical levels
+      call def_var(nid,"aps","hybrid pressure at midlayers ","Pa",
+     .            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(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
+
+      call def_var(nid,"ap","hybrid pressure at interlayers","Pa",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+
+      call def_var(nid,"bp","hybrid sigma at interlayers"," ",
+     .            1,idim_llmp1,nvarid,ierr)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil_h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+c
+c --------------------------
+c  Mesh area and conversion coefficients cov. <-> contra. <--> natural
+
+      id(1)=idim_rlonu
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
+     .             "Conversion coefficients cov <--> natural")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatv
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
+     .             "Conversion coefficients cov <--> natural")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Mesh area")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c  Surface geopotential
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "phisinit", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
+     .                       "Geopotential at the surface")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+
+      write(*,*)'iniwrite: iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      write(*,*)'iniwrite: rad,omeg,g,mugaz,rcp',
+     s rad,omeg,g,mugaz,rcp
+      write(*,*)'iniwrite: daysec,dtphys',daysec,dtphys
+
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite_specIR.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite_specIR.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite_specIR.F	(revision 222)
@@ -0,0 +1,241 @@
+      SUBROUTINE iniwrite_specIR(nid,idayref)
+
+      use radinc_h, only: L_NSPECTI
+      use radcommon_h, only: WNOI,DWNI
+!      use comsoil_h
+
+      implicit none
+
+c=======================================================================
+c
+c   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   'Initialize' the diagfi_spec.nc file: write down dimensions as well
+c   as time-independent fields (e.g: geopotential, mesh area, ...)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+!include "comconst.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "serre.h"
+#include"dimphys.h"
+
+c   Arguments:
+c   ----------
+
+      integer,intent(in) :: nid        ! NetCDF file ID
+      INTEGER*4,intent(in) :: idayref  ! date (initial date for this run)
+
+c   Local:
+c   ------
+      INTEGER length,l
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! run parameters are stored in this array
+      INTEGER ierr
+
+      integer :: nvarid,idim_index,idim_rlonu,idim_rlonv
+      integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm
+ !     integer :: idim_nsoilmx ! "subsurface_layers" dimension ID #
+      integer :: idim_bandsIR ! "IR Wavenumber" dimension ID #
+      integer, dimension(2) :: id  
+
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      tab_cntrl(1)  = FLOAT(iim)
+      tab_cntrl(2)  = FLOAT(jjm)
+      tab_cntrl(3)  = FLOAT(llm)
+      tab_cntrl(4)  = FLOAT(idayref)
+      tab_cntrl(5)  = rad
+      tab_cntrl(6)  = omeg
+      tab_cntrl(7)  = g
+      tab_cntrl(8)  = mugaz
+      tab_cntrl(9)  = rcp
+      tab_cntrl(10) = daysec
+      tab_cntrl(11) = dtphys
+      tab_cntrl(12) = etot0
+      tab_cntrl(13) = ptot0
+      tab_cntrl(14) = ztot0
+      tab_cntrl(15) = stot0
+      tab_cntrl(16) = ang0
+c
+c    ..........    P.Le Van  ( ajout le 8/04/96 )    .........
+c         .....        parametres  pour le zoom          ......   
+      tab_cntrl(17)  = clon
+      tab_cntrl(18)  = clat
+      tab_cntrl(19)  = grossismx
+      tab_cntrl(20)  = grossismy
+c
+c     .....   ajout  le 6/05/97 et le 15/10/97  .......
+c
+      IF ( fxyhypb )   THEN
+        tab_cntrl(21) = 1.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+      ELSE
+        tab_cntrl(21) = 0.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+        tab_cntrl(24) = 0.
+        IF( ysinus )  tab_cntrl(24) = 1.
+      ENDIF
+
+c    .........................................................
+
+! Define dimensions
+    
+      ierr = NF_REDEF (nid)
+
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "IR Wavenumber",L_NSPECTI,idim_bandsIR)
+
+      ierr = NF_ENDDEF(nid)
+
+c  Contol parameters for this run
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, 
+     .       idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, 
+     .       idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                       "Control parameters")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c --------------------------
+c  longitudes and latitudes
+
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_rlatu,nvarid)
+#else
+      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#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
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#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
+c
+
+!-------------------------------
+! Number of bands in the IR
+!-------------------------------
+
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"IR Wavenumber",NF_DOUBLE,1,
+     .				idim_bandsIR,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"IR Wavenumber",NF_FLOAT,1,
+     .				idim_bandsIR,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 34,
+     .                        "Band mid frequency in the infrared")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",5,"cm^-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(WNOI))
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,real(WNOI))
+#endif
+
+!-------------------------------
+! Width of bands in the IR
+!-------------------------------
+
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"IR Bandwidth",NF_DOUBLE,1,
+     .				idim_bandsIR,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"IR Bandwidth",NF_FLOAT,1,
+     .				idim_bandsIR,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 25,
+     .                        "Bandwidth in the infrared")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",5,"cm^-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(DWNI))
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,real(DWNI))
+#endif
+c
+c --------------------------
+c  Mesh area and conversion coefficients cov. <-> contra. <--> natural
+
+
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Mesh area")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+
+
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite_specVI.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite_specVI.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwrite_specVI.F	(revision 222)
@@ -0,0 +1,242 @@
+      SUBROUTINE iniwrite_specVI(nid,idayref)
+
+      use radinc_h, only: L_NSPECTV
+      use radcommon_h, only: WNOV,DWNV
+      use comsoil_h
+
+      implicit none
+
+c=======================================================================
+c
+c   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   'Initialize' the diagfi_spec.nc file: write down dimensions as well
+c   as time-independent fields (e.g: geopotential, mesh area, ...)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+!include "comconst.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "serre.h"
+#include"dimphys.h"
+
+c   Arguments:
+c   ----------
+
+      integer nid        ! NetCDF file ID
+      INTEGER*4 idayref  ! date (initial date for this run)
+
+c   Local:
+c   ------
+      INTEGER length,l
+      parameter (length = 100)
+      REAL tab_cntrl(length) ! run parameters are stored in this array
+      INTEGER ierr
+
+      integer :: nvarid,idim_index,idim_rlonu,idim_rlonv
+      integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm
+ !     integer :: idim_nsoilmx ! "subsurface_layers" dimension ID #
+      integer :: idim_bandsVI ! "VI Wavenumber" dimension ID #
+      integer, dimension(2) :: id  
+
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      tab_cntrl(1)  = FLOAT(iim)
+      tab_cntrl(2)  = FLOAT(jjm)
+      tab_cntrl(3)  = FLOAT(llm)
+      tab_cntrl(4)  = FLOAT(idayref)
+      tab_cntrl(5)  = rad
+      tab_cntrl(6)  = omeg
+      tab_cntrl(7)  = g
+      tab_cntrl(8)  = mugaz
+      tab_cntrl(9)  = rcp
+      tab_cntrl(10) = daysec
+      tab_cntrl(11) = dtphys
+      tab_cntrl(12) = etot0
+      tab_cntrl(13) = ptot0
+      tab_cntrl(14) = ztot0
+      tab_cntrl(15) = stot0
+      tab_cntrl(16) = ang0
+c
+c    ..........    P.Le Van  ( ajout le 8/04/96 )    .........
+c         .....        parametres  pour le zoom          ......   
+      tab_cntrl(17)  = clon
+      tab_cntrl(18)  = clat
+      tab_cntrl(19)  = grossismx
+      tab_cntrl(20)  = grossismy
+c
+c     .....   ajout  le 6/05/97 et le 15/10/97  .......
+c
+      IF ( fxyhypb )   THEN
+        tab_cntrl(21) = 1.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+      ELSE
+        tab_cntrl(21) = 0.
+        tab_cntrl(22) = dzoomx
+        tab_cntrl(23) = dzoomy
+        tab_cntrl(24) = 0.
+        IF( ysinus )  tab_cntrl(24) = 1.
+      ENDIF
+
+c    .........................................................
+
+! Define dimensions
+    
+      ierr = NF_REDEF (nid)
+
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "VI Wavenumber",L_NSPECTV,idim_bandsVI)
+
+      ierr = NF_ENDDEF(nid)
+
+c  Contol parameters for this run
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, 
+     .       idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, 
+     .       idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
+     .                       "Control parameters")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c --------------------------
+c  longitudes and latitudes
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid, "latitude", NF_DOUBLE, 1, idim_rlatu,nvarid)
+#else
+      ierr =NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#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
+c
+c --------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#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
+c
+
+!-------------------------------
+! Number of bands in the IR
+!-------------------------------
+
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"VI Wavenumber",NF_DOUBLE,1,
+     .				idim_bandsVI,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"VI Wavenumber",NF_FLOAT,1,
+     .				idim_bandsVI,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 33,
+     .                        "Band mid frequency in the visible")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",5,"cm^-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(WNOV))
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,real(WNOV))
+#endif
+
+c
+!-------------------------------
+! Width of bands in the Visible
+!-------------------------------
+
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"VI Bandwidth",NF_DOUBLE,1,
+     .				idim_bandsVI,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"VI Bandwidth",NF_FLOAT,1,
+     .				idim_bandsVI,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 24,
+     .                        "Bandwidth in the visible")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",5,"cm^-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,dble(DWNV))
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,real(DWNV))
+#endif
+c
+c --------------------------
+c   Mesh area
+c --------------------------
+
+      id(1)=idim_rlonv
+      id(2)=idim_rlatu
+
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "aire", NF_DOUBLE, 2, id,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "aire", NF_FLOAT, 2, id,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Mesh area")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+
+
+
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwritesoil.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwritesoil.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iniwritesoil.F90	(revision 222)
@@ -0,0 +1,273 @@
+subroutine iniwritesoil(nid,ngrid)
+
+! initialization routine for 'writediagoil'. Here we create/define
+! dimensions (longitude, latitude, depth and time) and other fixed
+! (time-independent) parameters.
+
+use comsoil_h, only: mlayer, inertiedat, nsoilmx
+
+implicit none
+
+#include"dimensions.h"
+#include"paramet.h"
+#include"comcstfi.h"
+#include"comgeom.h"
+#include"netcdf.inc"
+
+! Arguments:
+integer,intent(in) :: ngrid
+integer,intent(in) :: nid ! NetCDF output file ID
+
+! Local variables:
+
+! NetCDF stuff:
+integer :: ierr ! NetCDF routines return code
+integer :: idim_rlatu ! ID of the 'latitude' dimension
+integer :: idim_rlonv ! ID of the 'longitude' dimension
+integer :: idim_depth ! ID of the 'depth' dimension
+integer :: idim_time  ! ID of the 'time' dimension
+integer :: varid ! to store NetCDF ID of a variable
+integer,dimension(3) :: dimids ! to store IDs of dimensions of a variable
+character(len=60) :: text ! to store some text
+real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+integer :: i,j,l,ig0
+
+! 1. Define the dimensions
+! Switch to NetCDF define mode
+ierr=NF_REDEF(nid)
+
+! Define the dimensions
+ierr=NF_DEF_DIM(nid,"longitude",iip1,idim_rlonv)
+! iip1 known from paramet.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define longitude dimension"
+endif
+ierr=NF_DEF_DIM(nid,"latitude",jjp1,idim_rlatu)
+! jjp1 known from paramet.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define latitude dimension"
+endif
+ierr=NF_DEF_DIM(nid,"depth",nsoilmx,idim_depth)
+! nsoilmx known from dimphys.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth dimension"
+endif
+ierr=NF_DEF_DIM(nid,"time",NF_UNLIMITED,idim_time)
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define time dimension"
+endif
+
+! Switch out of NetCDF define mode
+ierr=NF_ENDDEF(nid)
+
+! 2. Define (as variables) and write dimensions, as well as their attributes
+! 2.1. Longitude
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,idim_rlonv,varid)
+#else
+ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,idim_rlonv,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define longitude variable"
+endif
+
+! Longitude attributes
+text="East longitude"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="degrees_east"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write longitude to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlonv*(180./pi))
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,rlonv*(180./pi))
+#endif
+! Note: rlonv is known from comgeom.h and pi from comcstfi.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write longitude variable"
+endif
+
+! 2.2. Latitude
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,idim_rlatu,varid)
+#else
+ierr=NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,idim_rlatu,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define latitude variable"
+endif
+
+! Latitude attributes
+text="North latitude"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="degrees_north"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write latitude to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlatu*(180./pi))
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,rlatu*(180./pi))
+#endif
+! Note: rlatu is known from comgeom.h and pi from comcstfi.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write longitude variable"
+endif
+
+! 2.3. Depth
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"depth",NF_DOUBLE,1,idim_depth,varid)
+#else
+ierr=NF_DEF_VAR(nid,"depth",NF_FLOAT,1,idim_depth,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth variable"
+endif
+
+! Depth attributes
+text="Soil mid-layer depth"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="m"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+text="down"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"positive",len_trim(text),text)
+
+! Write depth to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,mlayer)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,mlayer)
+#endif
+! Note mlayer(0:nsoilmx-1) known from comsoil_h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write depth variable"
+endif
+
+! 2.4. Time
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"time",NF_DOUBLE,1,idim_time,varid)
+#else
+ierr=NF_DEF_VAR(nid,"time",NF_FLOAT,1,idim_time,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define depth variable"
+endif
+
+! time attributes
+text="Time"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="days since 0000-01-01 00:00:00"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Note no need to write time variable here; it is done in writediagsoil.
+
+! 3. Other variables to be included
+
+! 3.1 mesh area surrounding each horizontal point
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+dimids(1)=idim_rlonv ! ID of the 'longitude' dimension
+dimids(2)=idim_rlatu ! ID of the 'latitude' dimension
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"area",NF_DOUBLE,2,dimids,varid)
+#else
+ierr=NF_DEF_VAR(nid,"area",NF_FLOAT,2,dimids,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define area variable"
+endif
+
+! Area attributes
+text="Mesh area"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="m2"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Write area to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,aire)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,aire)
+#endif
+! Note: aire is known from comgeom.h
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write area variable"
+endif
+
+! 3.2 Thermal inertia
+ierr=NF_REDEF(nid) ! switch to NetCDF define mode
+
+! Define the variable
+dimids(1)=idim_rlonv ! ID of the 'longitude' dimension
+dimids(2)=idim_rlatu ! ID of the 'latitude' dimension
+dimids(3)=idim_depth ! ID of the 'depth' dimension
+#ifdef NC_DOUBLE
+ierr=NF_DEF_VAR(nid,"th_inertia",NF_DOUBLE,3,dimids,varid)
+#else
+ierr=NF_DEF_VAR(nid,"th_inertia",NF_FLOAT,3,dimids,varid)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not define th_inertia variable"
+endif
+
+! Attributes
+text="Thermal inertia"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"long_name",len_trim(text),text)
+text="J.s-1/2.m-2.K-1"
+ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
+
+! Recast data along 'dynamics' grid
+! Note: inertiedat is known from comsoil_h
+
+do l=1,nsoilmx
+  ! handle the poles
+  do i=1,iip1
+    data3(i,1,l)=inertiedat(1,l)
+    data3(i,jjp1,l)=inertiedat(ngrid,l)
+  enddo
+  ! rest of the grid
+  do j=2,jjm
+    ig0=1+(j-2)*iim
+    do i=1,iim
+      data3(i,j,l)=inertiedat(ig0+i,l)
+    enddo
+    data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
+  enddo
+enddo ! of do l=1,nsoilmx
+
+! Write data2 to file
+ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
+! Write
+#ifdef NC_DOUBLE
+ierr=NF_PUT_VAR_DOUBLE(nid,varid,data3)
+#else
+ierr=NF_PUT_VAR_REAL(nid,varid,data3)
+#endif
+if (ierr.ne.NF_NOERR) then
+  write(*,*)"iniwritesoil: Error, could not write th_inertia variable"
+endif
+
+end subroutine iniwritesoil
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interp_line.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interp_line.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interp_line.F	(revision 222)
@@ -0,0 +1,55 @@
+      subroutine interp_line(x1,y1,len1,x2,y2,len2)
+      implicit none
+!-----------------------------------------------------------------------
+!
+!  Purpose: Do a series of linear interpolations
+!  Data sets are organized as vectors (see below)
+!  If x2(:), and abscissa at which interpolation is requiered, lies
+!  outside of the interval covered by x1(:), instead of doing an
+!  extrapolation, y2() is set to the value y1() corresponding to
+!  the nearby x1(:) point
+!  
+c-----------------------------------------------------------------------
+!  arguments
+!  ---------
+!  inputs:
+      real x1(len1) ! ordered list of abscissas
+      real y1(len1) ! values at x1(:)
+      integer len1  ! length of x1(:) and y1(:)
+      real x2(len2) !ordered list of abscissas at which interpolation is done
+      integer len2  ! length of x2(:) and y2(:)
+!  outputs:
+      real y2(len2) ! interpolated values
+!-----------------------------------------------------------------------
+
+! local variables:
+      integer i,j
+      
+
+      do i=1,len2
+        ! check if x2(i) lies outside of the interval covered by x1()
+        if(((x2(i).le.x1(1)).and.(x2(i).le.x1(len1))).or.
+     &     ((x2(i).ge.x1(1)).and.(x2(i).ge.x1(len1)))) then
+	  ! set y2(i) to y1(1) or y1(len1)
+	  if (abs(x2(i)-x1(1)).lt.abs(x2(i)-x1(len1))) then
+	    ! x2(i) lies closest to x1(1)
+	    y2(i)=y1(1)
+	  else
+	    ! x2(i) lies closest to x1(len1)
+	    y2(i)=y1(len1)
+	  endif
+
+	else
+        ! find the nearest neigbours and do a linear interpolation
+	 do j=1,len1-1
+          if(((x2(i).ge.x1(j)).and.(x2(i).le.x1(j+1))).or.
+     &       ((x2(i).le.x1(j)).and.(x2(i).ge.x1(j+1)))) then
+	    y2(i)=((x2(i)-x1(j))/(x1(j+1)-x1(j)))*y1(j+1)+
+     &            ((x2(i)-x1(j+1))/(x1(j)-x1(j+1)))*y1(j)
+	  endif
+	 enddo
+	endif
+
+      enddo
+
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2H2.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2H2.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2H2.F90	(revision 222)
@@ -0,0 +1,125 @@
+     subroutine interpolateH2H2(wn,temp,pres,abcoef,firstcall,ind)
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates the H2-H2 CIA opacity, using a lookup table from
+!     HITRAN (2011)
+!
+!     Authors
+!     -------
+!     R. Wordsworth (2011)
+!     
+!==================================================================
+
+      use datafile_mod, only: datadir
+
+      implicit none
+
+      ! input
+      double precision wn                 ! wavenumber             (cm^-1)
+      double precision temp               ! temperature            (Kelvin)
+      double precision pres               ! pressure               (Pascals)
+
+      ! output
+      double precision abcoef             ! absorption coefficient (m^-1)
+
+      integer nS,nT
+      parameter(nS=2428)
+      parameter(nT=10)
+
+      double precision, parameter :: losch = 2.6867774e19
+      ! Loschmit's number (molecule cm^-3 at STP) 
+      ! converts cm^5 molecule^-2 --> cm^-1 amagat^-2
+      ! see Richard et al. 2011, JQSRT for details
+
+      double precision amagat
+      double precision wn_arr(nS)
+      double precision temp_arr(nT)
+      double precision abs_arr(nS,nT)
+
+      integer k,iT
+      logical firstcall
+
+      save wn_arr, temp_arr, abs_arr
+
+      character*100 dt_file
+      integer strlen,ios
+
+      character(LEN=*), parameter :: fmat1 = "(A20,F10.3,F10.3,I7,F7.1,E10.3,F5.3)"
+
+      character*20 bleh
+      double precision blah, Ttemp
+      integer nres
+
+      integer ind
+
+      if(temp.gt.400)then
+         print*,'Your temperatures are too high for this H2-H2 CIA dataset. If you '
+         print*,'really want to run simulations with hydrogen at T > 400 K, contact'
+         print*,'Robin Wordsworth [rwordsworth@uchicago.edu].'
+         stop
+      endif
+
+      amagat = (273.15/temp)*(pres/101325.0)
+
+      if(firstcall)then ! called by sugas_corrk only
+         print*,'----------------------------------------------------'
+         print*,'Initialising H2-H2 continuum from HITRAN database...'
+
+!     1.1 Open the ASCII files
+         dt_file=TRIM(datadir)//'/continuum_data/H2-H2_norm_2011.cia'
+
+         open(33,file=dt_file,form='formatted',status='old',iostat=ios)
+         if (ios.ne.0) then        ! file not found
+           write(*,*) 'Error from interpolateH2H2'
+           write(*,*) 'Data file ',trim(dt_file),' not found.'
+           write(*,*) 'Check that your path to datagcm:',trim(datadir)
+           write(*,*) 'is correct. You can change it in callphys.def with:'
+           write(*,*) 'datadir = /absolute/path/to/datagcm'
+           write(*,*) 'Also check that the continuum data continuum_data/H2-H2_norm_2011.cia is there.'
+           call abort
+         else
+
+            do iT=1,nT
+
+               read(33,fmat1) bleh,blah,blah,nres,Ttemp
+               if(nS.ne.nres)then
+                  print*,'Resolution given in file: ',trim(dt_file)
+                  print*,'is ',nres,', which does not match nS.'
+                  print*,'Please adjust nS value in interpolateH2H2.F90'
+                  stop
+               endif
+               temp_arr(iT)=Ttemp
+
+               do k=1,nS
+                  read(33,*) wn_arr(k),abs_arr(k,it)
+               end do
+
+            end do
+      
+         endif
+         close(33)
+
+         print*,'interpolateH2H2: At wavenumber ',wn,' cm^-1'
+         print*,'   temperature ',temp,' K'
+         print*,'   pressure ',pres,' Pa'
+
+      endif
+
+         call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arr,wn,temp,abcoef,ind)
+
+         !print*,'the absorption is ',abcoef,' cm^5 molecule^-2'
+         !print*,'or ',abcoef*losch**2,' cm^-1 amagat^-2'
+
+         abcoef=abcoef*losch**2*100.0*amagat**2 ! convert to m^-1
+
+         !print*,'We have ',amagat,' amagats of H2'
+         !print*,'So the absorption is ',abcoef,' m^-1'
+
+         ! unlike for Rayleigh scattering, we do not currently weight by the BB function
+         ! however our bands are normally thin, so this is no big deal.
+
+      return
+    end subroutine interpolateH2H2
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2He.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2He.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2He.F90	(revision 222)
@@ -0,0 +1,129 @@
+     subroutine interpolateH2He(wn,temp,presH2,presHe,abcoef,firstcall,ind)
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates the H2-He CIA opacity, using a lookup table from
+!     HITRAN (2011)
+!
+!     Authors
+!     -------
+!     R. Wordsworth (2011)
+!     
+!==================================================================
+
+      use datafile_mod, only: datadir
+
+      implicit none
+
+      ! input
+      double precision wn                 ! wavenumber             (cm^-1)
+      double precision temp               ! temperature            (Kelvin)
+      double precision presH2             ! H2 partial pressure    (Pascals)
+      double precision presHe             ! He partial pressure    (Pascals)
+
+      ! output
+      double precision abcoef             ! absorption coefficient (m^-1)
+
+      integer nS,nT
+      parameter(nS=2428)
+      parameter(nT=10)
+
+      double precision, parameter :: losch = 2.6867774e19
+      ! Loschmit's number (molecule cm^-3 at STP) 
+      ! converts cm^5 molecule^-2 --> cm^-1 amagat^-2
+      ! see Richard et al. 2011, JQSRT for details
+
+      double precision amagatH2
+      double precision amagatHe
+      double precision wn_arr(nS)
+      double precision temp_arr(nT)
+      double precision abs_arr(nS,nT)
+
+      integer k,iT
+      logical firstcall
+
+      save wn_arr, temp_arr, abs_arr
+
+      character*100 dt_file
+      integer strlen,ios
+
+      character(LEN=*), parameter :: fmat1 = "(A20,F10.3,F10.3,I7,F7.1,E10.3,F5.3)"
+
+      character*20 bleh
+      double precision blah, Ttemp
+      integer nres
+
+      integer ind
+ 
+      if(temp.gt.400)then
+         print*,'Your temperatures are too high for this H2-He CIA dataset.'
+         print*,'Please run mixed H2-He atmospheres below T = 400 K.'      
+         stop
+      endif
+
+      amagatH2 = (273.15/temp)*(presH2/101325.0)
+      amagatHe = (273.15/temp)*(presHe/101325.0)
+
+      if(firstcall)then ! called by sugas_corrk only
+         print*,'----------------------------------------------------'
+         print*,'Initialising H2-He continuum from HITRAN database...'
+
+!     1.1 Open the ASCII files
+         dt_file=TRIM(datadir)//'/continuum_data/H2-He_norm_2011.cia'
+
+         open(33,file=dt_file,form='formatted',status='old',iostat=ios)
+         if (ios.ne.0) then        ! file not found
+           write(*,*) 'Error from interpolateH2He'
+           write(*,*) 'Data file ',trim(dt_file),' not found.'
+           write(*,*) 'Check that your path to datagcm:',trim(datadir)
+           write(*,*) 'is correct. You can change it in callphys.def with:'
+           write(*,*) 'datadir = /absolute/path/to/datagcm'
+           write(*,*) 'Also check that the continuum data continuum_data/H2-He_norm_2011.cia is there.'
+           call abort
+         else
+
+            do iT=1,nT
+
+               read(33,fmat1) bleh,blah,blah,nres,Ttemp
+               if(nS.ne.nres)then
+                  print*,'Resolution given in file: ',trim(dt_file)
+                  print*,'is ',nres,', which does not match nS.'
+                  print*,'Please adjust nS value in interpolateH2He.F90'
+                  stop
+               endif
+               temp_arr(iT)=Ttemp
+
+               do k=1,nS
+                  read(33,*) wn_arr(k),abs_arr(k,it)
+               end do
+
+            end do
+      
+         endif
+         close(33)
+
+         print*,'interpolateH2He: At wavenumber ',wn,' cm^-1'
+         print*,'   temperature                 ',temp,' K'
+         print*,'   H2 partial pressure         ',presH2,' Pa'
+         print*,'   and He partial pressure     ',presHe,' Pa'
+
+      endif
+
+         call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arr,wn,temp,abcoef,ind)
+
+         !print*,'the absorption is ',abcoef,' cm^5 molecule^-2'
+         !print*,'or ',abcoef*losch**2,' cm^-1 amagat^-2'
+
+         abcoef=abcoef*losch**2*100.0*amagatH2*amagatHe ! convert to m^-1
+
+         !print*,'We have ',amagatH2,' amagats of H2'
+         !print*,'and     ',amagatHe,' amagats of He'
+         !print*,'So the absorption is ',abcoef,' m^-1'
+
+         ! unlike for Rayleigh scattering, we do not currently weight by the BB function
+         ! however our bands are normally thin, so this is no big deal.
+
+      return
+    end subroutine interpolateH2He
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2Ocont_CKD.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2Ocont_CKD.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2Ocont_CKD.F90	(revision 222)
@@ -0,0 +1,167 @@
+     subroutine interpolateH2Ocont_CKD(wn,temp,presS,presF,abcoef,firstcall,ind)
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates the H2O continuum opacity, using a lookup table from
+!     Clough (2005).
+!
+!     Authors
+!     -------
+!     R. Wordsworth (2011)
+!     
+!==================================================================
+
+      use datafile_mod, only: datadir
+      implicit none
+
+      ! input
+      double precision wn                 ! wavenumber             (cm^-1)
+      double precision temp               ! temperature            (Kelvin)
+      double precision presS              ! self-pressure          (Pascals)
+      double precision presF              ! foreign (air) pressure (Pascals)
+
+      ! output
+      double precision abcoef             ! absorption coefficient (m^-1)
+
+      integer nS,nT
+      parameter(nS=1001)
+      parameter(nT=11)
+
+      double precision kB
+      parameter(kB=1.3806488e-23)
+
+      double precision amagatS, amagatF, abcoefS, abcoefF, Nmolec
+      double precision wn_arr(nS)
+      double precision temp_arr(nT)
+      double precision abs_arrS(nS,nT)
+      double precision abs_arrF(nS,nT)
+      double precision data_tmp(nT)
+
+      integer k,ind
+      logical firstcall
+
+      save wn_arr, temp_arr, abs_arrS, abs_arrF
+
+      character*100 dt_file
+      integer strlen,ios
+
+      amagatS=(273.15/temp)*(presS/101325.0)
+      amagatF=(273.15/temp)*(presF/101325.0)
+
+      if(firstcall)then ! called by sugas_corrk only
+         print*,'----------------------------------------------------'
+         print*,'Initialising H2O continuum from MT_CKD data...'
+
+!     1.1 Open the ASCII files
+
+         ! nu array
+         dt_file=TRIM(datadir)//'/continuum_data/H2O_CONT_NU.dat'
+         open(33,file=dt_file,form='formatted',status='old',iostat=ios)
+         if (ios.ne.0) then        ! file not found
+           write(*,*) 'Error from interpolateH2O_cont'
+           write(*,*) 'Data file ',trim(dt_file),' not found.'
+           write(*,*)'Check that your path to datagcm:',trim(datadir)
+           write(*,*)' is correct. You can change it in callphys.def with:'
+           write(*,*)' datadir = /absolute/path/to/datagcm'
+           write(*,*)' Also check that there is a continuum_data/H2O_CONT_NU.dat there.'
+           call abort
+         else
+            do k=1,nS
+               read(33,*) wn_arr(k)
+            enddo
+         endif
+         close(33)
+
+         ! self broadening
+         dt_file=TRIM(datadir)//'/continuum_data/H2O_CONT_SELF.dat'
+         open(34,file=dt_file,form='formatted',status='old',iostat=ios)
+         if (ios.ne.0) then        ! file not found
+           write(*,*) 'Error from interpolateH2O_cont'
+           write(*,*) 'Data file ',trim(dt_file),' not found.'
+           write(*,*)'Check that your path to datagcm:',trim(datadir)
+           write(*,*)' is correct. You can change it in callphys.def with:'
+           write(*,*)' datadir = /absolute/path/to/datagcm'
+           write(*,*)' Also check that there is a continuum_data/H2O_CONT_SELF.dat there.'
+           call abort
+         else
+            do k=1,nS
+               read(34,*) data_tmp
+               abs_arrS(k,1:nT)=data_tmp(1:nT)
+            end do
+         endif
+         close(34)
+
+         ! foreign (N2+O2+Ar) broadening
+         dt_file=TRIM(datadir)//'/continuum_data/H2O_CONT_FOREIGN.dat'
+         open(35,file=dt_file,form='formatted',status='old',iostat=ios)
+         if (ios.ne.0) then        ! file not found
+           write(*,*) 'Error from interpolateH2O_cont'
+           write(*,*) 'Data file ',trim(dt_file),' not found.'
+           write(*,*)'Check that your path to datagcm:',trim(datadir)
+           write(*,*)' is correct. You can change it in callphys.def with:'
+           write(*,*)' datadir = /absolute/path/to/datagcm'
+           write(*,*)' Also check that there is a continuum_data/H2O_CONT_FOREIGN.dat there.'
+           call abort
+         else
+            do k=1,nS
+               read(35,*) data_tmp
+               abs_arrF(k,1:nT)=data_tmp(1:nT)
+            end do
+         endif
+         close(35)
+
+         temp_arr(1)  = 200.
+         temp_arr(2)  = 250.
+         temp_arr(3)  = 300.
+         temp_arr(4)  = 350.
+         temp_arr(5)  = 400.
+         temp_arr(6)  = 450.
+         temp_arr(7)  = 500.
+         temp_arr(8)  = 550.
+         temp_arr(9)  = 600.
+         temp_arr(10) = 650.
+         temp_arr(11) = 700.
+
+         print*,'interpolateH2Ocont: At wavenumber ',wn,' cm^-1'
+         print*,'   temperature ',temp,' K'
+         print*,'   H2O pressure ',presS,' Pa'
+         print*,'   air pressure ',presF,' Pa'
+	 
+      endif
+
+      call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arrS,wn,temp,abcoefS,ind)
+!      print*,'the self absorption is ',abcoefS,' cm^2 molecule^-1'
+
+      call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arrF,wn,temp,abcoefF,ind)
+!      print*,'the foreign absorption is ',abcoefF,' cm^2 molecule^-1'
+
+!      print*,'We have ',amagatS,' amagats of H2O vapour'
+!      print*,'and ',amagatF,' amagats of air'
+
+      abcoef = abcoefS*amagatS + abcoefF*amagatF ! Eq. (15) in Clough (1989)
+      abcoef = abcoef*(presS/(presF+presS))      ! take H2O mixing ratio into account
+                                                    ! abs coeffs are given per molecule of H2O
+
+      Nmolec = (presS+presF)/(kB*temp)           ! assume ideal gas
+!      print*,'Total number of molecules per m^3 is',Nmolec
+
+      abcoef = abcoef*Nmolec/(100.0**2)          ! convert to m^-1
+!      print*,'So the total absorption is ',abcoef,' m^-1'
+!      print*,'And optical depth / km : ',1000.0*abcoef
+
+
+      if(wn.gt.500 .and. wn.lt.1400)then
+      elseif(wn.gt.2100 .and. wn.lt.3000)then
+      else
+         abcoef = 0.0
+      endif
+
+      ! unlike for Rayleigh scattering, we do not currently weight by the BB function
+      ! however our bands are normally thin, so this is no big deal.
+
+
+      return
+    end subroutine interpolateH2Ocont_CKD
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2Ocont_PPC.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2Ocont_PPC.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2Ocont_PPC.F90	(revision 222)
@@ -0,0 +1,84 @@
+     subroutine interpolateH2Ocont_PPC(wn,temp,presS,presF,abcoef,firstcall)
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates the H2O continuum opacity, using the formulae
+!     provided in Pierrehumbert, PPC (2010). As this is based on
+!     the CKD continuum, it provides a useful check for the 
+!     implementation of the more general interpolateH2Ocont_CKD.F90.
+!
+!     Authors
+!     -------
+!     R. Wordsworth (2012)
+!     
+!==================================================================
+
+      use watercommon_h, only: mH2O
+      use datafile_mod, only: datadir
+      implicit none
+
+      ! input
+      double precision wn                 ! wavenumber             (cm^-1)
+      double precision temp               ! temperature            (Kelvin)
+      double precision presS              ! self-pressure          (Pascals)
+      double precision presF              ! foreign (air) pressure (Pascals)
+
+      ! parameters
+      double precision, parameter :: T0 = 296.0
+      double precision, parameter :: p0 = 1.D+4
+
+      ! variables
+      double precision rho_w, x
+
+      ! output
+      double precision abcoef             ! absorption coefficient (m^-1)
+
+      logical firstcall
+
+      x = wn - 2500.
+
+      if(firstcall)then ! called by sugas_corrk only
+         print*,'----------------------------------------------------'
+         print*,'Testing H2O continuum...'
+
+         print*,'interpolateH2Ocont: At wavenumber ',wn,' cm^-1'
+         print*,'   temperature ',temp,' K'
+         print*,'   H2O pressure ',presS,' Pa'
+
+         rho_w = presS/((8.31446/(mH2O/1000.))*temp)
+
+         if(wn.gt.500 .and. wn.lt.1400)then
+            abcoef = exp(12.167 - 0.050898*wn + 8.3207e-5*wn**2 - 7.0748e-8*wn**3 + 2.3261e-11*wn**4)*(T0/temp)**4.25*(presS/p0)
+         elseif(wn.gt.2100 .and. wn.lt.3000)then
+            abcoef = exp(-6.0055 - 0.0021363*x + 6.4723e-7*x**2 - 1.493e-8*x**3 + 2.5621e-11*x**4 + 7.328e-14*x**5)*(T0/temp)**4.25*(presS/p0)
+         else
+            abcoef = 0.0
+         endif
+         abcoef = abcoef*rho_w
+
+         print*,'The self absorption is ',abcoef,' m^-1'
+         print*,'And optical depth / km : ',1000.0*abcoef
+
+      else
+
+         rho_w = presS/((8.31446/(mH2O/1000.))*temp)
+
+         if(wn.gt.500 .and. wn.lt.1400)then
+            abcoef = exp(12.167 - 0.050898*wn + 8.3207e-5*wn**2 - 7.0748e-8*wn**3 + 2.3261e-11*wn**4)*(T0/temp)**4.25*(presS/p0)
+         elseif(wn.gt.2100 .and. wn.lt.3000)then
+            abcoef = exp(-6.0055 - 0.0021363*x + 6.4723e-7*x**2 - 1.493e-8*x**3 + 2.5621e-11*x**4 + 7.328e-14*x**5)*(T0/temp)**4.25*(presS/p0)
+         else
+            abcoef = 0.0
+         endif
+         abcoef = abcoef*rho_w
+
+         ! unlike for Rayleigh scattering, we do not currently weight by the BB function
+         ! however our bands are normally thin, so this is no big deal.
+
+      endif
+
+      return
+    end subroutine interpolateH2Ocont_PPC
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateN2H2.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateN2H2.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateN2H2.F90	(revision 222)
@@ -0,0 +1,130 @@
+subroutine interpolateN2H2(wn,temp,presN2,presH2,abcoef,firstcall,ind)
+
+  !==================================================================
+  !     
+  !     Purpose
+  !     -------
+  !     Calculates the N2-H2 CIA opacity, using a lookup table from
+  !     HITRAN (2011)
+  !
+  !     Authors
+  !     -------
+  !     R. Wordsworth (2011)
+  !     
+  !==================================================================
+
+  use datafile_mod, only: datadir
+  implicit none
+
+  ! input
+  double precision wn                 ! wavenumber             (cm^-1)
+  double precision temp               ! temperature            (Kelvin)
+  double precision presN2             ! N2 partial pressure    (Pascals)
+  double precision presH2             ! H2 partial pressure    (Pascals)
+
+  ! output
+  double precision abcoef             ! absorption coefficient (m^-1)
+
+  integer nS,nT
+  parameter(nS=1914)
+  parameter(nT=10)
+
+  double precision, parameter :: losch = 2.6867774e19
+  ! Loschmit's number (molecule cm^-3 at STP) 
+  ! converts cm^5 molecule^-2 --> cm^-1 amagat^-2
+  ! see Richard et al. 2011, JQSRT for details
+
+  double precision amagatN2
+  double precision amagatH2
+  double precision wn_arr(nS)
+  double precision temp_arr(nT)
+  double precision abs_arr(nS,nT)
+
+  integer k,iT
+  logical firstcall
+
+  save wn_arr, temp_arr, abs_arr
+
+  character*100 dt_file
+  integer strlen,ios
+
+  character(LEN=*), parameter :: fmat1 = "(A20,F10.3,F10.3,I7,F7.1,E10.3,F5.3)"
+
+  character*20 bleh
+  double precision blah, Ttemp
+  integer nres
+  integer ind
+
+  if(temp.gt.400)then
+     print*,'Your temperatures are too high for this N2-H2 CIA dataset.'
+     print*,'Please run mixed N2-H2 atmospheres below T = 400 K.'      
+     stop
+  endif
+
+  amagatN2 = (273.15/temp)*(presN2/101325.0)
+  amagatH2 = (273.15/temp)*(presH2/101325.0)
+
+  if(firstcall)then ! called by sugas_corrk only
+     print*,'----------------------------------------------------'
+     print*,'Initialising N2-H2 continuum from HITRAN database...'
+
+     !     1.1 Open the ASCII files
+     dt_file=TRIM(datadir)//'/continuum_data/N2-H2_2011.cia'
+
+     open(33,file=dt_file,form='formatted',status='old',iostat=ios)
+     if (ios.ne.0) then        ! file not found
+        write(*,*) 'Error from interpolateN2H2'
+        write(*,*) 'Data file ',trim(dt_file),' not found.'
+        write(*,*) 'Check that your path to datagcm:',trim(datadir)
+        write(*,*) 'is correct. You can change it in callphys.def with:'
+        write(*,*) 'datadir = /absolute/path/to/datagcm'
+        write(*,*) 'Also check that the continuum data continuum_data/N2-H2_2011.cia is there.'
+        call abort
+     else
+
+        do iT=1,nT
+
+           read(33,fmat1) bleh,blah,blah,nres,Ttemp
+           if(nS.ne.nres)then
+              print*,'Resolution given in file: ',trim(dt_file)
+              print*,'is ',nres,', which does not match nS.'
+              print*,'Please adjust nS value in interpolateN2H2.F90'
+              stop
+           endif
+           temp_arr(iT)=Ttemp
+
+           do k=1,nS
+              read(33,*) wn_arr(k),abs_arr(k,it)
+           end do
+
+        end do
+
+     endif
+     close(33)
+
+     print*,'interpolateN2H2: At wavenumber ',wn,' cm^-1'
+     print*,'   temperature                 ',temp,' K'
+     print*,'   N2 partial pressure         ',presN2,' Pa'
+     print*,'   and H2 partial pressure     ',presH2,' Pa'
+
+  endif
+
+  call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arr,wn,temp,abcoef,ind)
+
+!     print*,'the absorption is ',abcoef,' cm^5 molecule^-2'
+!     print*,'or ',abcoef*losch**2,' cm^-1 amagat^-2'
+
+  abcoef=abcoef*losch**2*100.0*amagatN2*amagatH2 ! convert to m^-1
+
+!     print*,'We have ',amagatN2,' amagats of N2'
+!     print*,'and     ',amagatH2,' amagats of H2'
+!     print*,'So the absorption is ',abcoef,' m^-1'
+
+
+!  unlike for Rayleigh scattering, we do not currently weight by the BB function
+!  however our bands are normally thin, so this is no big deal.
+
+
+  return
+end subroutine interpolateN2H2
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateN2N2.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateN2N2.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateN2N2.F90	(revision 222)
@@ -0,0 +1,125 @@
+subroutine interpolateN2N2(wn,temp,pres,abcoef,firstcall,ind)
+
+  !==================================================================
+  !     
+  !     Purpose
+  !     -------
+  !     Calculates the N2-N2 CIA opacity, using a lookup table from
+  !     HITRAN (2011)
+  !
+  !     Authors
+  !     -------
+  !     R. Wordsworth (2011)
+  !     
+  !==================================================================
+
+  use datafile_mod, only: datadir
+  implicit none
+
+  ! input
+  double precision wn                 ! wavenumber             (cm^-1)
+  double precision temp               ! temperature            (Kelvin)
+  double precision pres               ! pressure               (Pascals)
+  integer :: ind
+
+  ! output
+  double precision abcoef             ! absorption coefficient (m^-1)
+
+  integer nS,nT
+  parameter(nS=582)
+  parameter(nT=10)
+
+  double precision, parameter :: losch = 2.6867774e19
+  ! Loschmit's number (molecule cm^-3 at STP) 
+  ! converts cm^5 molecule^-2 --> cm^-1 amagat^-2
+  ! see Richard et al. 2011, JQSRT for details
+
+  double precision amagat
+  double precision wn_arr(nS)
+  double precision temp_arr(nT)
+  double precision abs_arr(nS,nT)
+
+  integer k,iT
+  logical firstcall
+
+  save wn_arr, temp_arr, abs_arr
+
+  character*100 dt_file
+  integer strlen,ios
+
+  character(LEN=*), parameter :: fmat1 = "(A20,F10.3,F10.3,I7,F7.1,E10.3,F5.3)"
+
+  character*20 bleh
+  double precision blah, Ttemp
+  integer nres
+
+
+  if(temp.gt.400)then
+     print*,'Your temperatures are too high for this N2-N2 CIA dataset.'
+     print*,'Currently, HITRAN provides data for this pair in the range 40-400 K.'
+     stop
+  endif
+
+  amagat = (273.15/temp)*(pres/101325.0)
+
+  if(firstcall)then ! called by sugas_corrk only
+     print*,'----------------------------------------------------'
+     print*,'Initialising N2-N2 continuum from HITRAN database...'
+
+     !     1.1 Open the ASCII files
+     dt_file=TRIM(datadir)//'/continuum_data/N2-N2_2011.cia'
+
+     open(33,file=dt_file,form='formatted',status='old',iostat=ios)
+     if (ios.ne.0) then        ! file not found
+        write(*,*) 'Error from interpolateN2N2'
+        write(*,*) 'Data file ',trim(dt_file),' not found.'
+        write(*,*) 'Check that your path to datagcm:',trim(datadir)
+        write(*,*) 'is correct. You can change it in callphys.def with:'
+        write(*,*) 'datadir = /absolute/path/to/datagcm'
+        write(*,*) 'Also check that the continuum data continuum_data/N2-N2_norm_2011.cia is there.'
+        call abort
+     else
+
+        do iT=1,nT
+
+           read(33,fmat1) bleh,blah,blah,nres,Ttemp
+           if(nS.ne.nres)then
+              print*,'Resolution given in file: ',trim(dt_file)
+              print*,'is ',nres,', which does not match nS.'
+              print*,'Please adjust nS value in interpolateN2N2.F90'
+              stop
+           endif
+           temp_arr(iT)=Ttemp
+
+           do k=1,nS
+              read(33,*) wn_arr(k),abs_arr(k,it)
+           end do
+
+        end do
+
+     endif
+     close(33)
+
+     print*,'interpolateN2N2: At wavenumber ',wn,' cm^-1'
+     print*,'   temperature ',temp,' K'
+     print*,'   pressure ',pres,' Pa'
+
+  endif
+     call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arr,wn,temp,abcoef,ind)
+
+!     print*,'the absorption is ',abcoef,' cm^5 molecule^-2'
+!     print*,'or ',abcoef*losch**2,' cm^-1 amagat^-2'
+
+     abcoef=abcoef*losch**2*100.0*amagat**2 ! convert to m^-1
+!     abcoef=0.
+
+!     print*,'We have ',amagat,' amagats of N2'
+!     print*,'So the absorption is ',abcoef,' m^-1'
+
+!     unlike for Rayleigh scattering, we do not currently weight by the BB function
+!     however our bands are normally thin, so this is no big deal.
+
+
+  return
+end subroutine interpolateN2N2
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iostart.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iostart.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/iostart.F90	(revision 222)
@@ -0,0 +1,1031 @@
+MODULE iostart
+
+    IMPLICIT NONE
+PRIVATE
+    INTEGER,SAVE :: nid_start ! NetCDF file identifier for startfi.nc file
+    INTEGER,SAVE :: nid_restart ! NetCDF file identifier for restartfi.nc file
+    
+    ! restartfi.nc file dimension identifiers: (see open_restartphy())
+    INTEGER,SAVE :: idim1 ! "index" dimension
+    INTEGER,SAVE :: idim2 ! "physical_points" dimension
+    INTEGER,SAVE :: idim3 ! "subsurface_layers" dimension
+    INTEGER,SAVE :: idim4 ! "nlayer_plus_1" dimension
+    INTEGER,SAVE :: idim5 ! "number_of_advected_fields" dimension
+    INTEGER,SAVE :: idim6 ! "nlayer" dimension
+    INTEGER,SAVE :: idim7 ! "Time" dimension
+    INTEGER,SAVE :: idim8 ! "ocean_layers" dimension
+    INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields)
+    INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array
+    
+    INTERFACE get_field
+      MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
+    END INTERFACE get_field
+    
+    INTERFACE get_var
+      MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
+    END INTERFACE get_var
+
+    INTERFACE put_field
+      MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
+    END INTERFACE put_field
+
+    INTERFACE put_var
+      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
+    END INTERFACE put_var
+
+    PUBLIC nid_start, length
+    PUBLIC get_field,get_var,put_field,put_var
+    PUBLIC inquire_dimension, inquire_dimension_length
+    PUBLIC inquire_field, inquire_field_ndims
+    PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy
+    
+CONTAINS
+
+  SUBROUTINE open_startphy(filename)
+  USE netcdf, only: NF90_OPEN, NF90_NOERR, NF90_NOWRITE, nf90_strerror
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: filename
+    INTEGER          :: ierr
+
+    IF (is_master) THEN
+      ierr = NF90_OPEN (filename, NF90_NOWRITE, nid_start)
+      IF (ierr.NE.NF90_NOERR) THEN
+        write(*,*)'open_startphy: problem opening file '//trim(filename)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+    
+    CALL bcast(nid_start) ! tell all procs about nid_start
+  
+  END SUBROUTINE open_startphy
+
+  SUBROUTINE close_startphy
+  USE netcdf, only: NF90_CLOSE
+  USE mod_phys_lmdz_para, only: is_master
+  IMPLICIT NONE
+    INTEGER          :: ierr
+
+    IF (is_master) THEN
+        ierr = NF90_CLOSE (nid_start)
+    ENDIF
+
+  END SUBROUTINE close_startphy
+
+
+  FUNCTION inquire_field(Field_name)
+  ! check if a given field is present in the input file
+  USE netcdf, only: NF90_INQ_VARID, NF90_NOERR
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    LOGICAL :: inquire_field
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
+      IF (ierr==NF90_NOERR) THEN
+        Inquire_field=.TRUE.
+      ELSE
+        Inquire_field=.FALSE.
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_field)
+
+  END FUNCTION inquire_field
+
+
+  FUNCTION inquire_field_ndims(Field_name)
+  ! give the number of dimensions of "Field_name" stored in the input file 
+  USE netcdf, only: nf90_inq_varid, nf90_inquire_variable, &
+                    NF90_NOERR, nf90_strerror
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    INTEGER :: inquire_field_ndims
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=nf90_inq_varid(nid_start,Field_name,varid)
+      ierr=nf90_inquire_variable(nid_start,varid,&
+                                  ndims=inquire_field_ndims)
+      IF (ierr.NE.NF90_NOERR) THEN
+        write(*,*)'inquire_field_ndims: problem obtaining ndims of '&
+                  //trim(field_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_field_ndims)
+
+  END FUNCTION inquire_field_ndims
+
+
+  FUNCTION inquire_dimension(Field_name)
+  ! check if a given dimension is present in the input file
+  USE netcdf, only: nf90_inq_dimid, NF90_NOERR
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    LOGICAL :: inquire_dimension
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=NF90_INQ_DIMID(nid_start,Field_name,varid)
+      IF (ierr==NF90_NOERR) THEN
+        Inquire_dimension=.TRUE.
+      ELSE
+        Inquire_dimension=.FALSE.
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_dimension)
+
+  END FUNCTION inquire_dimension
+
+  FUNCTION inquire_dimension_length(Field_name)
+  ! give the length of the "Field_name" dimension stored in the input file
+  USE netcdf, only: nf90_inquire_dimension, nf90_inq_dimid, &
+                    NF90_NOERR, nf90_strerror
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    INTEGER :: inquire_dimension_length
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=nf90_inq_dimid(nid_start,Field_name,varid)
+      ierr=nf90_inquire_dimension(nid_start,varid,&
+                                  len=inquire_dimension_length)
+      IF (ierr.NE.NF90_NOERR) THEN
+        write(*,*)'inquire_field_length: problem obtaining length of '&
+                  //trim(field_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_dimension_length)
+
+  END FUNCTION inquire_dimension_length
+
+
+
+  SUBROUTINE Get_Field_r1(field_name,field,found,timeindex)
+  ! For a surface field
+  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
+
+    integer :: edges(4), corners(4)
+
+    edges(1)=klon_glo
+    edges(2:4)=1
+    corners(1:4)=1
+    if (PRESENT(timeindex)) then
+      corners(2)=timeindex
+    endif
+
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,1,corners,edges,found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,1,corners,edges)
+    ENDIF
+      
+  END SUBROUTINE Get_Field_r1
+  
+  SUBROUTINE Get_Field_r2(field_name,field,found,timeindex)
+  ! For a "3D" horizontal-vertical field
+  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:,:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
+
+    integer :: edges(4), corners(4)
+
+    edges(1)=klon_glo
+    edges(2)=size(field,2)
+    edges(3:4)=1
+    corners(1:4)=1
+    if (PRESENT(timeindex)) then
+      corners(3)=timeindex
+    endif
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,size(field,2),&
+                          corners,edges,found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,size(field,2),&
+                          corners,edges)
+    ENDIF
+
+      
+  END SUBROUTINE Get_Field_r2
+  
+  SUBROUTINE Get_Field_r3(field_name,field,found,timeindex)
+  ! for a "4D" field surf/alt/??
+  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:,:,:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
+
+    integer :: edges(4), corners(4)
+
+    edges(1)=klon_glo
+    edges(2)=size(field,2)
+    edges(3)=size(field,3)
+    edges(4)=1
+    corners(1:4)=1
+    if (PRESENT(timeindex)) then
+      corners(4)=timeindex
+    endif
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
+                          corners,edges,found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
+                          corners,edges)
+    ENDIF
+      
+  END SUBROUTINE Get_Field_r3
+  
+  SUBROUTINE Get_field_rgen(field_name,field,field_size, &
+                            corners,edges,found)
+  USE netcdf
+  USE dimphy
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: Field_name
+    INTEGER          :: field_size
+    REAL             :: field(klon,field_size)
+    INTEGER,INTENT(IN) :: corners(4)
+    INTEGER,INTENT(IN) :: edges(4)
+    LOGICAL,OPTIONAL :: found
+    
+    REAL    :: field_glo(klon_glo,field_size)
+    LOGICAL :: tmp_found
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+  
+      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
+      
+      IF (ierr==NF90_NOERR) THEN
+        CALL body(field_glo)
+        tmp_found=.TRUE.
+      ELSE
+        tmp_found=.FALSE.
+      ENDIF
+    
+    ENDIF
+    
+    CALL bcast(tmp_found)
+
+    IF (tmp_found) THEN
+      CALL scatter(field_glo,field)
+    ENDIF
+    
+    IF (PRESENT(found)) THEN
+      found=tmp_found
+    ELSE
+      IF (.NOT. tmp_found) THEN
+        PRINT*, 'get_field_rgen: Field <'//field_name//'> not found'
+        CALL abort
+      ENDIF
+    ENDIF
+ 
+    
+    CONTAINS
+     
+     SUBROUTINE body(field_glo)
+       REAL :: field_glo(klon_glo*field_size)
+         ierr=NF90_GET_VAR(nid_start,varid,field_glo,corners,edges)
+         IF (ierr/=NF90_NOERR) THEN
+           ! La variable exist dans le fichier mais la lecture a echouee. 
+           PRINT*, 'get_field_rgen: Failed reading <'//field_name//'>'
+
+!           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
+!              ! Essaye de lire le variable sur surface uniqument, comme fait avant
+!              field_glo(:)=0.
+!              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
+!              IF (ierr/=NF90_NOERR) THEN
+!                 PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
+!                 CALL abort
+!              ELSE
+!                 PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
+!              END IF
+!           ELSE
+              CALL abort
+!           ENDIF
+         ENDIF
+
+     END SUBROUTINE body
+
+  END SUBROUTINE Get_field_rgen
+
+
+  SUBROUTINE get_var_r0(var_name,var,found)
+  ! Get a scalar from input file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+
+    REAL                         :: varout(1)
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,varout,size(varout),found)
+    ELSE
+      CALL Get_var_rgen(var_name,varout,size(varout))
+    ENDIF
+    var=varout(1)
+ 
+  END SUBROUTINE get_var_r0
+
+  SUBROUTINE get_var_r1(var_name,var,found)
+  ! Get a vector from input file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var(:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r1
+
+  SUBROUTINE get_var_r2(var_name,var,found)
+  ! Get a 2D field from input file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(OUT)             :: var(:,:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r2
+
+  SUBROUTINE get_var_r3(var_name,var,found)
+  ! Get a 3D field frominput file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var(:,:,:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r3
+
+  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
+  USE netcdf
+  USE dimphy
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: var_name
+    INTEGER          :: var_size
+    REAL             :: var(var_size)
+    LOGICAL,OPTIONAL :: found
+    
+    LOGICAL :: tmp_found
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+  
+      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
+      
+      IF (ierr==NF90_NOERR) THEN
+        ierr=NF90_GET_VAR(nid_start,varid,var)
+        IF (ierr/=NF90_NOERR) THEN
+          PRINT*, 'phyetat0: Failed loading <'//trim(var_name)//'>'
+          CALL abort
+        ENDIF
+        tmp_found=.TRUE.
+      ELSE
+        tmp_found=.FALSE.
+      ENDIF
+    
+    ENDIF
+    
+    CALL bcast(tmp_found)
+
+    IF (tmp_found) THEN
+      CALL bcast(var)
+    ENDIF
+    
+    IF (PRESENT(found)) THEN
+      found=tmp_found
+    ELSE
+      IF (.NOT. tmp_found) THEN
+        PRINT*, 'phyetat0: Variable <'//trim(var_name)//'> not found'
+        CALL abort
+      ENDIF
+    ENDIF
+
+  END SUBROUTINE Get_var_rgen
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE open_restartphy(filename)
+  USE netcdf, only: NF90_CREATE, NF90_CLOBBER, NF90_64BIT_OFFSET, &
+                    NF90_NOERR, nf90_strerror, &
+                    NF90_PUT_ATT, NF90_GLOBAL, NF90_DEF_DIM, &
+                    NF90_UNLIMITED, NF90_ENDDEF, &
+                    NF90_WRITE, NF90_OPEN
+  USE mod_phys_lmdz_para, only: is_master
+  USE mod_grid_phy_lmdz, only: klon_glo
+  USE dimphy, only: klev, klevp1
+  USE infotrac, only: nqtot
+  USE comsoil_h, only: nsoilmx
+  USE slab_ice_h, only: noceanmx
+
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: filename
+    INTEGER                     :: ierr
+    LOGICAL,SAVE :: already_created=.false.
+    
+    IF (is_master) THEN
+      if (.not.already_created) then
+        ! At the very first call, create the file
+        ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
+                          nid_restart)
+        IF (ierr/=NF90_NOERR) THEN
+          write(*,*)'open_restartphy: problem creating file '//trim(filename)
+          write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+        already_created=.true.
+      else
+        ! Just open the file
+        ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
+        IF (ierr/=NF90_NOERR) THEN
+          write(*,*)'open_restartphy: problem opening file '//trim(filename)
+          write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+        return
+      endif ! of if (.not.already_created)
+
+      ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
+                        "Physics start file")
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem writing title '
+        write(*,*)trim(nf90_strerror(ierr))
+      ENDIF
+
+      ierr=NF90_DEF_DIM(nid_restart,"index",length,idim1)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining index dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining physical_points dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx,idim3)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining subsurface_layers dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining nlayer_plus_1 dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      if (nqtot>0) then
+        ! only define a tracer dimension if there are tracers
+        ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",nqtot,idim5)
+        IF (ierr/=NF90_NOERR) THEN
+          write(*,*)'open_restartphy: problem defining number_of_advected_fields dimension '
+          write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+      endif
+
+      ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining nlayer dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining Time dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+
+      ierr=NF90_DEF_DIM(nid_restart,"ocean_layers",noceanmx,idim8)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining oceanic layer dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+
+
+      ierr=NF90_ENDDEF(nid_restart)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem ending definition mode '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+
+  END SUBROUTINE open_restartphy
+
+  SUBROUTINE close_restartphy
+  USE netcdf, only: NF90_CLOSE
+  USE mod_phys_lmdz_para, only: is_master
+  IMPLICIT NONE
+    INTEGER          :: ierr
+
+    IF (is_master) THEN
+      ierr = NF90_CLOSE (nid_restart)
+    ENDIF
+ 
+  END SUBROUTINE close_restartphy
+
+  SUBROUTINE put_field_r1(field_name,title,field,time)
+  ! For a surface field
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  IF (present(time)) THEN
+    ! if timeindex is present, it is a time-dependent variable
+    CALL put_field_rgen(field_name,title,field,1,time)
+  ELSE
+    CALL put_field_rgen(field_name,title,field,1)
+  ENDIF
+  
+  END SUBROUTINE put_field_r1
+
+  SUBROUTINE put_field_r2(field_name,title,field,time)
+  ! For a "3D" horizontal-vertical field
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:,:)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  IF (present(time)) THEN
+    ! if timeindex is present, it is a time-dependent variable
+    CALL put_field_rgen(field_name,title,field,size(field,2),time)
+  ELSE
+    CALL put_field_rgen(field_name,title,field,size(field,2))
+  ENDIF
+  
+  END SUBROUTINE put_field_r2
+
+  SUBROUTINE put_field_r3(field_name,title,field,time)
+  ! For a "4D" field surf/alt/??
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:,:,:)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  IF (present(time)) THEN
+    ! if timeindex is present, it is a time-dependent variable
+    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3),&
+                        time)
+  ELSE  
+    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
+  ENDIF
+  
+  END SUBROUTINE put_field_r3
+  
+  SUBROUTINE put_field_rgen(field_name,title,field,field_size,time)
+  USE netcdf
+  USE dimphy
+  USE comsoil_h, only: nsoilmx
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  USE slab_ice_h, only: noceanmx
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  INTEGER,INTENT(IN)             :: field_size
+  REAL,INTENT(IN)                :: field(klon,field_size)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  REAL                           :: field_glo(klon_glo,field_size)
+  INTEGER                        :: ierr
+  INTEGER                        :: nvarid
+  INTEGER                        :: idim
+   
+    CALL gather(field,field_glo)
+    
+    IF (is_master) THEN
+
+      IF (field_size==1) THEN
+        ! input is a 1D "surface field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr=NF90_ENDDEF(nid_restart)
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim7/),nvarid)
+#endif
+            if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,timeindex/))
+        endif ! of if (.not.present(timeindex))
+
+      ELSE IF (field_size==klev) THEN
+        ! input is a 2D "atmospheric field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2,idim6/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2,idim6/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr=NF90_ENDDEF(nid_restart)
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim6,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim6,idim7/),nvarid)
+#endif
+            if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,1,timeindex/))
+        endif ! of if (.not.present(time))
+
+      ELSE IF (field_size==klevp1) THEN
+        ! input is a 2D "interlayer atmospheric field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2,idim4/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2,idim4/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr = NF90_ENDDEF(nid_restart)
+          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim4,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim4,idim7/),nvarid)
+#endif
+            if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,1,timeindex/))
+        endif ! of if (.not.present(timeindex))
+
+      ELSE IF (field_size==nsoilmx) THEN
+        ! input is a 2D "subsurface field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr = NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2,idim3/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2,idim3/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr = NF90_ENDDEF(nid_restart)
+          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim3,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim3,idim7/),nvarid)
+#endif
+           if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,1,timeindex/))
+
+        endif ! of if (.not.present(time))
+
+      ELSE IF (field_size==noceanmx) THEN
+        ! input is a 2D "oceanic field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr = NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2,idim8/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2,idim8/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr = NF90_ENDDEF(nid_restart)
+          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim8,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim8,idim7/),nvarid)
+#endif
+           if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,1,timeindex/))
+
+        endif ! of if (.not.present(time))
+
+
+      ELSE
+        PRINT *, "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name)
+        write(*,*) "  field_size =",field_size
+        CALL ABORT
+      ENDIF
+
+      ! Check the writting of field to file went OK
+      if (ierr.ne.NF90_NOERR) then
+        write(*,*) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        call abort
+      endif
+
+    ENDIF ! of IF (is_master)
+    
+  END SUBROUTINE put_field_rgen  
+  
+  SUBROUTINE put_var_r0(var_name,title,var)
+  ! Put a scalar in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var
+     REAL                        :: varin(1)
+     
+     varin(1)=var
+     
+     CALL put_var_rgen(var_name,title,varin,size(varin))
+
+  END SUBROUTINE put_var_r0
+
+
+  SUBROUTINE put_var_r1(var_name,title,var)
+  ! Put a vector in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r1
+ 
+  SUBROUTINE put_var_r2(var_name,title,var)
+  ! Put a 2D field in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:,:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r2     
+  
+  SUBROUTINE put_var_r3(var_name,title,var)
+  ! Put a 3D field in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:,:,:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r3
+
+  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
+  USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
+                    NF90_FLOAT, NF90_DOUBLE, &
+                    NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
+                    nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
+  USE comsoil_h, only: nsoilmx
+  USE mod_phys_lmdz_para, only: is_master
+  USE slab_ice_h, only: noceanmx
+  IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     INTEGER,INTENT(IN)          :: var_size
+     REAL,INTENT(IN)             :: var(var_size)
+     
+     INTEGER :: ierr
+     INTEGER :: nvarid
+     INTEGER :: idim1d
+     logical,save :: firsttime=.true.
+         
+    IF (is_master) THEN
+
+      IF (var_name=="Time") THEN
+        ! Very specific case of "Time" variable
+        if (firsttime) then
+          ! Create the "Time variable"
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,&
+                            (/idim7/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,&
+                            (/idim7/),nvarid)
+#endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr=NF90_ENDDEF(nid_restart)
+          
+          firsttime=.false.
+        endif
+        ! Append "time" value
+        ! get current length of "Time" dimension
+        ierr=nf90_inq_dimid(nid_restart,var_name,idim1d)
+        ierr=nf90_inquire_dimension(nid_restart,idim1d,len=timeindex)
+        timeindex=timeindex+1
+        ierr=NF90_INQ_VARID(nid_restart,var_name,nvarid)
+        ierr=NF90_PUT_VAR(nid_restart,nvarid,var,&
+                           start=(/timeindex/))
+        IF (ierr/=NF90_NOERR) THEN
+          write(*,*)'put_var_rgen: problem writing Time'
+          write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+        return ! nothing left to do
+      ELSEIF (var_size==length) THEN
+        ! We know it is a "controle" kind of 1D array
+        idim1d=idim1
+      ELSEIF (var_size==nsoilmx) THEN
+        ! We know it is an  "mlayer" kind of 1D array
+        idim1d=idim3
+      ELSEIF (var_size==noceanmx) THEN
+        ! We know it is an  "mlayer" kind of 1D array
+        idim1d=idim8
+      ELSE 
+        PRINT *, "put_var_rgen error : wrong dimension"
+        write(*,*) "  var_size =",var_size
+        CALL abort
+
+      ENDIF ! of IF (var_size==length) THEN
+
+      ! Swich to NetCDF define mode
+      ierr=NF90_REDEF (nid_restart)
+      ! Define the variable
+#ifdef NC_DOUBLE
+      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,(/idim1d/),nvarid)
+#else
+      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,(/idim1d/),nvarid)
+#endif
+      ! Add a "title" attribute
+      IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+      ! Swich out of define mode
+      ierr=NF90_ENDDEF(nid_restart)
+      ! Write variable to file
+      ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'put_var_rgen: problem writing '//trim(var_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF ! of IF (is_master)
+    
+  END SUBROUTINE put_var_rgen     
+
+END MODULE iostart
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/kcm1d.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/kcm1d.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/kcm1d.F90	(revision 222)
@@ -0,0 +1,375 @@
+program kcm1d
+
+  use infotrac, only: nqtot
+  use radinc_h,      only: NAERKIND
+  use radcommon_h,   only: L_NSPECTI, L_NSPECTV, sigma
+  use watercommon_h, only: mH2O
+  use ioipsl_getincom, only: getin
+  use comsaison_h, only: mu0, fract, dist_star
+!  use control_mod
+
+  implicit none
+
+  !==================================================================
+  !     
+  !     Purpose
+  !     -------
+  !     Run the universal model radiative transfer once in a 1D column.
+  !     Useful for climate evolution studies etc.
+  !     
+  !     It can be compiled with a command like (e.g. for 25 layers):
+  !                                  "makegcm -p std -d 25 kcm1d"
+  !     It requires the files "callphys.def", "gases.def"
+  !     "traceur.def", and "run.def" with a line "INCLUDEDEF=callphys.def"
+  !
+  !     Authors
+  !     -------
+  !     R. Wordsworth
+  !
+  !==================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+!#include "control.h"
+
+  ! --------------------------------------------------------------
+  !  Declarations
+  ! --------------------------------------------------------------
+
+  integer nlayer,nlevel,nq
+  integer ilay,ilev,iq,iw,iter
+  real play(nlayermx)     ! Pressure at the middle of the layers [Pa]
+  real zlay(nlayermx)     ! Altitude at middle of the layers [km]
+  real plev(nlayermx+1)   ! Intermediate pressure levels [Pa]
+  real temp(nlayermx)     ! temperature at the middle of the layers [K]
+  real,allocatable :: q(:,:)   ! tracer mixing ratio [kg/kg]
+  real,allocatable :: vmr(:,:) ! tracer mixing ratio [mol/mol]
+  real,allocatable :: qsurf(:)        ! tracer surface budget [kg/kg] ????
+  real psurf,psurf_n,tsurf      
+
+  real emis, albedo
+
+  real muvar(nlayermx+1)
+
+  real dtsw(nlayermx) ! heating rate (K/s) due to SW
+  real dtlw(nlayermx) ! heating rate (K/s) due to LW
+  real fluxsurf_lw   ! incident LW flux to surf (W/m2)
+  real fluxtop_lw    ! outgoing LW flux to space (W/m2)
+  real fluxsurf_sw   ! incident SW flux to surf (W/m2)
+  real fluxabs_sw    ! SW flux absorbed by planet (W/m2)
+  real fluxtop_dn    ! incident top of atmosphere SW flux (W/m2)
+
+  ! not used
+  real reffrad(nlayermx,naerkind)
+  real nueffrad(nlayermx,naerkind)
+  real cloudfrac(nlayermx)
+  real totcloudfrac
+  real tau_col
+
+  real dTstrat
+  real aerosol(nlayermx,naerkind) ! aerosol tau (kg/kg)
+  real OLR_nu(1,L_NSPECTI)
+  real OSR_nu(1,L_NSPECTV)
+  real Eatmtot
+
+  integer ierr
+  logical firstcall,lastcall,global1d
+
+  character*20,allocatable :: nametrac(:)   ! name of the tracer (no need for adv trac common)
+
+  ! --------------
+  ! Initialisation
+  ! --------------
+
+  pi=2.E+0*asin(1.E+0)
+
+  reffrad(:,:)  = 0.0
+  nueffrad(:,:) = 0.0
+  cloudfrac(:)  = 0.0
+  totcloudfrac  = 0.0
+
+
+  nlayer=nlayermx
+  nlevel=nlayer+1
+
+  !! this is defined in comsaison_h
+  ALLOCATE(mu0(1))
+  ALLOCATE(fract(1))
+
+
+
+  !  Load parameters from "run.def" 
+  ! -------------------------------
+
+  ! check if 'kcm1d.def' file is around (otherwise reading parameters
+  ! from callphys.def via getin() routine won't work.)
+  open(90,file='kcm1d.def',status='old',form='formatted',&
+       iostat=ierr)
+  if (ierr.ne.0) then
+     write(*,*) 'Cannot find required file "kcm1d.def"'
+     write(*,*) '  (which should contain some input parameters'
+     write(*,*) '   along with the following line:'
+     write(*,*) '   INCLUDEDEF=callphys.def'
+     write(*,*) '   )'
+     write(*,*) ' ... might as well stop here ...'
+     stop
+  else
+     close(90)
+  endif
+
+! now, run.def is needed anyway. so we create a dummy temporary one
+! for ioipsl to work. if a run.def is already here, stop the
+! program and ask the user to do a bit of cleaning
+  open(90,file='run.def',status='old',form='formatted',& 
+       iostat=ierr)
+  if (ierr.eq.0) then
+     close(90)
+     write(*,*) 'There is already a run.def file.'
+     write(*,*) 'This is not compatible with 1D runs.'
+     write(*,*) 'Please remove the file and restart the run.'
+     write(*,*) 'Runtime parameters are supposed to be in kcm1d.def'
+     stop
+  else
+     call system('touch run.def')
+     call system("echo 'INCLUDEDEF=callphys.def' >> run.def")
+     call system("echo 'INCLUDEDEF=kcm1d.def' >> run.def")
+  endif
+
+  global1d = .false. ! default value
+  call getin("global1d",global1d)
+  if(.not.global1d)then
+     print*,'Error, kcm1d must have global1d=.true. in kcm1d.def!'
+     stop
+  end if
+
+  psurf_n=100000. ! default value for psurf
+  print*,'Dry surface pressure (Pa)?'
+  call getin("psurf",psurf_n)
+  write(*,*) " psurf = ",psurf_n
+
+! OK. now that run.def has been read once -- any variable is in memory.
+! so we can dump the dummy run.def
+  call system("rm -rf run.def")
+
+  tsurf=300.0 ! default value for tsurf
+  print*,'Surface temperature (K)?'
+  call getin("tref",tsurf)
+  write(*,*) " tsurf = ",tsurf
+
+  g=10.0 ! default value for g
+  print*,'Gravity ?'
+  call getin("g",g)
+  write(*,*) " g = ",g
+
+  periastr = 1.0
+  apoastr  = 1.0
+  print*,'Periastron (AU)?'
+  call getin("periastr",periastr)
+  write(*,*) "periastron = ",periastr
+  dist_star = periastr 
+  fract     = 0.5
+  print*,'Apoastron (AU)?'
+  call getin("apoastr",apoastr)
+  write(*,*) "apoastron = ",apoastr
+
+  albedo=0.2 ! default value for albedo
+  print*,'Albedo of bare ground?'
+  call getin("albedo",albedo)
+  write(*,*) " albedo = ",albedo
+
+  emis=1.0 ! default value for emissivity
+  PRINT *,'Emissivity of bare ground ?'
+  call getin("emis",emis)
+  write(*,*) " emis = ",emis
+
+  pceil=100.0 ! Pascals
+  PRINT *,'Ceiling pressure (Pa) ?'
+  call getin("pceil",pceil)
+  write(*,*) " pceil = ", pceil
+
+  mugaz=0.
+  cpp=0.
+
+  check_cpp_match = .false.
+  call getin("check_cpp_match",check_cpp_match)
+  if (check_cpp_match) then
+     print*,"In 1D modeling, check_cpp_match is supposed to be F"
+     print*,"Please correct callphys.def"
+     stop
+  endif
+
+  call su_gases
+  call calc_cpp_mugaz
+
+  call inifis(1,llm,0,86400.0,1.0,0.0,0.0,1.0,rad,g,r,cpp)
+
+  ! Tracer initialisation
+  ! ---------------------
+  if (tracer) then
+     ! load tracer names from file 'traceur.def'
+     open(90,file='traceur.def',status='old',form='formatted',&
+          iostat=ierr)
+     if (ierr.eq.0) then
+        write(*,*) "kcm1d: Reading file traceur.def"
+        ! read number of tracers:
+        read(90,*,iostat=ierr) nq
+        if (ierr.ne.0) then
+           write(*,*) "kcm1d: error reading number of tracers"
+           write(*,*) "   (first line of traceur.def) "
+           stop
+        endif
+        nqtot=nq
+        ! allocate arrays which depend on number of tracers
+        allocate(nametrac(nq))
+        allocate(q(nlayermx,nq))
+        allocate(vmr(nlayermx,nq))
+        allocate(qsurf(nq))
+
+        do iq=1,nq
+           ! minimal version, just read in the tracer names, 1 per line
+           read(90,*,iostat=ierr) nametrac(iq)
+           if (ierr.ne.0) then
+              write(*,*) 'kcm1d: error reading tracer names...'
+              stop
+           endif
+        enddo !of do iq=1,nq
+     endif
+
+     call initracer(1,nq,nametrac)
+
+  endif
+
+
+  do iq=1,nq
+     do ilay=1,nlayer
+        q(ilay,iq) = 0.
+     enddo
+  enddo
+
+  do iq=1,nq
+     qsurf(iq) = 0.
+  enddo
+
+  firstcall = .true.
+  lastcall  = .false.
+
+  iter    = 1
+  Tstrat  = 150.0
+  dTstrat = 1000.0
+
+  ! ---------
+  ! Run model
+  ! ---------
+  !do
+     psurf = psurf_n
+
+     !    Create vertical profiles
+     call kcmprof_fn(psurf,qsurf(1),tsurf,    &
+          tstrat,play,plev,zlay,temp,q(:,1),muvar(1))
+
+     !    Run radiative transfer
+     call callcorrk(1,nlayer,q,nq,qsurf,      &
+          albedo,emis,mu0,plev,play,temp,                    &
+          tsurf,fract,dist_star,aerosol,muvar,         &
+          dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,    &
+          fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,reffrad,nueffrad,tau_col,  &
+          cloudfrac,totcloudfrac,.false.,firstcall,lastcall)
+
+     !    Iterate stratospheric temperature
+     print*,'Tstrat = ',Tstrat
+     dTstrat = Tstrat
+     !Tstrat  = Tsurf*(0.2786*(psurf/100000.)**(-1.123))**0.25 
+     ! skin temperature (gray approx.) using analytic pure H2 expression
+     !Tstrat  = (fluxabs_sw/(2*sigma))**0.25 ! skin temperature (gray approx.)
+     Tstrat  = (fluxtop_lw/(2*sigma))**0.25 ! skin temperature (gray approx.)
+     dTstrat = dTstrat-Tstrat
+
+     !if(abs(dTstrat).lt.1.0)then
+     !   print*,'dTstrat = ',dTstrat
+     !   exit
+     !endif
+
+     !iter=iter+1
+     !if(iter.eq.100)then
+     !   print*,'Stratosphere failed to converge after'
+     !   print*,'100 iteration, aborting run.'
+     !   call abort
+     !endif
+
+  !end do
+
+  ! Run radiative transfer one last time to get OLR,OSR
+  firstcall=.false.
+  lastcall=.true.
+  call callcorrk(1,nlayer,q,nq,qsurf,      &
+       albedo,emis,mu0,plev,play,temp,                    &
+       tsurf,fract,dist_star,aerosol,muvar,         &
+       dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,    &
+       fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,             &
+       reffrad,nueffrad,tau_col,  &
+       cloudfrac,totcloudfrac,.false.,firstcall,lastcall)
+
+
+  ! Calculate total atmospheric energy
+  Eatmtot=0.0
+  !  call calcenergy_kcm(tsurf,temp,play,plev,qsurf,&
+  !     q(:,1),muvar,Eatmtot)
+
+  ! ------------------------
+  ! Save data to ascii files
+  ! ------------------------
+
+  print*,'Saving profiles...'
+  open(115,file='profpres.out',form='formatted')
+  open(116,file='proftemp.out',form='formatted')
+  open(117,file='profztab.out',form='formatted')
+  open(118,file='profqvar.out',form='formatted')
+  open(119,file='profvvar.out',form='formatted')
+
+  write(115,*) psurf
+  write(116,*) tsurf
+  write(117,*) 0.0
+  write(118,*) qsurf(1)
+  write(119,*) qsurf(1)*(muvar(1)/mH2O)
+  do ilay=1,nlayer
+     vmr(ilay,1) = q(ilay,1)*(muvar(ilay+1)/mH2O)
+     write(115,*) play(ilay)
+     write(116,*) temp(ilay)
+     write(117,*) zlay(ilay)
+     write(118,*) q(ilay,1)
+     write(119,*) vmr(ilay,1)
+  enddo
+  close(115)
+  close(116)
+  close(117)
+  close(118)
+  close(119)
+
+  print*, tsurf,psurf,fluxtop_dn,fluxabs_sw,fluxtop_lw 
+
+  print*,'Saving scalars...'
+  open(116,file='surf_vals.out')
+  write(116,*) tsurf,psurf,fluxtop_dn,         &
+       fluxabs_sw,fluxtop_lw 
+  close(116)
+  open(111,file='ene_vals.out')
+  write(111,*) tsurf,psurf,Eatmtot,Tstrat
+  close(111)
+
+  print*,'Saving spectra...'
+  open(117,file='OLRnu.out')
+  do iw=1,L_NSPECTI
+     write(117,*) OLR_nu(1,iw)
+  enddo
+  close(117)
+
+  open(127,file='OSRnu.out')
+  do iw=1,L_NSPECTV
+     write(127,*) OSR_nu(1,iw)
+  enddo
+  close(127)  
+
+end program kcm1d
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/kcmprof_fn.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/kcmprof_fn.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/kcmprof_fn.F90	(revision 222)
@@ -0,0 +1,391 @@
+subroutine kcmprof_fn(psurf_rcm,qsurf_rcm,Tsurf_rcm,Tstra_rcm,P_rcm,Pl_rcm,z_rcm,T_rcm,q_rcm,m_rcm)
+
+use params_h
+use watercommon_h, only : mH2O
+use gases_h
+implicit none
+
+!     ----------------------------------------------------------------
+!     Purpose: create profiles of T, rho_v, rho_n, Pv and Pn following 
+!              Kasting 1988
+!     Authour: Adapted from a code by E. Marcq by R. Wordsworth (2011)
+!     ----------------------------------------------------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+  integer ilay, nlay
+  parameter (nlay=10000) ! number of vertical layers
+
+  ! rcm inputs
+  real Tsurf_rcm,Tstra_rcm
+
+  ! rcm outputs
+  real psurf_rcm,qsurf_rcm
+  real P_rcm(1:nlayermx)
+  real Pl_rcm(1:nlayermx+1)
+  real z_rcm(1:nlayermx)
+  real T_rcm(1:nlayermx),q_rcm(1:nlayermx)
+  real m_rcm(1:nlayermx+1)
+
+  ! rcm for interpolation (should really use log coords?)
+  !double precision p1,p2,pnew,ilay_rcm
+
+  double precision lnp1,lnp2,lnpnew
+  real Dp_rcm, dlogp_rcm
+  integer ilay_rcm,ilev_rcm,ifinal_rcm
+
+  double precision Dz, Dp
+  double precision Ptop, dlogp, Psat_max
+  parameter (Ptop=1.0)                             ! Pressure at TOA [Pa]
+
+  double precision T(1:nlay)                       ! temperature [K]
+  double precision Ztab(1:nlay)                    ! altitude [m]
+  double precision Pv(1:nlay),Pn(1:nlay),P(1:nlay) ! pressure [Pa]
+  double precision rho_v(1:nlay), rho_n(1:nlay)    ! density [kg m^-3]
+  double precision a_v(1:nlay)                     ! = rho_v/rho_n [kg/kg]
+  double precision q_v(1:nlay)                     ! = rho_v/rho_tot [kg/kg]
+  double precision mtot(1:nlay)                    ! = (rho_v+rho_n)/(n_v+n_n) [g/mol]
+
+  integer profil_flag(1:nlay) ! 0 = dry, 1 = moist, 2 = isothermal
+
+  ! inputs
+  double precision Tsurf   ! surface temperature [K]
+  double precision Psurf_v ! surface par. pressure (variable species) [Pa]
+  double precision Psurf_n ! surface par. pressure (incondensible species)[Pa]
+  double precision Ttop    ! stratospheric temperature [K]
+
+  double precision dTdp        ! [K/Pa]
+  double precision dPvdp,dPndp ! [Pa/Pa]
+  double precision psat_v      ! local Psat_H2O value
+  double precision Tcrit       ! Critical temperature [K]
+  double precision rho_vTEMP,rho_nTEMP
+
+  double precision TCO2cond ! for CO2 condensation quasi-hack
+
+  ! variables necessary for steam.f90
+  double precision rhol,rhov,nul
+
+  ! for output
+  double precision vmr
+
+  logical verbose
+  parameter(verbose=.true.)
+
+  logical add_Pvar_to_total
+  parameter(add_Pvar_to_total=.true.)
+
+  ! initialise flags
+  profil_flag(:) = 0
+
+  !-------------------------------
+  ! assign input variables
+  m_n     = dble(mugaz/1000.)
+  cp_n    = cpp
+  ! modify/generalise later??
+
+  Psat_max = 1000000.0 ! maximum vapour pressure [Pa]
+                       ! set huge until further notice 
+
+  if(vgas.lt.1)then
+     if(psat_max.gt.0.0)then
+        print*,'Must have Psat_max=0 if no variable species'
+        psat_max=0.0
+        !stop
+     endif
+     print*, 'Assuming pure atmosphere'
+     m_v   = 1.0
+     tcrit = 1000.0
+  elseif(trim(gnom(vgas)).eq.'H2O')then
+     m_v   = dble(mH2O/1000.)
+     tcrit = 6.47d2
+  elseif(trim(gnom(vgas)).eq.'NH3')then
+     m_v   = 17.031/1000.
+     tcrit = 4.06d2
+  elseif(trim(gnom(vgas)).eq.'CH4')then
+     m_v   = 16.04/1000.
+     tcrit = 1.91d2
+     stop
+  else
+     print*,'Variable gas not recognised!'
+     call abort
+  endif
+
+  rmn     = rc/m_n
+  Ttop    = dble(Tstra_rcm)
+  Tsurf   = dble(Tsurf_rcm)
+
+  psat_v  = psat_max
+  if(vgas.gt.0)then
+     if(trim(gnom(vgas)).eq.'H2O')then
+        call Psat_H2O(tsurf,psat_v)
+     elseif(trim(gnom(vgas)).eq.'NH3')then
+        call Psat_NH3(tsurf,psat_v)
+     endif
+  endif
+
+  ! Moist adiabat unless greater than or equal to psat_max
+  if(psat_v*1d6.lt.psat_max)then
+    Psurf_v = Psat_v*1d6
+    profil_flag(1) = 1
+  else 
+    Psurf_v = psat_max
+    profil_flag(1) = 0
+  endif
+
+  if(add_Pvar_to_total)then
+    Psurf_n = dble(psurf_rcm)
+    psurf_rcm = real(Psurf_n+Psurf_v)
+  else
+    Psurf_n = dble(psurf_rcm) - Psurf_v
+  endif
+
+  ! include relative humidity option
+  !if(satval.lt.1.0)then
+  !   Psurf_v = Psurf_v*satval
+  !   profil_flag(1) = 0     
+  !endif
+
+  if(verbose)then
+     print*,'Psat_v  =',psat_v*1d6
+     print*,'Tsurf   =',Tsurf,' K'
+     print*,'Ttop    =',Ttop,' K'
+     print*,'Psurf_v =',Psurf_v,' Pa'
+     print*,'Psurf_n =',Psurf_n,' Pa'
+     print*,'m_n     =',m_n,' kg/mol'
+     print*,'m_v     =',m_v,' kg/mol'
+     print*,'rc      =',rc
+  endif
+
+  ! define fine pressure grid
+  dlogp_rcm = -(log(psurf_rcm)-log(ptop))/nlayermx
+
+  P_rcm(1)  = psurf_rcm*exp(dlogp_rcm)
+  do ilay_rcm=1,nlayermx-1
+     P_rcm(ilay_rcm+1) = P_rcm(ilay_rcm)*exp(dlogp_rcm)
+  enddo
+
+  Pl_rcm(1) = psurf_rcm
+  do ilev_rcm=2,nlayermx
+     ! log-linear interpolation
+     Pl_rcm(ilev_rcm) = exp( log( P_rcm(ilev_rcm)*P_rcm(ilev_rcm-1) )/2 )
+  enddo
+
+  !-------------------------------
+  ! Layer 1
+  T(1)     = Tsurf
+  Pv(1)    = Psurf_v
+  Pn(1)    = Psurf_n
+  rho_n(1) = m_n*Pn(1)/(Rc*Tsurf)
+  rho_v(1) = m_v*Pv(1)/(Rc*Tsurf)
+  a_v(1)   = rho_v(1)/rho_n(1)
+
+  ! log pressure grid spacing (constant)
+  dlogp = -(log(Pn(1)+Pv(1))-log(ptop))/(nlay-1)
+
+  call gradients_kcm(profil_flag(1),rho_v(1),rho_n(1),Tsurf,dTdp,dPvdp,dPndp)
+  if(verbose)then
+     print*, 'dT/dp ground [K/Pa] =',dTdp
+  endif
+
+  ! initial delta p, delta z
+  Dp = (Pn(1) + Pv(1))*(exp(dlogp) - 1d0)
+  Dz = -Dp/(  g*(rho_n(1) + rho_v(1))  )
+
+  !-------------------------------
+  ! Layer 2
+  T(2)     = tsurf + dTdp*Dp 
+  Pv(2)    = Pv(1) + dPvdp*Dp
+  Pn(2)    = Pn(1) + dPndp*Dp
+  rho_n(2) = m_n*Pn(2)/(Rc*T(2))
+  rho_v(2) = m_v*Pv(2)/(Rc*T(2))
+  a_v(2)   = rho_v(2)/rho_n(2)
+
+  !-------------------------------
+  ! start vertical ascent
+  Ztab(1) = 0.
+  do ilay=2,nlay-1
+
+     ! calculate altitude levels (for diagnostic only)
+     Dz         = -Dp/(  g*(rho_n(ilay) + rho_v(ilay))  )
+     Ztab(ilay) = Dz + Ztab(ilay-1)
+
+     ! 1st assume next layer same as last one
+     profil_flag(ilay) = profil_flag(ilay-1)
+  
+     ! update delta p
+     Dp = (Pn(ilay)+Pv(ilay))*(exp(dlogp) - 1d0)
+
+     ! intial gradients call to calculate temperature at next level
+     call gradients_kcm(profil_flag(ilay),rho_v(ilay),rho_n(ilay),&
+                        T(ilay),dTdp,dPvdp,dPndp)
+
+     T(ilay+1) = T(ilay) + dTdp*Dp
+
+     ! test for moist adiabat at next level
+     psat_v=psat_max
+
+     if(vgas.gt.0)then
+     if(trim(gnom(vgas)).eq.'H2O')then
+        call Psat_H2O(T(ilay+1),psat_v)
+     elseif(trim(gnom(vgas)).eq.'NH3')then
+        call Psat_NH3(T(ilay+1),psat_v)
+     endif
+     endif
+
+     if (psat_v*1d6 .lt. Pv(ilay)+dPvdp*Dp) then
+        profil_flag(ilay)=1
+        call gradients_kcm(profil_flag(ilay),rho_v(ilay),rho_n(ilay),&
+                         T(ilay),dTdp,dPvdp,dPndp)
+     endif
+
+     ! test for stratosphere at next level
+     if (T(ilay+1) .le. Ttop) then
+        profil_flag(ilay)=2
+        T(ilay+1)=Ttop
+     endif
+
+     ! calculate pressures at next level
+     Pn(ilay+1) = Pn(ilay) + dPndp*Dp
+     Pv(ilay+1) = Pv(ilay) + dPvdp*Dp
+
+     if(profil_flag(ilay) .eq. 1)then
+       
+        psat_v=psat_max 
+
+        if(vgas.gt.0)then
+        if(trim(gnom(vgas)).eq.'H2O')then
+           call Psat_H2O(T(ilay+1),psat_v)
+        elseif(trim(gnom(vgas)).eq.'NH3')then
+           call Psat_NH3(T(ilay+1),psat_v)
+        endif
+        endif
+
+        if(Pv(ilay+1) .lt. psat_v*1e6)then
+           Pv(ilay+1)=psat_v*1d6
+        endif
+
+     endif
+
+     ! calculate gas densities at next level (assume ideal)
+     rho_n(ilay+1) = m_n*Pn(ilay+1)/(rc*T(ilay+1)) 
+     select case(profil_flag(ilay)) 
+     case(2) ! isothermal
+        rho_v(ilay+1) = rho_v(ilay)/rho_n(ilay)*rho_n(ilay+1)
+     case(1) ! moist
+
+        ! dont think this is necessary
+        !call psat_est(T(ilay+1),psat_v)
+        ! modify for ammonia!!!
+
+        rho_v(ilay+1) = m_v*psat_v*1d6/(rc*T(ilay+1))
+     case(0) ! dry
+        rho_v(ilay+1) = m_v*Pv(ilay+1)/(rc*T(ilay+1)) 
+     end select
+
+  enddo
+
+  Ztab(nlay)=Ztab(nlay-1)+Dz
+
+  !-------------------------------
+  ! save to kcm1d variables 
+
+  ! surface quantities
+  psurf_rcm = Pn(1) + Pv(1)
+  qsurf_rcm = rho_v(1)/(rho_v(1) + rho_n(1))
+
+  ! create q_v, mtot for saving
+  do ilay=1,nlay
+     mtot(ilay) = 1d3*(rho_v(ilay) + rho_n(ilay)) / &
+                  (rho_v(ilay)/m_v + rho_n(ilay)/m_n)
+     q_v(ilay)  = rho_v(ilay)/(rho_v(ilay) + rho_n(ilay))
+     ! CHECK THIS
+  enddo
+
+
+  ! convert to rcm lower-res grid
+  z_rcm(:) = 0.0
+  T_rcm(:) = 0.0
+  q_rcm(:) = 0.0
+  m_rcm(:) = 0.0
+
+  m_rcm(1) = real( 1d3*(rho_v(1) + rho_n(1)) / &
+                  (rho_v(1)/m_v + rho_n(1)/m_n) )
+
+  ilay_rcm=1
+  do ilay=2,nlay
+
+     if(ilay_rcm.le.nlayermx)then
+     ! interpolate rcm variables
+
+        if(Pn(ilay)+Pv(ilay) .lt. P_rcm(ilay_rcm))then
+
+           if(ilay.eq.1)then
+              print*,'Error in create_profils: Psurf here less than Psurf in RCM!'
+              call abort
+           endif
+
+           lnp1   = log(Pn(ilay-1)+Pv(ilay-1))
+           lnp2   = log(Pn(ilay)+Pv(ilay))
+           lnpnew = dble(log(P_rcm(ilay_rcm)))
+
+           z_rcm(ilay_rcm) = real(Ztab(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + Ztab(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+           T_rcm(ilay_rcm) = real(T(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + T(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+           q_rcm(ilay_rcm) = real(q_v(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + q_v(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+
+           m_rcm(ilay_rcm+1) = real(mtot(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + mtot(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+
+           ilay_rcm = ilay_rcm+1
+        endif
+
+     endif
+  enddo
+
+  ifinal_rcm=ilay_rcm-1
+  if(ifinal_rcm.lt.nlayermx)then
+     if(verbose)then
+        print*,'Interpolation in kcmprof stopped at layer',ilay_rcm,'!'
+     endif
+
+     do ilay_rcm=ifinal_rcm+1,nlayermx
+
+        z_rcm(ilay_rcm) = z_rcm(ilay_rcm-1)
+        T_rcm(ilay_rcm) = T_rcm(ilay_rcm-1)
+        q_rcm(ilay_rcm) = q_rcm(ilay_rcm-1)
+        m_rcm(ilay_rcm+1) = m_rcm(ilay_rcm)
+
+     enddo
+  endif
+
+  do ilay=2,nlayermx
+     if(T_rcm(ilay).lt.Ttop)then
+        T_rcm(ilay)=Ttop
+     endif
+  enddo
+
+!    CO2 condensation 'haircut' of temperature profile if necessary
+  if(co2cond)then
+     print*,'CO2 condensation haircut - assumes CO2-dominated atmosphere!'
+     do ilay=2,nlayermx
+        if(P_rcm(ilay).lt.518000.)then
+           TCO2cond = (-3167.8)/(log(.01*P_rcm(ilay))-23.23) ! Fanale's formula
+        else
+           TCO2cond = 684.2-92.3*log(P_rcm(ilay))+4.32*log(P_rcm(ilay))**2 
+           ! liquid-vapour transition (based on CRC handbook 2003 data)
+        endif
+
+        print*,'p=',P_rcm(ilay),', T=',T_rcm(ilay),' Tcond=',TCO2cond
+        if(T_rcm(ilay).lt.TCO2cond)then
+           T_rcm(ilay)=TCO2cond
+        endif
+     enddo
+  endif
+
+  return
+end subroutine kcmprof_fn
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/lagrange.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/lagrange.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/lagrange.F	(revision 222)
@@ -0,0 +1,30 @@
+      subroutine lagrange(x, xi, yi, ans)
+
+C  Lagrange interpolation - Polynomial interpolation at point x 
+C  xi(1) <= x <= xi(4).  Yi(n) is the functional value at XI(n).
+
+      implicit none
+
+      real*8 x, xi(4), yi(4), ans
+      real*8 fm1, fm2, fm3, fm4
+
+C======================================================================!
+
+      fm1   = x - XI(1)
+      fm2   = x - XI(2)
+      fm3   = x - XI(3)
+      fm4   = x - XI(4)
+
+C  Get the answer at the requested X
+ 
+      ans = fm2*fm3*fm4*YI(1)/
+     *                ((XI(1)-XI(2))*(XI(1)-XI(3))*(XI(1)-XI(4)))  +
+     *      fm1*fm3*fm4*YI(2)/
+     *                ((XI(2)-XI(1))*(XI(2)-XI(3))*(XI(2)-XI(4)))  +
+     *      fm1*fm2*fm4*YI(3)/
+     *                ((XI(3)-XI(1))*(XI(3)-XI(2))*(XI(3)-XI(4)))  +
+     *      fm1*fm2*fm3*YI(4)/
+     *                ((XI(4)-XI(1))*(XI(4)-XI(2))*(XI(4)-XI(3))) 
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/largescale.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/largescale.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/largescale.F90	(revision 222)
@@ -0,0 +1,177 @@
+      subroutine largescale(ngrid,nq,ptimestep, pplev, pplay, pt, pq,   &
+                        pdt, pdq, pdtlsc, pdqvaplsc, pdqliqlsc, rneb)
+
+
+!     to use  'getin'
+      use ioipsl_getincom 
+      use watercommon_h, only : RLVTT, RCPD, RVTMP2,  &
+          T_h2O_ice_clouds,T_h2O_ice_liq,Psat_waterDP,Lcpdqsat_waterDP
+      USE tracer_h
+      IMPLICIT none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates large-scale (stratiform) H2O condensation.
+!     
+!     Authors
+!     -------
+!     Adapted from the LMDTERRE code by R. Wordsworth (2009)
+!     Original author Z. X. Li (1993)
+!     
+!==================================================================
+
+#include "dimensions.h" 
+#include "dimphys.h"
+#include "comcstfi.h"
+
+#include "callkeys.h"
+
+      INTEGER ngrid,nq
+
+!     Arguments
+      REAL ptimestep                 ! intervalle du temps (s)
+      REAL pplev(ngrid,nlayermx+1) ! pression a inter-couche
+      REAL pplay(ngrid,nlayermx)   ! pression au milieu de couche
+      REAL pt(ngrid,nlayermx)      ! temperature (K)
+      REAL pq(ngrid,nlayermx,nq) ! tracer mixing ratio (kg/kg)
+      REAL pdt(ngrid,nlayermx)     ! physical temperature tenedency (K/s)
+      REAL pdq(ngrid,nlayermx,nq)! physical tracer tenedency (K/s)
+      REAL pdtlsc(ngrid,nlayermx)  ! incrementation de la temperature (K)
+      REAL pdqvaplsc(ngrid,nlayermx) ! incrementation de la vapeur d'eau
+      REAL pdqliqlsc(ngrid,nlayermx) ! incrementation de l'eau liquide
+      REAL rneb(ngrid,nlayermx)    ! fraction nuageuse
+
+
+!     Options du programme
+      REAL, SAVE :: ratqs   ! determine largeur de la distribution de vapeur
+
+!     Variables locales
+      REAL CBRT
+      EXTERNAL CBRT
+      INTEGER i, k , nn
+      INTEGER,PARAMETER :: nitermax=5000
+      DOUBLE PRECISION,PARAMETER :: alpha=.1,qthreshold=1.d-8
+      ! JL13: if "careful, T<Tmin in psat water" appears often, you may want to stabilise the model by
+      !                   decreasing alpha and increasing nitermax accordingly
+      DOUBLE PRECISION zt(ngrid), zq(ngrid)
+      DOUBLE PRECISION zcond(ngrid),zcond_iter
+      DOUBLE PRECISION zdelq(ngrid)
+      DOUBLE PRECISION zqs(ngrid), zdqs(ngrid)
+      DOUBLE PRECISION local_p,psat_tmp,dlnpsat_tmp,Lcp
+      
+! evaporation calculations
+      REAL dqevap(ngrid,nlayermx),dtevap(ngrid,nlayermx)     
+      REAL qevap(ngrid,nlayermx,nq)
+      REAL tevap(ngrid,nlayermx)
+
+      DOUBLE PRECISION zx_q(ngrid)
+      LOGICAL,SAVE :: firstcall=.true.
+
+
+      IF (firstcall) THEN
+
+	 write(*,*) "value for ratqs? "
+         ratqs=0.2 ! default value
+         call getin("ratqs",ratqs)
+         write(*,*) " ratqs = ",ratqs
+
+         firstcall = .false.
+      ENDIF
+
+!     GCM -----> subroutine variables, initialisation of outputs
+
+      pdtlsc(1:ngrid,1:nlayermx)  = 0.0
+      pdqvaplsc(1:ngrid,1:nlayermx)  = 0.0
+      pdqliqlsc(1:ngrid,1:nlayermx) = 0.0
+      rneb(1:ngrid,1:nlayermx) = 0.0
+      Lcp=RLVTT/RCPD
+
+
+      ! Evaporate cloud water/ice
+      call evap(ngrid,nq,ptimestep,pt,pq,pdq,pdt,dqevap,dtevap,qevap,tevap)
+      ! note: we use qevap but not tevap in largescale/moistadj
+            ! otherwise is a big mess
+
+
+!  Boucle verticale (du haut vers le bas)
+   DO k = nlayermx, 1, -1
+
+      zt(1:ngrid)=pt(1:ngrid,k)+(pdt(1:ngrid,k)+dtevap(1:ngrid,k))*ptimestep
+      zq(1:ngrid)=qevap(1:ngrid,k,igcm_h2o_vap) !liquid water is included in qevap
+
+!     Calculer la vapeur d'eau saturante et 
+!     determiner la condensation partielle
+      DO i = 1, ngrid
+
+         local_p=pplay(i,k)
+         if(zt(i).le.15.) then
+	    print*,'in lsc',i,k,zt(i)
+!	    zt(i)=15.   ! check too low temperatures
+         endif
+         call Psat_waterDP(zt(i),local_p,psat_tmp,zqs(i))
+ 
+         zdelq(i) = MAX(MIN(ratqs * zq(i),1.-zq(i)),1.d-12)
+	 rneb(i,k) = (zq(i)+zdelq(i)-zqs(i)) / (2.0*zdelq(i))
+	 if (rneb(i,k).lt.0.) then  !no clouds
+
+	    rneb(i,k)=0.
+	    zcond(i)=0.
+
+	 else if ((rneb(i,k).gt.0.99).or.(ratqs.lt.1.e-6)) then    !complete cloud cover, we start without evaporating
+	    rneb(i,k)=1.
+            zt(i)=pt(i,k)+pdt(i,k)*ptimestep
+	    zx_q(i) = pq(i,k,igcm_h2o_vap)+pdq(i,k,igcm_h2o_vap)*ptimestep
+	    dqevap(i,k)=0.
+!           iterative process to stabilize the scheme when large water amounts JL12
+            zcond(i) = 0.0d0
+            Do nn=1,nitermax  
+               call Psat_waterDP(zt(i),local_p,psat_tmp,zqs(i))
+	       call Lcpdqsat_waterDP(zt(i),local_p,psat_tmp,zqs(i),zdqs(i),dlnpsat_tmp)
+               zcond_iter = alpha*(zx_q(i)-zqs(i))/(1.d0+zdqs(i))	   
+                  !zcond can be negative here
+               zx_q(i) = zx_q(i) - zcond_iter
+	       zcond(i) = zcond(i) + zcond_iter
+	       zt(i) = zt(i) + zcond_iter*Lcp
+	       if (ABS(zcond_iter/alpha/zqs(i)).lt.qthreshold) exit
+!	       if (ABS(zcond_iter/alpha).lt.qthreshold) exit
+	       if (nn.eq.nitermax) print*,'itermax in largescale'
+	    End do ! niter
+	    zcond(i)=MAX(zcond(i),-(pq(i,k,igcm_h2o_ice)+pdq(i,k,igcm_h2o_ice)*ptimestep))
+
+	 else   !standard case	    
+
+	    zx_q(i) = (zq(i)+zdelq(i)+zqs(i))/2.0d0 !water vapor in cloudy sky
+!           iterative process to stabilize the scheme when large water amounts JL12
+            zcond(i) = 0.0d0
+            Do nn=1,nitermax  
+	       call Lcpdqsat_waterDP(zt(i),local_p,psat_tmp,zqs(i),zdqs(i),dlnpsat_tmp)
+               zcond_iter = MAX(0.0d0,alpha*(zx_q(i)-zqs(i))/(1.d0+zdqs(i)))	   
+                  !zcond always postive! cannot evaporate clouds!
+                  !this is why we must reevaporate before largescale
+               zx_q(i) = zx_q(i) - zcond_iter
+	       zcond(i) = zcond(i) + zcond_iter
+	       if (ABS(zcond_iter/alpha/zqs(i)).lt.qthreshold) exit
+!	       if (ABS(zcond_iter/alpha).lt.qthreshold) exit
+	       zt(i) = zt(i) + zcond_iter*Lcp*rneb(i,k)
+               call Psat_waterDP(zt(i),local_p,psat_tmp,zqs(i))
+	       if (nn.eq.nitermax) print*,'itermax in largescale'
+	    End do ! niter
+
+	 Endif
+
+         zcond(i) = zcond(i)*rneb(i,k)/ptimestep ! JL12
+
+      ENDDO
+
+!     Tendances de t et q
+         pdqvaplsc(1:ngrid,k)  = dqevap(1:ngrid,k) - zcond(1:ngrid)
+         pdqliqlsc(1:ngrid,k) = - pdqvaplsc(1:ngrid,k)
+         pdtlsc(1:ngrid,k)  = pdqliqlsc(1:ngrid,k)*real(Lcp)
+
+   Enddo ! k= nlayermx, 1, -1
+ 
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/lect_start_archive.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/lect_start_archive.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/lect_start_archive.F	(revision 222)
@@ -0,0 +1,1492 @@
+      SUBROUTINE lect_start_archive(date,tsurf,tsoil,emis,q2,
+     &     t,ucov,vcov,ps,h,phisold_newgrid,
+     &     q,qsurf,surfith,nid,
+     &     rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+!      USE surfdat_h
+      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat
+      USE tracer_h, ONLY: igcm_co2_ice
+      USE infotrac, ONLY: tname, nqtot
+      USE slab_ice_h, ONLY: noceanmx
+!      USE control_mod
+! to use  'getin'
+
+c=======================================================================
+c
+c
+c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
+c   ------
+c
+c
+c   Objet:     Lecture des variables d'un fichier "start_archive"
+c              Plus besoin de régler ancienne valeurs grace
+c              a l'allocation dynamique de memoire (Yann Wanherdrick)
+c
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+!#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+!#include "logic.h"
+#include "ener.h"
+#include "temps.h"
+#include "netcdf.inc"
+!#include"advtrac.h"
+#include "callkeys.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Old variables dimensions (from file)
+c------------------------------------
+      INTEGER   imold,jmold,lmold,nsoilold,nqold
+
+
+c Variables pour les lectures des fichiers "ini" 
+c--------------------------------------------------
+!      INTEGER sizei,
+      integer timelen,dimid
+!      INTEGER length
+!      parameter (length = 100)
+      INTEGER tab0
+      INTEGER isoil,iq,iqmax
+      CHARACTER*2   str2
+
+!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
+
+!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
+
+!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
+!      CHARACTER*120 dimsource
+!      CHARACTER*16 dimname
+!      CHARACTER*80 dimtitle
+!      CHARACTER*40 dimunits
+!      INTEGER   dimtype
+
+!      INTEGER dimord(4)  ! tableau contenant l''ordre
+!      data dimord /1,2,3,4/ ! de sortie des dimensions
+
+!      INTEGER vardim(4)
+      REAL date
+      INTEGER   memo
+!      character (len=50) :: tmpname
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL h(iip1,jjp1,llm),ps(iip1,jjp1)
+      REAL q(iip1,jjp1,llm,nqtot),qtot(iip1,jjp1,llm)
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+
+c!-*-
+!      integer klatdat,klongdat
+!      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+
+c variable physique
+c------------------
+      REAL tsurf(ngridmx) ! surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
+      REAL co2ice(ngridmx) ! CO2 ice layer
+      REAL emis(ngridmx)
+      REAL q2(ngridmx,nlayermx+1),qsurf(ngridmx,nqtot)
+      REAL tslab(ngridmx,noceanmx)
+      REAL rnat(ngridmx),pctsrf_sic(ngridmx)
+      REAL tsea_ice(ngridmx),sea_ice(ngridmx)
+c     REAL phisfi(ngridmx)
+
+      INTEGER i,j,l
+      INTEGER nid,nvarid
+c     REAL year_day,periheli,aphelie,peri_day
+c     REAL obliquit,z0,emin_turb,lmixmin
+c     REAL emissiv,emisice(2),albedice(2)
+c     REAL iceradius(2) , dtemisice(2)
+
+      integer ierr
+      integer, dimension(4) :: start,count
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
+      REAL phisold_newgrid(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
+      real inertiedatS(iip1,jjp1,nsoilmx)
+      real co2iceS(iip1,jjp1)
+      real emisS(iip1,jjp1)
+      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
+      real tslabS(iip1,jjp1,noceanmx)
+      real pctsrf_sicS(iip1,jjp1),tsea_iceS(iip1,jjp1)
+      real rnatS(iip1,jjp1), sea_iceS(iip1,jjp1)
+
+      real ptotal, co2icetotal
+
+c Var intermediaires : vent naturel, mais pas coord scalaire
+c-----------------------------------------------------------
+      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+
+
+c Variable de l'ancienne grille 
+c---------------------------------------------------------
+
+      real, dimension(:), allocatable :: timelist
+      real, dimension(:), allocatable :: rlonuold, rlatvold
+      real, dimension(:), allocatable :: rlonvold, rlatuold
+      real, dimension(:), allocatable :: apsold,bpsold
+      real, dimension(:), allocatable :: mlayerold
+      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
+      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
+      real, dimension(:,:,:),allocatable :: tsoiloldnew
+! tsoiloldnew: old soil values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatold
+! inertiedatoldnew: old inertia values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatoldnew
+      real, dimension(:,:), allocatable :: psold,phisold
+      real, dimension(:,:), allocatable :: co2iceold
+      real, dimension(:,:), allocatable :: tsurfold
+      real, dimension(:,:), allocatable :: emisold
+      real, dimension(:,:,:,:), allocatable :: qold
+      real, dimension(:,:,:), allocatable :: tslabold
+      real, dimension(:,:), allocatable :: rnatold,pctsrf_sicold
+      real, dimension(:,:), allocatable :: tsea_iceold,sea_iceold
+
+
+      real tab_cntrl(100)
+
+      real ptotalold, co2icetotalold
+
+      logical :: olddepthdef=.false. ! flag
+! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
+      logical :: depthinterpol=.false. ! flag
+! depthinterpol=.true. if interpolation will be requiered
+      logical :: therminertia_3D=.true. ! flag
+! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
+c Variable intermediaires iutilise pour l'extrapolation verticale 
+c----------------------------------------------------------------
+      real, dimension(:,:,:), allocatable :: var,varp1 
+      real, dimension(:), allocatable :: oldgrid, oldval
+      real, dimension(:), allocatable :: newval
+
+      real surfith(iip1,jjp1) ! surface thermal inertia
+      ! surface thermal inertia at old horizontal grid resolution
+      real, dimension(:,:), allocatable :: surfithold 
+
+      character(len=30) :: txt ! to store some text
+
+c=======================================================================
+
+! 0. Preliminary stuff
+
+
+
+!-----------------------------------------------------------------------
+! 1. Read data dimensions (i.e. size and length)
+!-----------------------------------------------------------------------
+
+! 1.2 Read the various dimension lengths of data in file 
+
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"temps",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+
+      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
+      jmold=jmold-1
+
+      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
+      imold=imold-1
+
+      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
+
+      nqold=0
+      do
+         write(str2,'(i2.2)') nqold+1
+         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
+!        write(*,*) 'q'//str2
+         if (ierr.eq.NF_NOERR) then
+            nqold=nqold+1
+         else
+            exit
+         endif
+      enddo
+
+! 1.2.1 find out the # of subsurface_layers
+      nsoilold=0 !dummy initialisation
+      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+      if (ierr.eq.NF_NOERR) then
+        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'lec_start_archive: ',
+     &              'Failed reading subsurface_layers length'
+	endif
+      else
+        write(*,*)"lec_start_archive: did not find subsurface_layers"
+      endif
+
+      if (nsoilold.eq.0) then ! 'old' archive format;
+      ! must use Tg//str2 fields to compute nsoilold
+      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
+        do
+	 write(str2,'(i2.2)') nsoilold+1
+	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
+	 if (ierr.eq.NF_NOERR) then
+	  nsoilold=nsoilold+1
+	 else
+	  exit
+	 endif
+	enddo
+      endif
+
+
+      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
+        depthinterpol=.true.
+      endif
+
+! 1.3 Report dimensions
+      
+      write(*,*) "Start_archive dimensions:"
+      write(*,*) "longitude: ",imold
+      write(*,*) "latitude: ",jmold
+      write(*,*) "altitude: ",lmold
+      write(*,*) "tracers: ",nqold
+      write(*,*) "subsurface_layers: ",nsoilold
+      if (depthinterpol) then
+      write(*,*) " => Warning, nsoilmx= ",nsoilmx
+      write(*,*) '    which implies that you want subterranean interpola
+     &tion.'
+      write(*,*) '  Otherwise, set nsoilmx -in dimphys.h- to: ',nsoilold
+      endif
+      write(*,*) "time lenght: ",timelen
+      write(*,*) 
+
+!-----------------------------------------------------------------------
+! 2. Allocate arrays to store datasets
+!-----------------------------------------------------------------------
+
+      allocate(timelist(timelen))
+      allocate(rlonuold(imold+1), rlatvold(jmold))
+      allocate(rlonvold(imold+1), rlatuold(jmold+1))
+      allocate (apsold(lmold),bpsold(lmold))
+      allocate(uold(imold+1,jmold+1,lmold))
+      allocate(vold(imold+1,jmold+1,lmold))
+      allocate(told(imold+1,jmold+1,lmold))
+      allocate(psold(imold+1,jmold+1))
+      allocate(phisold(imold+1,jmold+1))
+      allocate(qold(imold+1,jmold+1,lmold,nqtot))
+      allocate(co2iceold(imold+1,jmold+1))
+      allocate(tsurfold(imold+1,jmold+1))
+      allocate(emisold(imold+1,jmold+1))
+      allocate(q2old(imold+1,jmold+1,lmold+1))
+!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
+      allocate(tsoilold(imold+1,jmold+1,nsoilold))
+      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
+      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
+      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
+      ! surface thermal inertia at old horizontal grid resolution
+      allocate(surfithold(imold+1,jmold+1))
+      allocate(mlayerold(nsoilold))
+      allocate(qsurfold(imold+1,jmold+1,nqtot))
+      allocate(tslabold(imold+1,jmold+1,noceanmx))
+      allocate(rnatold(imold+1,jmold+1))
+      allocate(pctsrf_sicold(imold+1,jmold+1))
+      allocate(tsea_iceold(imold+1,jmold+1))
+      allocate(sea_iceold(imold+1,jmold+1))
+
+      allocate(var (imold+1,jmold+1,llm))
+      allocate(varp1 (imold+1,jmold+1,llm+1))
+
+      write(*,*) 'q2',ngridmx,nlayermx+1
+      write(*,*) 'q2S',iip1,jjp1,llm+1
+      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
+
+!-----------------------------------------------------------------------
+! 3. Read time-independent data
+!-----------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+c 3.1. Lecture du tableau des parametres du run 
+c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Lect_start_archive: champ <controle> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echoue pour <controle>"
+         CALL abort
+      ENDIF
+c
+      tab0 = 50
+
+c-----------------------------------------------------------------------
+c 3.2 Lecture des longitudes et latitudes
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatu> est absent"
+         CALL abort
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rlatv>"
+         CALL abort
+      ENDIF
+c
+
+c-----------------------------------------------------------------------
+c 3.3. Lecture des niveaux verticaux
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <aps> est absent"
+         apsold=0
+         PRINT*, "<aps> set to 0"
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Lecture echouee pour <aps>"
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <bps> est absent"
+         PRINT*, "It must be an old start_archive, lets look for sig_s"
+         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "Nothing to do..."
+            CALL abort
+         ENDIF
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <bps>"
+         CALL abort
+      END IF
+
+c-----------------------------------------------------------------------
+c 3.4 Read Soil layers depths
+c-----------------------------------------------------------------------
+     
+      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <soildepth>'
+       write(*,*)' => Assuming this is an archive in old format'
+       olddepthdef=.true.
+       depthinterpol=.true.
+       ! this is how soil depth was defined in ye old days
+	do isoil=1,nsoilold
+	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
+	enddo
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+
+      endif !of if(ierr.ne.NF_NOERR)
+
+      ! Read (or build) mlayer()
+      if (depthinterpol) then
+       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
+       ! as in soil_settings.F
+       write(*,*)' => Building default soil depths'
+       do isoil=0,nsoilmx-1
+         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
+       enddo
+       write(*,*)' => mlayer: ',mlayer
+       ! Also build (default) new soil interlayer depth layer(:)
+       do isoil=1,nsoilmx
+         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
+     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
+       enddo
+       write(*,*)' =>  layer: ',layer
+      else ! read mlayer() from file
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+      endif ! of if (depthinterpol)
+
+c-----------------------------------------------------------------------
+c 3.5 Read Soil thermal inertia
+c-----------------------------------------------------------------------
+
+      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <inertiedat>'
+       write(*,*)' => Assuming this is an archive in old format'
+       therminertia_3D=.false.
+       write(*,*)' => Thermal inertia will be read from reference file'
+       volcapa=1.e6
+       write(*,*)'    and soil volumetric heat capacity is set to ',
+     &           volcapa
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
+         CALL abort
+       endif
+      endif
+
+c-----------------------------------------------------------------------
+c 3.6 Lecture geopotentiel au sol
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <phisinit> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+C-----------------------------------------------------------------------
+c   lecture de "ptotalold" et "co2icetotalold"
+c-----------------------------------------------------------------------
+      ptotalold = tab_cntrl(tab0+49)
+      co2icetotalold = tab_cntrl(tab0+50)
+ 
+c-----------------------------------------------------------------------
+c 4. Lecture du temps et choix
+c-----------------------------------------------------------------------
+ 
+c  lecture du temps
+c
+      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Le champ <Time> est absent"
+            CALL abort
+         endif
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_VARID (nid, "temps", nvarid)
+      endif 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <Time>"
+         CALL abort
+      ENDIF
+c
+      write(*,*)
+      write(*,*)
+      write(*,*) 'Differentes dates des etats initiaux stockes:'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      pi=2.*ASIN(1.)
+      do i=1,timelen
+c       call solarlong(timelist(i),sollong(i))
+c       sollong(i) = sollong(i)*180./pi
+        write(*,*) 'etat initial au jour martien' ,int(timelist(i))
+c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
+c    .    sollong(i)
+      end do
+
+   6  FORMAT(i7,i7,f9.3)
+ 
+      write(*,*)
+      write(*,*) 'Choix de la date'
+ 123  read(*,*,iostat=ierr) date
+      if(ierr.ne.0) goto 123
+      memo = 0
+      do i=1,timelen
+        if (date.eq.int(timelist(i))) then
+            memo = i
+        endif
+      end do
+ 
+      if (memo.eq.0) then
+        write(*,*)
+        write(*,*)
+        write(*,*) 'He alors... Y sait pas lire !?!'
+        write(*,*)
+        write(*,*) 'Differentes dates des etats initiaux stockes:'
+        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+        do i=1,timelen
+          write(*,*) 'etat initial au jour martien' ,nint(timelist(i))
+c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
+        end do
+        goto 123
+      endif
+
+!-----------------------------------------------------------------------
+! 5. Read (time-dependent) data from datafile
+!-----------------------------------------------------------------------
+
+
+c-----------------------------------------------------------------------
+c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], qsurf)
+c-----------------------------------------------------------------------
+ 
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+       
+! CO2ice is now in qsurf(igcm_co2_ice) ...
+!      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+!      IF (ierr .NE. NF_NOERR) THEN
+!         PRINT*, "lect_start_archive: Le champ <co2ice> est absent"
+!         CALL abort
+!      ENDIF
+!#ifdef NC_DOUBLE
+!      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
+!#else
+!      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
+!#endif
+!      IF (ierr .NE. NF_NOERR) THEN
+!         PRINT*, "lect_start_archive: Lecture echouee pour <co2ice>"
+!         PRINT*, NF_STRERROR(ierr)
+!         CALL abort
+!      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <emis> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <emis>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <ps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,psold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,psold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <ps>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <tsurf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsurfold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2surf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2surf>"
+         CALL abort
+      ENDIF
+c
+cc Slab ocean
+      if(ok_slab_ocean) then
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,noceanmx,1/)
+
+       ierr=NF_INQ_VARID(nid,"tslab",nvarid)
+       IF (ierr.ne.NF_NOERR) then
+          PRINT*,"lect_start_archive: Cannot find <tslab>"
+       ENDIF
+#ifdef NC_DOUBLE
+      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tslabold)
+#else
+      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tslabold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tslab>"
+      ENDIF
+
+
+c
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+
+      ierr = NF_INQ_VARID (nid, "rnat", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rnat> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,rnatold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,rnatold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rnat>"
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "pctsrf_sic", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <pctsrf_sic> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,pctsrf_sicold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,pctsrf_sicold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <pctsrf_sic>"
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsea_ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <tsea_ice> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsea_iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsea_iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tsea_ice>"
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "sea_ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <sea_ice> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,sea_iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,sea_iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <sea_ice>"
+      ENDIF
+  
+      ENDIF! ok_slab_ocean
+c
+      write(*,*)"lect_start_archive: rlonuold:"
+     &           ,rlonuold," rlatvold:",rlatvold
+      write(*,*)
+
+! Surface tracers:      
+      do iq=1,nqtot
+        ! initialize all surface tracers to zero
+        call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+      enddo
+
+
+!      print*,'tname=',tname
+!      print*,'nid',nid
+!      print*,'nvarid',nvarid
+!      stop
+
+      DO iq=1,nqtot
+          txt=trim(tname(iq))//"_surf"
+          if (txt.eq."h2o_vap") then
+            ! There is no surface tracer for h2o_vap;
+            ! "h2o_ice" should be loaded instead
+            txt="h2o_ice_surf"
+            write(*,*) 'lect_start_archive: loading surface tracer',
+     &                     ' h2o_ice instead of h2o_vap'
+          endif
+
+        
+        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+
+!          print*,'RDW has added hack to let me continue...'
+!          CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#else
+        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &             " Failed loading <",trim(txt),">"
+          write (*,*) trim(txt),'    is set to 0'
+!          call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+
+!-----------------------------------------------------------------------
+! 5.2 Read 3D subterranean fields
+!-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+!
+! Read soil temperatures
+!
+      if (olddepthdef) then ! tsoil stored using the 'old format'
+         start=(/1,1,memo,0/)
+         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
+       do isoil=1,nsoilold
+         write(str2,'(i2.2)') isoil
+c
+         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              "Field <","Tg"//str2,"> not found"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &            "Failed reading <","Tg"//str2,">"
+            CALL abort
+         ENDIF
+c
+       enddo ! of do isoil=1,nsoilold
+      
+      ! reset 'start' and 'count' to "3D" behaviour
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+      
+      else
+       write(*,*) "lect_start_archive: loading tsoil "
+       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+       if (ierr.ne.NF_NOERR) then
+        write(*,*)"lect_start_archive: Cannot find <tsoil>"
+	call abort
+       else
+#ifdef NC_DOUBLE
+      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
+#else
+      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
+#endif
+       endif ! of if (ierr.ne.NF_NOERR)
+       
+      endif ! of if (olddepthdef)
+
+!
+! Read soil thermal inertias
+!
+!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
+!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+!       if (ierr.ne.NF_NOERR) then
+!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
+!	call abort
+!       else
+!#ifdef NC_DOUBLE
+!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
+!#else
+!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
+!#endif
+!       endif ! of if (ierr.ne.NF_NOERR)
+!      endif
+
+c-----------------------------------------------------------------------
+c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,lmold,1/)
+
+c
+      ierr = NF_INQ_VARID (nid,"temp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <temp> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, count, told)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, told)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <temp>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"u", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <u> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,uold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,uold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <u>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"v", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <v> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,vold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <v>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2atm> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2atm>"
+         CALL abort
+      ENDIF
+c
+
+! Tracers:      
+      do iq=1,nqtot
+         call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) )
+      enddo
+
+      DO iq=1,nqtot
+        txt=tname(iq)
+        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+!            CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
+#else
+        ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &             "  Failed loading <",trim(txt),">"
+          write (*,*) trim(txt),'      set to 1.E-30'
+          do l=1,lmold
+            do j=1,jmold+1
+              do i=1,imold+1
+                 qold(i,j,l,iq)=1.e-30
+              end do
+            end do
+          end do
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+
+!=======================================================================
+! 6. Interpolation from old grid to new grid
+!=======================================================================
+
+c=======================================================================
+c   INTERPOLATION DANS LA NOUVELLE GRILLE et initialisation des variables
+c=======================================================================
+c  Interpolation horizontale puis passage dans la grille physique pour 
+c  les variables physique 
+c  Interpolation verticale puis horizontale pour chaque variable 3D
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c 6.1	Variable 2d :
+c-----------------------------------------------------------------------
+c Relief 
+      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+! CO2 ice is now in qsurf(igcm_co2_ice)
+!      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
+!     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Temperature de surface
+      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,tsurfs,tsurf)
+c     write(44,*) 'tsurf', tsurf
+
+c Temperature du sous-sol
+!      call interp_horiz(tsoilold,tsoils,
+!     &                  imold,jmold,iim,jjm,nsoilmx,
+!     &                   rlonuold,rlatvold,rlonu,rlatv)
+!      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,tsoils,tsoil)
+c     write(45,*) 'tsoil',tsoil
+
+c Emissivite de la surface
+      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,emiss,emis)
+c     write(46,*) 'emis',emis
+
+
+
+c-----------------------------------------------------------------------
+c 6.1.2	Traitement special de la pression au sol :
+c-----------------------------------------------------------------------
+
+c  Extrapolation la pression dans la nouvelle grille
+      call interp_horiz(psold,ps,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c-----------------------------------------------------------------------
+c	On assure la conservation de la masse de l'atmosphere + calottes
+c-----------------------------------------------------------------------
+
+      ptotal =  0.
+      DO j=1,jjp1
+         DO i=1,iim
+            ptotal=ptotal+ps(i,j)*aire(i,j)/g
+         END DO
+      END DO
+      co2icetotal = 0.
+      if (igcm_co2_ice.ne.0) then
+        ! recast surface CO2 ice on new grid
+        call interp_horiz(qsurfold(1,1,igcm_co2_ice),
+     &                  qsurfs(1,1,igcm_co2_ice),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+       DO j=1,jjp1
+         DO i=1,iim
+           !co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
+           co2icetotal=co2icetotal+qsurfS(i,j,igcm_co2_ice)*aire(i,j)
+         END DO
+       END DO
+      else
+        write(*,*) "Warning: No co2_ice surface tracer"
+      endif
+
+      write(*,*)
+      write(*,*)'Ancienne grille: masse de l atm :',ptotalold
+      write(*,*)'Nouvelle grille: masse de l atm :',ptotal
+      write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold 
+      write(*,*)
+      write(*,*)'Ancienne grille: masse de la glace CO2:',co2icetotalold
+      write(*,*)'Nouvelle grille: masse de la glace CO2:',co2icetotal
+      if (co2icetotalold.ne.0.) then
+      write(*,*)'Ratio new ice./old ice =',co2icetotal/co2icetotalold
+      endif
+      write(*,*)
+
+
+      DO j=1,jjp1
+         DO i=1,iip1
+            ps(i,j)=ps(i,j) * ptotalold/ptotal
+         END DO
+      END DO
+
+      if ( co2icetotalold.gt.0.) then 
+!         DO j=1,jjp1
+!            DO i=1,iip1
+!               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
+!            END DO
+!         END DO
+        write(*,*) "Not enforcing conservation of surface CO2 ice"
+        write(*,*) " (should be OK when CO2 ice is a tracer)"
+      end if
+
+c-----------------------------------------------------------------------
+c 6.2 Subterranean 3d variables:
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c 6.2.1 Thermal Inertia
+c       Note: recall that inertiedat is a common in "comsoil.h"
+c-----------------------------------------------------------------------
+
+      ! depth-wise interpolation, if required
+      if (depthinterpol.and.(.not.olddepthdef)) then
+        allocate(oldval(nsoilold))
+	allocate(newval(nsoilmx))
+        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
+     &f soil thermal inertia; might be wiser to reset it.'
+        write(*,*)
+       
+        do i=1,imold+1
+         do j=1,jmold+1
+	   !copy old values
+	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
+	   !interpolate
+	   call interp_line(mlayerold,oldval,nsoilold,
+     &                     mlayer,newval,nsoilmx)
+           !copy interpolated values
+           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+        enddo
+        ! cleanup
+	deallocate(oldval)
+	deallocate(newval)
+      endif !of if (depthinterpol)
+
+      if (therminertia_3D) then
+        ! We have inertiedatold
+       if((imold.ne.iim).or.(jmold.ne.jjm)) then
+       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
+     &of thermal inertia; might be better to reset it.'
+       write(*,*)
+       endif
+       
+        ! Do horizontal interpolation
+	if (depthinterpol) then
+	  call interp_horiz(inertiedatoldnew,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+	else
+          call interp_horiz(inertiedatold,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilold,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+        endif ! of if (depthinterpol)
+
+      else ! no 3D thermal inertia data
+       write(*,*)'lect_start_archive: using reference surface inertia'
+        ! Use surface inertia (and extend it to all depths)
+        do i=1,nsoilmx
+         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
+        enddo
+	! Build an old resolution surface thermal inertia
+	! (will be needed for tsoil interpolation)
+	call interp_horiz(surfith,surfithold,
+     &                    iim,jjm,imold,jmold,1,
+     &                    rlonu,rlatv,rlonuold,rlatvold)
+      endif
+
+
+      ! Reshape inertiedatS to scalar grid as inertiedat
+      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,
+     &                  inertiedatS,inertiedat)
+      
+c-----------------------------------------------------------------------
+c 6.2.2 Soil temperature
+c-----------------------------------------------------------------------
+!      write(*,*) 'Soil'
+
+      !print*,'Problem in lect_start_archive interpolating'
+      !print*,'to new resolution!!'
+
+      ! Recast temperatures along soil depth, if necessary
+      if (olddepthdef) then
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        do i=1,imold+1
+	 do j=1,jmold+1
+
+            !if(i.gt.iip1 .or. j.gt.jjp1)then
+               !print*,'Problem in lect_start_archive interpolating'
+               !print*,'to new resolution!!'
+               !call abort
+            !endif
+
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+!	   oldval(1)=tsurfS(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	   ! build vertical coordinate
+	   oldgrid(1)=0. ! ground
+	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
+     &                (surfithold(i,j)/1.e6)
+          ! Note; at this stage, we impose volcapa=1.e6 above
+	  ! since volcapa isn't set in old soil definitions
+
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+
+      else
+       if (depthinterpol) then ! if vertical interpolation is required
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        ! build vertical coordinate
+	oldgrid(1)=0. ! ground
+	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+!	   oldval(1)=tsurfS(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+       
+       else
+        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
+       endif ! of if (depthinterpol)
+      endif ! of if (olddepthdef)
+
+      ! Do the horizontal interpolation
+       call interp_horiz(tsoiloldnew,tsoilS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+      ! Reshape tsoilS to scalar grid as tsoil
+       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngridmx,tsoilS,tsoil)
+
+c-----------------------------------------------------------------------
+c 6.3   Slab Ocean :
+c-----------------------------------------------------------------------
+      call interp_horiz (tslabold,tslabs,imold,jmold,iim,jjm,noceanmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,tslabs,tslab)
+
+      call interp_horiz (rnatold,rnats,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,rnats,rnat)
+
+      call interp_horiz (pctsrf_sicold,pctsrf_sics,imold,jmold,iim,
+     &                   jjm,1,rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,pctsrf_sics,pctsrf_sic)
+
+      call interp_horiz (tsea_iceold,tsea_ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,tsea_ices,tsea_ice)
+
+      call interp_horiz (sea_iceold,sea_ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,sea_ices,sea_ice)
+
+c-----------------------------------------------------------------------
+c 6.4 Variable 3d :
+c-----------------------------------------------------------------------
+      
+c temperatures atmospheriques
+      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
+      call interp_vert
+     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
+     &     psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
+      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
+
+c q2 : pbl wind variance
+      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
+      call interp_vert (q2old,varp1,lmold+1,llm+1,
+     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
+      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
+      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngridmx,q2s,q2)
+      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
+c     write(47,*) 'q2',q2
+
+c calcul des champ de vent; passage en vent covariant
+      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
+      call interp_vert
+     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
+     &  psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
+      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
+
+      call interp_vert
+     & (vold,var,lmold,llm,
+     &  apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      call interp_horiz(var,vs,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call scal_wind(us,vs,unat,vnat)
+      write (*,*) 'lect_start_archive: unat ', unat (1,2,1)    ! INFO
+      do l=1,llm
+        do j = 1, jjp1
+          do i=1,iip1
+            ucov( i,j,l ) = unat( i,j,l ) * cu(i,j)
+c           ucov( i,j,l ) = 0
+          end do
+        end do
+      end do 
+      write (*,*) 'lect_start_archive: ucov ', ucov (1,2,1)  ! INFO
+c     write(48,*) 'ucov',ucov
+      do l=1,llm
+        do j = 1, jjm
+          do i=1,iim
+            vcov( i,j,l ) = vnat( i,j,l ) * cv(i,j)
+c           vcov( i,j,l ) = 0
+          end do
+          vcov( iip1,j,l ) = vcov( 1,j,l )
+        end do
+      end do
+c     write(49,*) 'ucov',vcov
+
+      if (nqtot .gt. 0) then
+c traceurs surface
+      do iq = 1, nqtot
+            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+
+      call gr_dyn_fi (nqtot,iim+1,jjm+1,ngridmx,qsurfs,qsurf)
+
+c traceurs 3D
+      do  iq = 1, nqtot
+            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
+     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+c      iqmax=1
+c      
+c      if (nqold.gt.10) then
+c       do l=1,llm
+c        do j=1,jjp1
+c          do i=1,iip1
+c           do iq=1,nqold
+c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
+c              iqmax=iq
+c            endif
+c           enddo
+c           q(i,j,l,iqmax)=1.
+c           qtot(i,j,l)=0
+c           do iq=1,nqold
+c            if (iq.ne.iqmax) then        
+c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
+c            endif
+c           enddo !iq
+c           do iq=1,nqold
+c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
+c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
+c     $    qtot(i,j,l)
+c           enddo !iq
+c          enddo !i   
+c         enddo !j   
+c       enddo !l  
+c      endif
+ccccccccccccccccccccccccccccccc
+
+c     Periodicite :
+      do  iq = 1, nqtot
+         do l=1, llm
+            do j = 1, jjp1
+               q(iip1,j,l,iq) = q(1,j,l,iq)
+            end do
+         end do
+      enddo
+      
+!      call gr_dyn_fi (1,iim+1,jjm+1,ngridmx,co2ices,co2ice)
+! no need to transfer "co2ice" any more; it is in qsurf(igcm_co2_ice)
+
+      endif !! if nqtot .ne. 0
+
+c-----------------------------------------------------------------------
+c   Initialisation  h:	(passage de t -> h)
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO j=1,jjp1
+            DO i=1,iim
+               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
+            END DO
+            h(iip1,j,l) =  h(1,j,l)
+         END DO
+      END DO
+
+
+c***********************************************************************
+c***********************************************************************
+c     Fin subroutine lecture ini
+c***********************************************************************
+c***********************************************************************
+
+      deallocate(timelist)
+      deallocate(rlonuold, rlatvold)
+      deallocate(rlonvold, rlatuold)
+      deallocate(apsold,bpsold)
+      deallocate(uold)
+      deallocate(vold)
+      deallocate(told)
+      deallocate(psold)
+      deallocate(phisold)
+      deallocate(qold)
+      deallocate(co2iceold)
+      deallocate(tsurfold)
+      deallocate(emisold)
+      deallocate(q2old)
+      deallocate(tsoilold)
+      deallocate(tsoiloldnew)
+      deallocate(inertiedatold)
+      deallocate(inertiedatoldnew)
+      deallocate(surfithold)
+      deallocate(mlayerold)
+      deallocate(qsurfold)
+      deallocate(var,varp1)
+      deallocate(tslabold)
+      deallocate(rnatold)
+      deallocate(pctsrf_sicold)
+      deallocate(tsea_iceold)
+      deallocate(sea_iceold)
+
+!      write(*,*)'lect_start_archive: END'
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mass_redistribution.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mass_redistribution.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mass_redistribution.F90	(revision 222)
@@ -0,0 +1,405 @@
+      SUBROUTINE mass_redistribution(ngrid,nlayer,nq,ptimestep,   &
+                       rnat,pcapcal,pplay,pplev,pt,ptsrf,pq,pqs,     &
+		       pu,pv,pdt,pdtsrf,pdq,pdu,pdv,pdmassmr,  &
+		       pdtmr,pdtsrfmr,pdpsrfmr,pdumr,pdvmr,pdqmr,pdqsmr)
+                                                   
+       USE watercommon_h, Only: Tsat_water,RLVTT
+       use surfdat_h
+       use radcommon_h, only: glat
+       USE comgeomfi_h
+       USE tracer_h
+
+       IMPLICIT NONE
+!=======================================================================
+!   subject:
+!   --------
+!     Mass and momentum fluxes through sigma levels as the surface pressure is modified are also taken into account
+!
+!   author:   Jeremy Leconte 2012 (from F.Forget 1998)
+!   ------
+!
+!   input:
+!   ----- 
+!    ngrid                 nombre de points de verticales
+!                          (toutes les boucles de la physique sont au
+!                          moins vectorisees sur ngrid)
+!    nlayer                nombre de couches
+!    pplay(ngrid,nlayer)   Pressure levels 
+!    pplev(ngrid,nlayer+1) Pressure levels 
+!    nq                    Number of tracers
+!
+!    pt(ngrid,nlayer)      temperature (en K)
+!    pq(ngrid,nlayer,nq)   tracer specific concentration (kg/kg of air)
+!    pu,pv (ngrid,nlayer)  wind velocity (m/s)
+!
+!                    
+!    pdX                   physical tendency of X before mass redistribution
+!
+!    pdmassmr                air Mass added to the atmosphere in each layer (kg/m2/s)
+!
+!   output:
+!   -------
+!
+!    pdXmr(ngrid)           physical tendency of X after mass redistribution
+!
+!    
+!
+!=======================================================================
+!
+!    0.  Declarations :
+!    ------------------
+!
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "paramet.h"
+#include "callkeys.h"
+
+!-----------------------------------------------------------------------
+!    Arguments :
+!    ---------
+      INTEGER ngrid, nlayer, nq   
+      REAL ptimestep
+      REAL pcapcal(ngrid)
+      INTEGER rnat(ngrid)      
+      REAL pplay(ngrid,nlayer),pplev(ngrid,nlayer+1)
+      REAL pt(ngrid,nlayer),pdt(ngrid,nlayer)
+      REAL ptsrf(ngrid),pdtsrf(ngrid)
+      REAL pdtmr(ngrid,nlayer)
+      REAL pu(ngrid,nlayer) ,  pv(ngrid,nlayer)
+      REAL pdu(ngrid,nlayer) , pdv(ngrid,nlayer)
+      REAL pdmassmr(ngrid,nlayer)
+      REAL pdumr(ngrid,nlayer) , pdvmr(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq),pdq(ngrid,nlayer,nq)
+      REAL pqs(ngrid,nq)
+      REAL pdqmr(ngrid,nlayer,nq),pdqsmr(ngrid,nq)
+      REAL pdpsrfmr(ngrid),pdtsrfmr(ngrid)
+!
+!    Local variables :
+!    -----------------
+
+!    Boiling/sublimation
+      REAL Tsat(ngrid),zmassboil(ngrid)
+
+!    vertical reorganization of sigma levels
+      REAL zzu(nlayermx),zzv(nlayermx)
+      REAL zzq(nlayermx,nq),zzt(nlayermx)
+!    Dummy variables      
+      INTEGER n,l,ig,iq
+      REAL zdtsig(ngrid,nlayermx)
+      REAL zmass(ngrid,nlayermx),zzmass(nlayermx),w(nlayermx+1)
+      REAL zdmass_sum(ngrid,nlayermx+1)
+      REAL zmflux(nlayermx+1)
+      REAL zq1(nlayermx)
+      REAL ztsrf(ngrid)
+      REAL ztm(nlayermx+1) 
+      REAL zum(nlayermx+1) , zvm(nlayermx+1)
+      REAL zqm(nlayermx+1,nq),zqm1(nlayermx+1)
+
+!   local saved variables
+      LOGICAL, SAVE :: firstcall=.true.
+
+!----------------------------------------------------------------------
+
+!   Initialisation
+!   --------------
+!
+      IF (firstcall) THEN
+         firstcall=.false.	 
+      ENDIF
+!
+!======================================================================
+!    Calcul of h2o condensation  
+!    ============================================================
+!  
+!    Used variable :
+!       pdmassmr      : air Mass added to the atmosphere in each layer per unit time (kg/m2/s)
+!       zdmass_sum(ngrid,l) : total air mass added to the atm above layer l per unit time (kg/m2/s)
+!
+!
+!     Surface tracer Tendencies set to 0
+!     -------------------------------------
+      pdqsmr(1:ngrid,1:nq)=0.
+
+      ztsrf(1:ngrid) = ptsrf(1:ngrid) + pdtsrf(1:ngrid)*ptimestep
+
+
+      DO ig=1,ngrid
+         zdmass_sum(ig,nlayermx+1)=0.
+         DO l = nlayermx, 1, -1
+           zmass(ig,l) = (pplev(ig,l)-pplev(ig,l+1))/glat(ig)
+	   zdmass_sum(ig,l)= zdmass_sum(ig,l+1)+pdmassmr(ig,l)
+         END DO
+      END DO
+
+
+      if (water) then
+         do ig=1,ngrid
+	    call Tsat_water(pplev(ig,1)+zdmass_sum(ig,1)*g*ptimestep,Tsat(ig))
+	 enddo
+               call writediagfi(ngrid,'Tsat','saturation temperature at surface','',2,Tsat)
+	 
+         do ig=1,ngrid
+	    if (ztsrf(ig).gt.Tsat(ig)) then
+	       zmassboil(ig)=(ptsrf(ig)-Tsat(ig))*pcapcal(ig)/RLVTT/ptimestep
+	       if ((zmassboil(ig)*ptimestep.gt.pqs(ig,igcm_h2o_vap)).and.(rnat(ig).eq.1)) then
+	          zmassboil(ig)=pqs(ig,igcm_h2o_vap)/ptimestep
+	       endif
+	       zmassboil(ig)=zmassboil(ig)*0.0 !momentary, should be 1. JL12
+               pdqsmr(ig,igcm_h2o_vap)=-zmassboil(ig)
+	       pdtsrfmr(ig)=-zmassboil(ig)*RLVTT/pcapcal(ig)
+	       ztsrf(ig)=ptsrf(ig)+pdtsrfmr(ig)*ptimestep
+	    else
+	       zmassboil(ig)=0.
+	       pdtsrfmr(ig)=0.
+	    endif
+	 enddo
+      endif
+
+!     *************************
+!           UPDATE SURFACE
+!     *************************
+!    Changing pressure at the surface:
+!    """"""""""""""""""""""""""""""""""""
+         
+      pdpsrfmr(1:ngrid) = (zdmass_sum(1:ngrid,1)+zmassboil(1:ngrid))*g
+
+      do ig = 1, ngrid
+        IF(ABS(pdpsrfmr(ig)*ptimestep).GT.pplev(ig,1)) THEN
+         PRINT*,'STOP in condens'
+         PRINT*,'condensing more than total mass'
+         PRINT*,'Grid point ',ig
+         PRINT*,'Ps = ',pplev(ig,1)
+         PRINT*,'d Ps = ',pdpsrfmr(ig)*ptimestep
+         STOP
+        ENDIF
+      enddo ! of DO ig=1,ngrid
+
+
+! ***************************************************************
+!  Correction to account for redistribution between sigma or hybrid 
+!  layers when changing surface pressure
+!  zzx quantities have dimension (nlayermx) to speed up calculation
+! *************************************************************
+
+      DO ig=1,ngrid
+         zzt(1:nlayermx)  = pt(ig,1:nlayermx) + pdt(ig,1:nlayermx) * ptimestep
+         zzu(1:nlayermx)  = pu(ig,1:nlayermx) + pdu(ig,1:nlayermx) * ptimestep
+         zzv(1:nlayermx)  = pv(ig,1:nlayermx) + pdv(ig,1:nlayermx) * ptimestep
+         zzq(1:nlayermx,1:nq)=pq(ig,1:nlayermx,1:nq)+pdq(ig,1:nlayermx,1:nq)*ptimestep ! must add the water that has fallen???
+
+!  Mass fluxes of air through the sigma levels (kg.m-2.s-1)  (>0 when up)
+!  """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
+
+         zmflux(1) = zmassboil(ig)
+         DO l=1,nlayer
+            zmflux(l+1) = zmflux(l) + pdmassmr(ig,l) - (bp(l)-bp(l+1))*(zdmass_sum(ig,1)+zmflux(1))
+! zmflux set to 0 if very low to avoid: top layer is disappearing in v1ld  
+            if (abs(zmflux(l+1)).lt.1E-13.OR.bp(l+1).eq.0.) zmflux(l+1)=0.
+         END DO
+
+! Mass of each layer
+! ------------------ 
+         zzmass(1:nlayermx)=zmass(ig,1:nlayermx)*(1.+pdpsrfmr(ig)*ptimestep/pplev(ig,1))
+
+
+!  Corresponding fluxes for T,U,V,Q
+!  """"""""""""""""""""""""""""""""
+
+!        averaging operator for TRANSPORT  
+!        """"""""""""""""""""""""""""""""
+!        Value transfert at the surface interface when condensation
+!        sublimation:
+         ztm(1) = ztsrf(ig)
+         zum(1) = 0.  
+         zvm(1) = 0.  
+         zqm(1,1:nq)=0. ! most tracer do not condense !
+         if (water) zqm(1,igcm_h2o_vap)=1. ! flux is 100% h2o at surface
+	 
+!        Van Leer scheme:
+         w(1:nlayermx+1)=-zmflux(1:nlayermx+1)*ptimestep
+         call vl1d(zzt,2.,zzmass,w,ztm) 
+         call vl1d(zzu ,2.,zzmass,w,zum) 
+         call vl1d(zzv ,2.,zzmass,w,zvm) 
+         do iq=1,nq
+           zq1(1:nlayermx)=zzq(1:nlayermx,iq)
+           zqm1(1)=zqm(1,iq)
+!		print*,iq
+!		print*,zq1
+           call vl1d(zq1,2.,zzmass,w,zqm1)
+           do l=2,nlayer
+              zzq(l,iq)=zq1(l)
+              zqm(l,iq)=zqm1(l)
+           enddo
+         enddo
+
+!        Surface condensation affects low winds
+         if (zmflux(1).lt.0) then 
+            zum(1)= zzu(1) *  (w(1)/zzmass(1))
+            zvm(1)= zzv(1) *  (w(1)/zzmass(1))
+            if (w(1).gt.zzmass(1)) then ! ensure numerical stability
+               zum(1)= (zzu(1)-zum(2))*zzmass(1)/w(1) + zum(2)
+               zvm(1)= (zzv(1)-zvm(2))*zzmass(1)/w(1) + zvm(2)
+            end if
+         end if
+                    
+         ztm(nlayer+1)= zzt(nlayer) ! should not be used, but... 
+         zum(nlayer+1)= zzu(nlayer)  ! should not be used, but...
+         zvm(nlayer+1)= zzv(nlayer)  ! should not be used, but...
+         zqm(nlayer+1,1:nq)= zzq(nlayer,1:nq)
+ 
+!        Tendencies on T, U, V, Q 
+!        """"""""""""""""""""""""
+         DO l=1,nlayer
+ 
+!           Tendencies on T
+            pdtmr(ig,l) = (1/zzmass(l)) *   &
+		(zmflux(l)*(ztm(l) - zzt(l))-zmflux(l+1)*(ztm(l+1)-zzt(l)))
+		  !JL12 the last term in Newcondens has been set to zero because we are only dealing with redistribution here
+
+!           Tendencies on U
+            pdumr(ig,l)   = (1/zzmass(l)) *( zmflux(l)*(zum(l) - zzu(l)) - zmflux(l+1)*(zum(l+1) - zzu(l)) )
+
+!           Tendencies on V
+            pdvmr(ig,l)   = (1/zzmass(l)) *( zmflux(l)*(zvm(l) - zzv(l)) - zmflux(l+1)*(zvm(l+1) - zzv(l)) )
+
+         END DO
+
+!        Tendencies on Q
+         do iq=1,nq
+            DO l=1,nlayer
+               pdqmr(ig,l,iq)= (1/zzmass(l)) *   &
+		   (zmflux(l)*(zqm(l,iq)-zzq(l,iq))- zmflux(l+1)*(zqm(l+1,iq)-zzq(l,iq)) - pdmassmr(ig,l)*zzq(l,iq))
+            END DO
+         enddo
+
+      END DO  ! loop on ig 
+
+      return
+      end
+
+
+
+! *****************************************************************
+      SUBROUTINE vl1d(q,pente_max,zzmass,w,qm)
+!
+!    
+!     Operateur de moyenne inter-couche pour calcul de transport type
+!     Van-Leer " pseudo amont " dans la verticale
+!    q,w sont des arguments d'entree  pour le s-pg ....
+!    masse : masse de la couche Dp/g
+!    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
+!    pente_max = 2 conseillee
+!
+!
+!   --------------------------------------------------------------------
+      IMPLICIT NONE
+
+#include "dimensions.h"
+
+!   Arguments:
+!   ----------
+      real zzmass(llm),pente_max
+      REAL q(llm),qm(llm+1)
+      REAL w(llm+1)
+!
+!      Local 
+!   ---------
+!
+      INTEGER l
+!
+      real dzq(llm),dzqw(llm),adzqw(llm),dzqmax
+      real sigw, Mtot, MQtot
+      integer m 
+!     integer ismax,ismin 
+
+
+!    On oriente tout dans le sens de la pression 
+!     W > 0 WHEN DOWN !!!!!!!!!!!!!
+
+      do l=2,llm
+            dzqw(l)=q(l-1)-q(l)
+            adzqw(l)=abs(dzqw(l))
+      enddo
+
+      do l=2,llm-1
+            if(dzqw(l)*dzqw(l+1).gt.0.) then
+                dzq(l)=0.5*(dzqw(l)+dzqw(l+1))
+            else
+                dzq(l)=0.
+            endif
+            dzqmax=pente_max*min(adzqw(l),adzqw(l+1))
+            dzq(l)=sign(min(abs(dzq(l)),dzqmax),dzq(l))
+      enddo
+
+         dzq(1)=0.
+         dzq(llm)=0.
+
+       do l = 1,llm-1
+
+!         Regular scheme (transfered mass < layer mass)
+!         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(w(l+1).gt.0. .and. w(l+1).le.zzmass(l+1)) then
+             sigw=w(l+1)/zzmass(l+1)
+             qm(l+1)=(q(l+1)+0.5*(1.-sigw)*dzq(l+1))
+          else if(w(l+1).le.0. .and. -w(l+1).le.zzmass(l)) then
+             sigw=w(l+1)/zzmass(l)
+             qm(l+1)=(q(l)-0.5*(1.+sigw)*dzq(l))
+
+!         Extended scheme (transfered mass > layer mass)
+!         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else if(w(l+1).gt.0.) then
+             m=l+1
+             Mtot = zzmass(m)
+             MQtot = zzmass(m)*q(m)
+             do while ((m.lt.llm).and.(w(l+1).gt.(Mtot+zzmass(m+1))))
+                m=m+1
+                Mtot = Mtot + zzmass(m)
+                MQtot = MQtot + zzmass(m)*q(m)
+             end do
+             if (m.lt.llm) then
+                sigw=(w(l+1)-Mtot)/zzmass(m+1)
+                qm(l+1)= (1/w(l+1))*(MQtot + (w(l+1)-Mtot)*(q(m+1)+0.5*(1.-sigw)*dzq(m+1)) )
+             else
+!                w(l+1) = Mtot
+!                qm(l+1) = Mqtot / Mtot
+                write(*,*) 'top layer is disappearing !',l,Mtot,w(l+1),qm(l+1)
+		print*,zzmass
+ 		print*,w
+		print*,q
+		print*,qm
+               stop
+             end if
+          else      ! if(w(l+1).lt.0) 
+             m = l-1 
+             Mtot = zzmass(m+1)
+             MQtot = zzmass(m+1)*q(m+1)
+             if (m.gt.0) then ! because some compilers will have problems
+                              ! evaluating zzmass(0)
+              do while ((m.gt.0).and.(-w(l+1).gt.(Mtot+zzmass(m))))
+                m=m-1
+                Mtot = Mtot + zzmass(m+1)
+                MQtot = MQtot + zzmass(m+1)*q(m+1)
+                if (m.eq.0) exit
+              end do
+             endif
+             if (m.gt.0) then
+                sigw=(w(l+1)+Mtot)/zzmass(m)
+                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)*(q(m)-0.5*(1.+sigw)*dzq(m))  )
+             else
+                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)*qm(1))
+             end if   
+          end if
+       enddo
+
+!     boundary conditions (not used in newcondens !!)
+!         qm(llm+1)=0.
+!         if(w(1).gt.0.) then
+!            qm(1)=q(1)
+!         else 
+!           qm(1)=0.
+!         end if
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mkstat.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mkstat.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mkstat.F90	(revision 222)
@@ -0,0 +1,170 @@
+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
+
+use mod_phys_lmdz_para, only : is_master
+
+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
+
+if (is_master) then
+! only the master needs do this
+
+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)
+
+endif ! of if (is_master)
+
+end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_grid_phy_lmdz.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_grid_phy_lmdz.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_grid_phy_lmdz.F90	(revision 222)
@@ -0,0 +1,454 @@
+!
+!$Header$
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,nbp,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: nbp
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=nbp
+  
+  ! Ehouarn: handle 1D case:
+  if ((iim.eq.1).and.(jjp1.eq.2)) then
+    nbp_lat=1
+    klon_glo=1
+  endif
+  
+  END SUBROUTINE init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  fonctions generiques (privees)
+!---------------------------------------------------------------- 
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_grid_phy_lmdz.F90.orig
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_grid_phy_lmdz.F90.orig	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_grid_phy_lmdz.F90.orig	(revision 222)
@@ -0,0 +1,453 @@
+!
+!$Header$
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=(iim*jjp1)-2*(iim-1)
+  
+  ! Ehouarn: handle 1D case:
+  if ((iim.eq.1).and.(jjp1.eq.2)) then
+    nbp_lat=1
+    klon_glo=1
+  endif
+  
+  END SUBROUTINE init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  fonctions generiques (privees)
+!---------------------------------------------------------------- 
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_data.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_data.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_data.F90	(revision 222)
@@ -0,0 +1,212 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
+  
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+  INTEGER,SAVE :: klon_mpi_begin
+  INTEGER,SAVE :: klon_mpi_end
+  INTEGER,SAVE :: klon_mpi
+  
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end 
+
+  
+  INTEGER,SAVE :: mpi_rank
+  INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_root
+  LOGICAL,SAVE :: is_mpi_root
+  LOGICAL,SAVE :: is_using_mpi
+  
+  
+  LOGICAL,SAVE :: is_north_pole
+  LOGICAL,SAVE :: is_south_pole
+  INTEGER,SAVE :: COMM_LMDZ_PHY
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+  USE mod_const_mpi, ONLY : COMM_LMDZ
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+    
+    INTEGER :: ierr
+    INTEGER :: klon_glo
+    INTEGER :: i
+    
+#ifdef CPP_MPI
+    is_using_mpi=.TRUE.
+#else
+    is_using_mpi=.FALSE.
+#endif
+    
+    if (iim.eq.1) then
+       klon_glo=1
+    else
+!       klon_glo=iim*(jjp1-2)+2
+       klon_glo=sum(distrib)
+    endif
+    
+    COMM_LMDZ_PHY=COMM_LMDZ
+
+    IF (is_using_mpi) THEN    
+#ifdef CPP_MPI
+      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN
+      mpi_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN 
+      is_north_pole = .TRUE.
+    ELSE
+      is_north_pole = .FALSE.
+    ENDIF
+    
+    IF (mpi_rank == mpi_size-1) THEN
+      is_south_pole = .TRUE.
+    ELSE
+      is_south_pole = .FALSE.
+    ENDIF
+    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))
+
+    ALLOCATE(klon_mpi_para_nb(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_end(0:mpi_size-1))
+  
+      
+    klon_mpi_para_nb(0:mpi_size-1)=distrib(0:nb_proc-1)
+
+    DO i=0,mpi_size-1
+      IF (i==0) THEN 
+        klon_mpi_para_begin(i)=1
+      ELSE 
+        klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1
+      ENDIF
+        klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1
+    ENDDO
+
+
+    DO i=0,mpi_size-1
+      
+      IF (i==0) THEN
+        ij_para_begin(i) = 1
+      ELSE
+        ij_para_begin(i) = klon_mpi_para_begin(i)+iim-1
+      ENDIF
+
+      jj_para_begin(i) = (ij_para_begin(i)-1)/iim + 1
+      ii_para_begin(i) = MOD(ij_para_begin(i)-1,iim) + 1
+
+      
+      ij_para_end(i) = klon_mpi_para_end(i)+iim-1
+      jj_para_end(i) = (ij_para_end(i)-1)/iim + 1
+      ii_para_end(i) = MOD(ij_para_end(i)-1,iim) + 1
+
+      ! Ehouarn: handle 1D case:
+      if (klon_glo.eq.1) then
+        klon_mpi_para_end(i) = 1
+        klon_mpi_para_nb(i) = 1
+        ij_para_end(i) = 1
+        jj_para_end(i) = 1
+        ii_para_end(i) = 1
+      endif
+
+      ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1
+      jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1
+         
+    ENDDO
+  
+    ii_begin = ii_para_begin(mpi_rank)
+    ii_end   = ii_para_end(mpi_rank)
+    jj_begin = jj_para_begin(mpi_rank)
+    jj_end   = jj_para_end(mpi_rank)
+    jj_nb    = jj_para_nb(mpi_rank)
+    ij_begin = ij_para_begin(mpi_rank)
+    ij_end   = ij_para_end(mpi_rank)
+    ij_nb    = ij_para_nb(mpi_rank)
+    klon_mpi_begin = klon_mpi_para_begin(mpi_rank)
+    klon_mpi_end   = klon_mpi_para_end(mpi_rank)
+    klon_mpi       = klon_mpi_para_nb(mpi_rank)
+   
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_mpi_data
+
+  SUBROUTINE print_module_data
+  IMPLICIT NONE
+!  INCLUDE "iniprint.h" 
+  
+    WRITE(*,*) 'ii_begin =', ii_begin
+    WRITE(*,*) 'ii_end =', ii_end
+    WRITE(*,*) 'jj_begin =',jj_begin
+    WRITE(*,*) 'jj_end =', jj_end
+    WRITE(*,*) 'jj_nb =', jj_nb
+    WRITE(*,*) 'ij_begin =', ij_begin
+    WRITE(*,*) 'ij_end =', ij_end
+    WRITE(*,*) 'ij_nb =', ij_nb
+    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(*,*) 'klon_mpi =', klon_mpi
+    WRITE(*,*) 'jj_para_nb =', jj_para_nb
+    WRITE(*,*) 'jj_para_begin =', jj_para_begin
+    WRITE(*,*) 'jj_para_end =', jj_para_end
+    WRITE(*,*) 'ii_para_begin =', ii_para_begin
+    WRITE(*,*) 'ii_para_end =', ii_para_end
+    WRITE(*,*) 'ij_para_nb =', ij_para_nb
+    WRITE(*,*) 'ij_para_begin =', ij_para_begin
+    WRITE(*,*) 'ij_para_end =', ij_para_end
+    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(*,*) 'mpi_rank =', mpi_rank
+    WRITE(*,*) 'mpi_size =', mpi_size
+    WRITE(*,*) 'mpi_root =', mpi_root
+    WRITE(*,*) 'is_mpi_root =', is_mpi_root
+    WRITE(*,*) 'is_north_pole =', is_north_pole
+    WRITE(*,*) 'is_south_pole =', is_south_pole
+    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_data.F90.orig
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_data.F90.orig	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_data.F90.orig	(revision 222)
@@ -0,0 +1,211 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
+  
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+  INTEGER,SAVE :: klon_mpi_begin
+  INTEGER,SAVE :: klon_mpi_end
+  INTEGER,SAVE :: klon_mpi
+  
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end 
+
+  
+  INTEGER,SAVE :: mpi_rank
+  INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_root
+  LOGICAL,SAVE :: is_mpi_root
+  LOGICAL,SAVE :: is_using_mpi
+  
+  
+  LOGICAL,SAVE :: is_north_pole
+  LOGICAL,SAVE :: is_south_pole
+  INTEGER,SAVE :: COMM_LMDZ_PHY
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+  USE mod_const_mpi, ONLY : COMM_LMDZ
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+    
+    INTEGER :: ierr
+    INTEGER :: klon_glo
+    INTEGER :: i
+    
+#ifdef CPP_MPI
+    is_using_mpi=.TRUE.
+#else
+    is_using_mpi=.FALSE.
+#endif
+    
+    if (iim.eq.1) then
+       klon_glo=1
+    else
+       klon_glo=iim*(jjp1-2)+2
+    endif
+    
+    COMM_LMDZ_PHY=COMM_LMDZ
+
+    IF (is_using_mpi) THEN    
+#ifdef CPP_MPI
+      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN
+      mpi_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN 
+      is_north_pole = .TRUE.
+    ELSE
+      is_north_pole = .FALSE.
+    ENDIF
+    
+    IF (mpi_rank == mpi_size-1) THEN
+      is_south_pole = .TRUE.
+    ELSE
+      is_south_pole = .FALSE.
+    ENDIF
+    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))
+
+    ALLOCATE(klon_mpi_para_nb(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_end(0:mpi_size-1))
+  
+      
+    klon_mpi_para_nb(0:mpi_size-1)=distrib(0:nb_proc-1)
+
+    DO i=0,mpi_size-1
+      IF (i==0) THEN 
+        klon_mpi_para_begin(i)=1
+      ELSE 
+        klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1
+      ENDIF
+        klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1
+    ENDDO
+
+
+    DO i=0,mpi_size-1
+      
+      IF (i==0) THEN
+        ij_para_begin(i) = 1
+      ELSE
+        ij_para_begin(i) = klon_mpi_para_begin(i)+iim-1
+      ENDIF
+
+      jj_para_begin(i) = (ij_para_begin(i)-1)/iim + 1
+      ii_para_begin(i) = MOD(ij_para_begin(i)-1,iim) + 1
+
+      
+      ij_para_end(i) = klon_mpi_para_end(i)+iim-1
+      jj_para_end(i) = (ij_para_end(i)-1)/iim + 1
+      ii_para_end(i) = MOD(ij_para_end(i)-1,iim) + 1
+
+      ! Ehouarn: handle 1D case:
+      if (klon_glo.eq.1) then
+        klon_mpi_para_end(i) = 1
+        klon_mpi_para_nb(i) = 1
+        ij_para_end(i) = 1
+        jj_para_end(i) = 1
+        ii_para_end(i) = 1
+      endif
+
+      ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1
+      jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1
+         
+    ENDDO
+  
+    ii_begin = ii_para_begin(mpi_rank)
+    ii_end   = ii_para_end(mpi_rank)
+    jj_begin = jj_para_begin(mpi_rank)
+    jj_end   = jj_para_end(mpi_rank)
+    jj_nb    = jj_para_nb(mpi_rank)
+    ij_begin = ij_para_begin(mpi_rank)
+    ij_end   = ij_para_end(mpi_rank)
+    ij_nb    = ij_para_nb(mpi_rank)
+    klon_mpi_begin = klon_mpi_para_begin(mpi_rank)
+    klon_mpi_end   = klon_mpi_para_end(mpi_rank)
+    klon_mpi       = klon_mpi_para_nb(mpi_rank)
+   
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_mpi_data
+
+  SUBROUTINE print_module_data
+  IMPLICIT NONE
+!  INCLUDE "iniprint.h" 
+  
+    WRITE(*,*) 'ii_begin =', ii_begin
+    WRITE(*,*) 'ii_end =', ii_end
+    WRITE(*,*) 'jj_begin =',jj_begin
+    WRITE(*,*) 'jj_end =', jj_end
+    WRITE(*,*) 'jj_nb =', jj_nb
+    WRITE(*,*) 'ij_begin =', ij_begin
+    WRITE(*,*) 'ij_end =', ij_end
+    WRITE(*,*) 'ij_nb =', ij_nb
+    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(*,*) 'klon_mpi =', klon_mpi
+    WRITE(*,*) 'jj_para_nb =', jj_para_nb
+    WRITE(*,*) 'jj_para_begin =', jj_para_begin
+    WRITE(*,*) 'jj_para_end =', jj_para_end
+    WRITE(*,*) 'ii_para_begin =', ii_para_begin
+    WRITE(*,*) 'ii_para_end =', ii_para_end
+    WRITE(*,*) 'ij_para_nb =', ij_para_nb
+    WRITE(*,*) 'ij_para_begin =', ij_para_begin
+    WRITE(*,*) 'ij_para_end =', ij_para_end
+    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(*,*) 'mpi_rank =', mpi_rank
+    WRITE(*,*) 'mpi_size =', mpi_size
+    WRITE(*,*) 'mpi_root =', mpi_root
+    WRITE(*,*) 'is_mpi_root =', is_mpi_root
+    WRITE(*,*) 'is_north_pole =', is_north_pole
+    WRITE(*,*) 'is_south_pole =', is_south_pole
+    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_transfert.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_mpi_transfert.F90	(revision 222)
@@ -0,0 +1,1906 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_transfert
+
+
+  INTERFACE bcast_mpi
+    MODULE PROCEDURE bcast_mpi_c,                                                     &
+                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  INTERFACE scatter_mpi
+    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
+                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+		     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_mpi
+    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
+                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+		     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D_mpi
+    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+		     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather2D_mpi
+    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+		     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum_mpi
+    MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+                     reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE 
+
+ INTERFACE grid1dTo2d_mpi
+    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
+                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
+		     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
+ END INTERFACE 
+
+ INTERFACE grid2dTo1d_mpi
+    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
+                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
+		     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
+ END INTERFACE 
+    
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_mpi_c(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+   
+    CALL bcast_mpi_cgen(Var1,len(Var1))
+
+  END SUBROUTINE bcast_mpi_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_mpi_i(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    INTEGER               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_igen(Var_tmp,1)
+    var=var_tmp(1)
+    
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+    
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+  
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_rgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r4
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_lgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l4
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL scatter_mpi_igen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
+    
+  END SUBROUTINE scatter_mpi_i1
+  
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_i3
+
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,1)
+  
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_r1
+  
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_l1
+  
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_l3  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_i
+  
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i2
+  
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_R
+
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r1
+
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r2
+  
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_r3
+  
+  
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l
+
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE scatter2D_mpi_l1
+
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+  
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l2
+  
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i2
+  
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+ 
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i3
+
+
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r2
+  
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r3
+
+  
+  
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l2
+  
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i4                  
+  
+  
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+     
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r4 
+  
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_i
+  
+
+  SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i1
+
+  SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i2
+  
+  SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i3
+
+
+  SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_r
+  
+
+  SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r1
+
+  SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r2
+  
+  SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_l
+  
+
+  SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l1
+
+  SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l2
+  
+  SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l3
+
+
+  SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_i
+  
+
+  SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i1
+
+  SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i2
+  
+  SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_r
+  
+
+  SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r1
+
+  SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r2
+  
+  SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r3
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_l
+  
+
+  SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l1
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l2
+
+  
+  SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l3
+
+               
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_mpi_cgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+    
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_cgen
+
+
+      
+  SUBROUTINE bcast_mpi_igen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_igen
+
+
+
+  
+  SUBROUTINE bcast_mpi_rgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+    
+  END SUBROUTINE bcast_mpi_rgen
+  
+
+
+
+  SUBROUTINE bcast_mpi_lgen(var,nb)
+    USE mod_phys_lmdz_mpi_data ,  mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
+    if (ierr.ne.MPI_SUCCESS) then
+      write(*,*) "bcast_mpi error: ierr=",ierr
+      stop
+    endif
+#endif
+
+  END SUBROUTINE bcast_mpi_lgen
+
+  
+
+  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
+                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_igen
+
+  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+
+#endif
+
+  END SUBROUTINE scatter_mpi_rgen
+
+  
+  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_lgen  
+
+
+
+
+  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+     
+    ENDIF
+    
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
+                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_igen  
+
+  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_rgen  
+
+  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_lgen
+  
+
+
+  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+   
+    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
+    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+   
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+
+
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+            
+  END SUBROUTINE reduce_sum_mpi_igen
+  
+  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+
+    IMPLICIT NONE
+
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
+    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+ 
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+   
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE reduce_sum_mpi_rgen
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE grid1dTo2d_mpi_igen   
+
+
+  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_rgen   
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=.FALSE.
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_lgen   
+
+  
+
+
+  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_igen   
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+         VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_rgen   
+  
+
+  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_lgen   
+
+END MODULE mod_phys_lmdz_mpi_transfert
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_omp_data.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_omp_data.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_omp_data.F90	(revision 222)
@@ -0,0 +1,109 @@
+!
+!$Id: mod_phys_lmdz_omp_data.F90 1575 2011-09-21 13:57:48Z jghattas $
+!
+MODULE mod_phys_lmdz_omp_data
+
+  INTEGER,SAVE :: omp_size
+  INTEGER,SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_using_omp
+  
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_begin
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_end    
+  
+  INTEGER,SAVE :: klon_omp
+  INTEGER,SAVE :: klon_omp_begin
+  INTEGER,SAVE :: klon_omp_end
+!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_omp_data(klon_mpi)
+    USE dimphy
+    IMPLICIT NONE
+    INTEGER, INTENT(in) :: klon_mpi
+
+    INTEGER :: i
+
+    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
+    CHARACTER (LEN=80) :: abort_message
+
+
+#ifdef CPP_OMP    
+    INTEGER :: OMP_GET_NUM_THREADS
+    EXTERNAL OMP_GET_NUM_THREADS
+    INTEGER :: OMP_GET_THREAD_NUM
+    EXTERNAL OMP_GET_THREAD_NUM
+#endif  
+
+#ifdef CPP_OMP
+!$OMP MASTER
+        is_using_omp=.TRUE.
+        omp_size=OMP_GET_NUM_THREADS()
+!$OMP END MASTER
+        omp_rank=OMP_GET_THREAD_NUM()    
+#else    
+    is_using_omp=.FALSE.
+    omp_size=1
+    omp_rank=0
+#endif
+
+   is_omp_root=.FALSE.
+!$OMP MASTER
+   IF (omp_rank==0) THEN
+     is_omp_root=.TRUE.
+   ELSE
+     abort_message = 'ANORMAL : OMP_MASTER /= 0'
+     CALL abort_gcm (modname,abort_message,1)
+   ENDIF
+!$OMP END MASTER
+
+
+!$OMP MASTER 
+    ALLOCATE(klon_omp_para_nb(0:omp_size-1))
+    ALLOCATE(klon_omp_para_begin(0:omp_size-1))
+    ALLOCATE(klon_omp_para_end(0:omp_size-1))
+    
+    DO i=0,omp_size-1
+      klon_omp_para_nb(i)=klon_mpi/omp_size
+      IF (i<MOD(klon_mpi,omp_size)) klon_omp_para_nb(i)=klon_omp_para_nb(i)+1
+    ENDDO
+    
+    klon_omp_para_begin(0) = 1
+    klon_omp_para_end(0) = klon_omp_para_nb(0)
+    
+    DO i=1,omp_size-1
+      klon_omp_para_begin(i)=klon_omp_para_end(i-1)+1
+      klon_omp_para_end(i)=klon_omp_para_begin(i)+klon_omp_para_nb(i)-1
+    ENDDO
+!$OMP END MASTER
+!$OMP BARRIER
+   
+    klon_omp=klon_omp_para_nb(omp_rank)
+    klon_omp_begin=klon_omp_para_begin(omp_rank)
+    klon_omp_end=klon_omp_para_end(omp_rank)
+    
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_omp_data
+
+  SUBROUTINE Print_module_data
+  IMPLICIT NONE
+!  INCLUDE "iniprint.h"
+
+!$OMP CRITICAL  
+  WRITE(*,*)'--------> TASK ',omp_rank
+  WRITE(*,*)'omp_size =',omp_size
+  WRITE(*,*)'omp_rank =',omp_rank
+  WRITE(*,*)'is_omp_root =',is_omp_root
+  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
+  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
+  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
+  WRITE(*,*)'klon_omp =',klon_omp
+  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
+  WRITE(*,*)'klon_omp_end =',klon_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE Print_module_data
+END MODULE mod_phys_lmdz_omp_data
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_omp_transfert.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_omp_transfert.F90	(revision 222)
@@ -0,0 +1,1057 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_omp_transfert
+
+  PRIVATE
+  
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  
+  CHARACTER(LEN=size_min),SAVE            :: buffer_c
+!  INTEGER,SAVE                            :: size_c=0
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
+  INTEGER,SAVE                            :: size_i=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
+  INTEGER,SAVE                            :: size_r=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
+  INTEGER,SAVE                            :: size_l=0
+
+
+  
+  
+  INTERFACE bcast_omp
+    MODULE PROCEDURE bcast_omp_c,                                                     &
+                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+		     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE scatter_omp
+    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
+                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+		     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_omp
+    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
+                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
+		     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
+  END INTERFACE
+  
+  
+  INTERFACE reduce_sum_omp
+    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE 
+
+
+  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
+
+CONTAINS
+
+  SUBROUTINE check_buffer_i(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_i) THEN
+      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
+      size_i=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_i(size_i))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_r) THEN
+      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
+      size_r=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_r(size_r))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_l) THEN
+      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
+      size_l=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_l(size_l))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_l
+    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    
+    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
+    
+  END SUBROUTINE bcast_omp_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_omp_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    INTEGER :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_i(1)
+    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_i
+
+
+  SUBROUTINE bcast_omp_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i1
+
+
+  SUBROUTINE bcast_omp_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i2
+
+
+  SUBROUTINE bcast_omp_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i3
+
+
+  SUBROUTINE bcast_omp_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_r(1)
+    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_r
+
+
+  SUBROUTINE bcast_omp_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r1
+
+
+  SUBROUTINE bcast_omp_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r2
+
+
+  SUBROUTINE bcast_omp_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r3
+
+
+  SUBROUTINE bcast_omp_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r4
+
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_l(1)
+    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_l
+
+
+  SUBROUTINE bcast_omp_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l1
+
+
+  SUBROUTINE bcast_omp_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l2
+
+
+  SUBROUTINE bcast_omp_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l3
+
+
+  SUBROUTINE bcast_omp_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l4
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE scatter_omp_i
+
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
+    
+  END SUBROUTINE scatter_omp_i1
+  
+  
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
+
+  END SUBROUTINE scatter_omp_i2
+
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i)
+  
+  END SUBROUTINE scatter_omp_i3
+
+
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE scatter_omp_r
+
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
+        
+  END SUBROUTINE scatter_omp_r1
+  
+  
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
+
+  END SUBROUTINE scatter_omp_r2
+
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r)
+  
+  END SUBROUTINE scatter_omp_r3
+  
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE scatter_omp_l
+
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
+    
+  END SUBROUTINE scatter_omp_l1
+  
+  
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
+
+  END SUBROUTINE scatter_omp_l2
+
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l)
+  
+  END SUBROUTINE scatter_omp_l3  
+  
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
+    
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
+          
+  END SUBROUTINE gather_omp_i2
+  
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i)
+    
+  END SUBROUTINE gather_omp_i3
+
+
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
+        
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
+    
+  END SUBROUTINE gather_omp_r2
+  
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))       
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
+    
+  END SUBROUTINE gather_omp_r3
+
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
+    
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
+    
+  END SUBROUTINE gather_omp_l2
+  
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
+    
+  END SUBROUTINE gather_omp_l3
+
+
+
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_i(1)   
+    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE reduce_sum_omp_i1
+  
+  
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i2
+
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i3
+
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_r(1)   
+    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE reduce_sum_omp_r1
+  
+  
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r2
+
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r3
+
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    LES ROUTINES GENERIQUES    !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+    
+    INTEGER :: i
+  
+  !$OMP MASTER
+      Buff=Var
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var=Buff
+    ENDDO
+  !$OMP BARRIER      
+  
+  END SUBROUTINE bcast_omp_cgen
+
+
+      
+  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_igen
+
+
+  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_rgen
+
+  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+  
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_lgen
+
+
+  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+    USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+ 
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+ 
+  END SUBROUTINE scatter_omp_igen
+
+
+  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_rgen
+
+
+  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+ !$OMP MASTER 
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_lgen
+
+
+
+
+
+  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_igen
+
+
+  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_rgen
+
+
+  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_lgen
+
+
+  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_igen
+
+  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_rgen
+
+END MODULE mod_phys_lmdz_omp_transfert
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_para.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_para.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_para.F90	(revision 222)
@@ -0,0 +1,114 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_para
+  USE mod_phys_lmdz_transfert_para
+  USE mod_phys_lmdz_mpi_data
+  USE mod_phys_lmdz_omp_data
+    
+  INTEGER,SAVE :: klon_loc
+  LOGICAL,SAVE :: is_sequential
+  LOGICAL,SAVE :: is_parallel
+  LOGICAL,SAVE :: is_master
+  
+!$OMP THREADPRIVATE(klon_loc,is_master)
+  
+CONTAINS
+
+  SUBROUTINE Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+    CALL Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL Init_phys_lmdz_omp_data(klon_mpi)
+    klon_loc=klon_omp
+    IF (is_mpi_root .AND. is_omp_root) THEN 
+       is_master=.TRUE.
+     ELSE
+       is_master=.FALSE.
+     ENDIF
+     CALL Test_transfert
+!$OMP END PARALLEL    
+     IF (is_using_mpi .OR. is_using_omp) THEN
+       is_sequential=.FALSE.
+       is_parallel=.TRUE.
+     ELSE
+       is_sequential=.TRUE.
+       is_parallel=.FALSE.
+     ENDIF
+      
+  END SUBROUTINE Init_phys_lmdz_para
+
+  SUBROUTINE Test_transfert
+  USE mod_grid_phy_lmdz, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
+                               grid1dTo2d_glo, grid2dTo1d_glo
+  IMPLICIT NONE
+!    INCLUDE "iniprint.h"
+ 
+    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
+    REAL :: tmp1d_glo(klon_glo,nbp_lev)
+    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
+    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
+    REAL :: CheckSum
+    
+    INTEGER :: i,l
+  
+    Test_Field1d_glo = 0.
+    Test_Field2d_glo = 0.
+    Test_Field1d_loc = 0.
+    Test_Field2d_loc = 0.
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER
+      DO l=1,nbp_lev
+        DO i=1,klon_glo
+!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
+           Test_Field1d_glo(i,l)=1
+        ENDDO
+      ENDDO
+!$OMP END MASTER  
+    ENDIF
+  
+    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
+    CALL Gather(Test_Field1d_loc,tmp1d_glo)
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
+    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
+    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
+    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+
+    CALL bcast(Test_Field1d_glo)
+    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+     
+   END SUBROUTINE Test_transfert
+  
+END MODULE mod_phys_lmdz_para
+    
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_transfert_para.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_transfert_para.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mod_phys_lmdz_transfert_para.F90	(revision 222)
@@ -0,0 +1,1275 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_transfert_para
+
+  USE mod_phys_lmdz_mpi_transfert
+  USE mod_phys_lmdz_omp_transfert 
+
+
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c,                                     &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  END INTERFACE
+
+  
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
+                     gather_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D
+    MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, &
+                     scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, &
+		     scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3
+  END INTERFACE
+
+  INTERFACE gather2D
+    MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, &
+                     gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, &
+		     gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum
+    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
+                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
+  END INTERFACE 
+
+   
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!! --> Les entiers
+
+  SUBROUTINE scatter2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i
+
+
+  SUBROUTINE scatter2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i1
+  
+
+  SUBROUTINE scatter2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i2  
+
+
+  SUBROUTINE scatter2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i3
+  
+
+!!!!! --> Les reels
+
+  SUBROUTINE scatter2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r
+
+
+  SUBROUTINE scatter2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r1
+  
+
+  SUBROUTINE scatter2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r2  
+
+
+  SUBROUTINE scatter2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r3
+    
+    
+!!!!! --> Les booleens
+
+
+  SUBROUTINE scatter2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l
+
+
+  SUBROUTINE scatter2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l1
+  
+
+  SUBROUTINE scatter2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l2  
+
+
+  SUBROUTINE scatter2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i
+  
+
+  SUBROUTINE gather2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i1
+
+  
+  SUBROUTINE gather2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i2
+
+
+  SUBROUTINE gather2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r
+  
+
+  SUBROUTINE gather2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r1
+
+  
+  SUBROUTINE gather2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r2
+
+
+  SUBROUTINE gather2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r3
+  
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l
+  
+
+  SUBROUTINE gather2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l1
+
+  
+  SUBROUTINE gather2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l2
+
+
+  SUBROUTINE gather2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l3
+  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Les entiers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i4  
+
+
+! Les reels
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_phys_lmdz_transfert_para
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/moistadj.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/moistadj.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/moistadj.F90	(revision 222)
@@ -0,0 +1,336 @@
+subroutine moistadj(ngrid, nq, pt, pq, pdq, pplev, pplay, pdtmana, pdqmana, ptimestep, rneb)
+
+  use watercommon_h, only: T_h2O_ice_liq, RLVTT, RCPD, RCPV, Psat_water, Lcpdqsat_water
+  USE tracer_h
+
+  implicit none
+
+
+!=====================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates moist convective adjustment by the method of Manabe.
+!     
+!     Authors
+!     -------
+!     Adapted from the LMDTERRE code by R. Wordsworth (2010)
+!     Original author Z. X. Li (1993)
+!     
+!=====================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+
+      INTEGER ngrid, nq
+
+      REAL pt(ngrid,nlayermx)            ! temperature (K)
+      REAL pq(ngrid,nlayermx,nq)       ! tracer (kg/kg)
+      REAL pdq(ngrid,nlayermx,nq)
+
+      REAL pdqmana(ngrid,nlayermx,nq)  ! tendency of tracers (kg/kg.s-1)
+      REAL pdtmana(ngrid,nlayermx)       ! temperature increment
+
+!     local variables
+      REAL zt(ngrid,nlayermx)      ! temperature (K)
+      REAL zq(ngrid,nlayermx)      ! humidite specifique (kg/kg)
+      REAL pplev(ngrid,nlayermx+1) ! pression a inter-couche (Pa)
+      REAL pplay(ngrid,nlayermx)   ! pression au milieu de couche (Pa)
+
+      REAL d_t(ngrid,nlayermx)     ! temperature increment
+      REAL d_q(ngrid,nlayermx)     ! incrementation pour vapeur d'eau
+      REAL d_ql(ngrid,nlayermx)    ! incrementation pour l'eau liquide
+      REAL rneb(ngrid,nlayermx) ! cloud fraction 
+      REAL ptimestep
+
+!      REAL t_coup
+!      PARAMETER (t_coup=234.0)
+      REAL seuil_vap
+      PARAMETER (seuil_vap=1.0E-10)
+
+!     Local variables
+      INTEGER i, k, iq, nn
+      INTEGER, PARAMETER :: niter = 1
+      INTEGER k1, k1p, k2, k2p
+      LOGICAL itest(ngrid)
+      REAL delta_q(ngrid, nlayermx)
+      DOUBLE PRECISION :: cp_new_t(nlayermx), v_cptt(ngrid,nlayermx)
+      REAL cp_delta_t(nlayermx)
+      DOUBLE PRECISION :: v_cptj(nlayermx), v_cptjk1, v_ssig
+      REAL v_p, v_t, v_zqs,v_cptt2,v_pratio,v_dlnpsat
+      REAL zqs(ngrid,nlayermx), zdqs(ngrid,nlayermx),zpsat(ngrid,nlayermx),zdlnpsat(ngrid,nlayermx)
+      REAL zq1(ngrid), zq2(ngrid)
+      DOUBLE PRECISION :: gamcpdz(ngrid,2:nlayermx)
+      DOUBLE PRECISION :: zdp, zdpm
+
+      REAL zsat ! super-saturation
+      REAL zflo ! flotabilite
+
+      DOUBLE PRECISION :: local_q(ngrid,nlayermx),local_t(ngrid,nlayermx)
+
+      REAL zdelta, zcor, zcvm5
+
+      REAL dEtot, dqtot, masse ! conservation diagnostics
+      real dL1tot, dL2tot
+
+!     Indices of water vapour and water ice tracers
+      INTEGER,SAVE :: i_h2o=0  ! water vapour
+      INTEGER,SAVE :: i_ice=0  ! water ice
+
+      LOGICAL firstcall
+      SAVE firstcall
+
+      DATA firstcall /.TRUE./
+
+      IF (firstcall) THEN
+
+         i_h2o=igcm_h2o_vap
+         i_ice=igcm_h2o_ice
+        
+         write(*,*) "rain: i_ice=",i_ice
+         write(*,*) "      i_h2o=",i_h2o
+
+         firstcall = .FALSE.
+      ENDIF
+
+!     GCM -----> subroutine variables
+      zq(1:ngrid,1:nlayermx)    = pq(1:ngrid,1:nlayermx,i_h2o)+ pdq(1:ngrid,1:nlayermx,i_h2o)*ptimestep
+      zt(1:ngrid,1:nlayermx)    = pt(1:ngrid,1:nlayermx)
+      pdqmana(1:ngrid,1:nlayermx,1:nq)=0.0
+
+      DO k = 1, nlayermx
+       DO i = 1, ngrid
+         if(zq(i,k).lt.0.)then
+            zq(i,k)=0.0
+         endif
+       ENDDO
+      ENDDO
+      
+      local_q(1:ngrid,1:nlayermx) = zq(1:ngrid,1:nlayermx)
+      local_t(1:ngrid,1:nlayermx) = zt(1:ngrid,1:nlayermx)
+      rneb(1:ngrid,1:nlayermx) = 0.0
+      d_ql(1:ngrid,1:nlayermx) = 0.0
+      d_t(1:ngrid,1:nlayermx)  = 0.0
+      d_q(1:ngrid,1:nlayermx)  = 0.0
+
+!     Calculate v_cptt
+      DO k = 1, nlayermx
+         DO i = 1, ngrid
+            v_cptt(i,k) = RCPD * local_t(i,k)
+            v_t = MAX(local_t(i,k),15.)
+            v_p = pplay(i,k)
+
+            call Psat_water(v_t,v_p,zpsat(i,k),zqs(i,k))
+	    call Lcpdqsat_water(v_t,v_p,zpsat(i,k),zqs(i,k),zdqs(i,k),zdlnpsat(i,k))
+         ENDDO
+      ENDDO
+
+!     Calculate Gamma * Cp * dz: (gamma is the critical gradient)
+      DO k = 2, nlayermx
+         DO i = 1, ngrid
+            zdp = pplev(i,k)-pplev(i,k+1)
+            zdpm = pplev(i,k-1)-pplev(i,k)
+!            gamcpdz(i,k) = ( ( R/RCPD /(zdpm+zdp) * (v_cptt(i,k-1)*zdpm + v_cptt(i,k)*zdp)          &
+!                +  RLVTT /(zdpm+zdp) * (zqs(i,k-1)*zdpm + zqs(i,k)*zdp) )                           &
+!	        * (pplay(i,k-1)-pplay(i,k)) / pplev(i,k) )                                          &
+!                / (1.0+ (zdqs(i,k-1)*zdpm + zdqs(i,k)*zdp)/(zdpm+zdp) )                    
+! general case where water is not a trace gas (JL13)
+            v_zqs     = (zqs(i,k-1)*zdpm + zqs(i,k)*zdp)/(zdpm+zdp)
+	    v_cptt2   = (v_cptt(i,k-1)*zdpm + v_cptt(i,k)*zdp)/(zdpm+zdp)
+	    v_pratio  = ((1.-zpsat(i,k-1)/pplay(i,k-1))*zdpm + (1.-zpsat(i,k)/pplay(i,k))*zdp)/(zdpm+zdp)
+	    v_dlnpsat = (zdlnpsat(i,k-1)*zdpm + zdlnpsat(i,k)*zdp)/(zdpm+zdp)
+            gamcpdz(i,k) = ( (R/RCPD*v_cptt2*(1.- v_zqs) + RLVTT*v_zqs) * (pplay(i,k-1)-pplay(i,k))/pplev(i,k) )  &
+                / (((1.- v_zqs) + v_zqs * RCPV/RCPD)*v_pratio + v_zqs  * v_dlnpsat)                
+         ENDDO
+      ENDDO
+
+!------------------------------------ modification of unstable profile
+      DO 9999 i = 1, ngrid
+
+      itest(i) = .FALSE.
+
+!        print*,'we in the loop'
+!        stop    
+
+      k1 = 0
+      k2 = 1
+
+  810 CONTINUE ! look for k1, the base of the column
+      k2 = k2 + 1
+      IF (k2 .GT. nlayermx) GOTO 9999
+      zflo = v_cptt(i,k2-1) - v_cptt(i,k2) - gamcpdz(i,k2)
+      zsat=(local_q(i,k2-1)-zqs(i,k2-1))*(pplev(i,k2-1)-pplev(i,k2))   &
+         +(local_q(i,k2)-zqs(i,k2))*(pplev(i,k2)-pplev(i,k2+1))
+
+      IF ( zflo.LE.0.0 .OR. zsat.LE.0.0 ) GOTO 810
+      k1 = k2 - 1
+      itest(i) = .TRUE.
+
+  820 CONTINUE !! look for k2, the top of the column
+      IF (k2 .EQ. nlayermx) GOTO 821
+      k2p = k2 + 1
+      zsat=zsat+(pplev(i,k2p)-pplev(i,k2p+1))*(local_q(i,k2p)-zqs(i,k2p))
+      zflo = v_cptt(i,k2p-1) - v_cptt(i,k2p) - gamcpdz(i,k2p)
+
+      IF (zflo.LE.0.0 .OR. zsat.LE.0.0) GOTO 821
+      k2 = k2p
+      GOTO 820
+  821 CONTINUE
+
+!------------------------------------------------------ local adjustment
+  830 CONTINUE ! actual adjustment
+    Do nn=1,niter
+      v_cptj(k1) = 0.0
+      zdp = pplev(i,k1)-pplev(i,k1+1)
+      v_cptjk1 = ( (1.0+zdqs(i,k1))*(v_cptt(i,k1)+v_cptj(k1)) + RLVTT*(local_q(i,k1)-zqs(i,k1)) ) * zdp
+      v_ssig = zdp * (1.0+zdqs(i,k1))
+
+      k1p = k1 + 1
+      DO k = k1p, k2
+         zdp = pplev(i,k)-pplev(i,k+1)
+         v_cptj(k) = v_cptj(k-1) + gamcpdz(i,k)
+         v_cptjk1 = v_cptjk1 + zdp * ( (1.0+zdqs(i, k))*(v_cptt(i,k)+v_cptj(k)) + RLVTT*(local_q(i,k)-zqs(i,k)) )        
+         v_ssig = v_ssig + zdp *(1.0+zdqs(i,k))
+      ENDDO
+
+
+      ! this right here is where the adjustment is done???
+      DO k = k1, k2
+         cp_new_t(k) = v_cptjk1/v_ssig - v_cptj(k)
+         cp_delta_t(k) = cp_new_t(k) - v_cptt(i,k)
+         v_cptt(i,k)=cp_new_t(k)
+         local_q(i,k) = zqs(i,k) + zdqs(i,k)*cp_delta_t(k)/RLVTT
+         local_t(i,k) = cp_new_t(k) / RCPD
+
+         v_t = MAX(local_t(i,k),15.)
+         v_p = pplay(i,k)
+         
+         call Psat_water(v_t,v_p,zpsat(i,k),zqs(i,k))
+         call Lcpdqsat_water(v_t,v_p,zpsat(i,k),zqs(i,k),zdqs(i,k),zdlnpsat(i,k))
+
+      ENDDO
+    Enddo ! nn=1,niter
+
+
+!--------------------------------------------------- sounding downwards
+!              -- we refine the prognostic variables in
+!              -- the layer about to be adjusted
+
+!      DO k = k1, k2
+!         v_cptt(i,k) = RCPD * local_t(i,k)
+!         v_t = local_t(i,k)
+!         v_p = pplay(i,k)
+!       
+!         call Psat_water(v_t,v_p,zpsat,zqs(i,k))
+!         call Lcpdqsat_water(v_t,v_p,zpsat,zqs(i,k),zdqs(i,k))
+!      ENDDO
+
+      DO k = 2, nlayermx
+         zdpm = pplev(i,k-1) - pplev(i,k)
+         zdp = pplev(i,k) - pplev(i,k+1)
+!         gamcpdz(i,k) = ( ( R/RCPD /(zdpm+zdp) * (v_cptt(i,k-1)*zdpm + v_cptt(i,k)*zdp)          &
+!             +  RLVTT /(zdpm+zdp) * (zqs(i,k-1)*zdpm + zqs(i,k)*zdp) )                           &
+!	      * (pplay(i,k-1)-pplay(i,k)) / pplev(i,k) )                                          &
+!             / (1.0+ (zdqs(i,k-1)*zdpm + zdqs(i,k)*zdp)/(zdpm+zdp) )                    
+! general case where water is not a trace gas (JL13)
+         v_zqs     = (zqs(i,k-1)*zdpm + zqs(i,k)*zdp)/(zdpm+zdp)
+	 v_cptt2   = (v_cptt(i,k-1)*zdpm + v_cptt(i,k)*zdp)/(zdpm+zdp)
+	 v_pratio  = ((1.-zpsat(i,k-1)/pplay(i,k-1))*zdpm + (1.-zpsat(i,k)/pplay(i,k))*zdp)/(zdpm+zdp)
+	 v_dlnpsat = (zdlnpsat(i,k-1)*zdpm + zdlnpsat(i,k)*zdp)/(zdpm+zdp)
+         gamcpdz(i,k) = ( (R/RCPD*v_cptt2*(1.- v_zqs) + RLVTT*v_zqs) * (pplay(i,k-1)-pplay(i,k))/pplev(i,k) )  &
+                / (((1.- v_zqs) + v_zqs * RCPV/RCPD)*v_pratio + v_zqs  * v_dlnpsat)                
+      ENDDO
+
+!     Test to see if we've reached the bottom
+
+      IF (k1 .EQ. 1) GOTO 841 ! yes we have!
+      zflo = v_cptt(i,k1-1) - v_cptt(i,k1) - gamcpdz(i,k1)
+      zsat=(local_q(i,k1-1)-zqs(i,k1-1))*(pplev(i,k1-1)-pplev(i,k1))   &
+        + (local_q(i,k1)-zqs(i,k1))*(pplev(i,k1)-pplev(i,k1+1))
+      IF (zflo.LE.0.0 .OR. zsat.LE.0.0) GOTO 841 ! yes we have!
+
+  840 CONTINUE
+      k1 = k1 - 1
+      IF (k1 .EQ. 1) GOTO 830 ! GOTO 820 (a tester, Z.X.Li, mars 1995)
+      zsat = zsat + (local_q(i,k1-1)-zqs(i,k1-1))               &
+                  *(pplev(i,k1-1)-pplev(i,k1))
+      zflo = v_cptt(i,k1-1) - v_cptt(i,k1) - gamcpdz(i,k1)
+      IF (zflo.GT.0.0 .AND. zsat.GT.0.0) THEN
+         GOTO 840
+      ELSE
+         GOTO 830 ! GOTO 820 (a tester, Z.X.Li, mars 1995)
+      ENDIF
+  841 CONTINUE
+
+      GOTO 810 ! look for other layers higher up
+
+ 9999 CONTINUE ! loop over all the points
+
+!-----------------------------------------------------------------------
+! Determine the cloud fraction (hypothese: la nebulosite a lieu
+! a l'endroit ou la vapeur d'eau est diminuee par l'ajustement):
+
+      DO k = 1, nlayermx
+      DO i = 1, ngrid
+         IF (itest(i)) THEN
+         delta_q(i,k) = local_q(i,k) - zq(i,k)
+         IF (delta_q(i,k).LT.0.) rneb(i,k)  = 1.0
+         ENDIF
+      ENDDO
+      ENDDO
+
+! Distribuer l'eau condensee en eau liquide nuageuse (hypothese:
+! l'eau liquide est distribuee aux endroits ou la vapeur d'eau
+! diminue et d'une maniere proportionnelle a cet diminution):
+
+      DO i = 1, ngrid
+         IF (itest(i)) THEN
+         zq1(i) = 0.0
+         zq2(i) = 0.0
+         ENDIF
+      ENDDO
+      DO k = 1, nlayermx
+      DO i = 1, ngrid
+         IF (itest(i)) THEN
+         zdp = pplev(i,k)-pplev(i,k+1)
+         zq1(i) = zq1(i) - delta_q(i,k) * zdp
+         zq2(i) = zq2(i) - MIN(0.0, delta_q(i,k)) * zdp
+         ENDIF
+      ENDDO
+      ENDDO
+      DO k = 1, nlayermx
+      DO i = 1, ngrid
+         IF (itest(i)) THEN
+           IF (zq2(i).NE.0.0) d_ql(i,k) = - MIN(0.0,delta_q(i,k))*zq1(i)/zq2(i)
+         ENDIF
+      ENDDO
+      ENDDO
+
+      DO k = 1, nlayermx
+      DO i = 1, ngrid
+          local_q(i, k) = MAX(local_q(i, k), seuil_vap)
+      ENDDO
+      ENDDO
+
+      DO k = 1, nlayermx
+      DO i = 1, ngrid
+         d_t(i,k) = local_t(i,k) - zt(i,k)
+         d_q(i,k) = local_q(i,k) - zq(i,k)
+      ENDDO
+      ENDDO
+
+!     now subroutine -----> GCM variables
+      DO k = 1, nlayermx
+         DO i = 1, ngrid
+            
+            pdtmana(i,k)       = d_t(i,k)/ptimestep
+            pdqmana(i,k,i_h2o) = d_q(i,k)/ptimestep
+            pdqmana(i,k,i_ice) = d_ql(i,k)/ptimestep
+         
+         ENDDO
+      ENDDO
+
+
+      RETURN
+   END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mucorr.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mucorr.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mucorr.F	(revision 222)
@@ -0,0 +1,113 @@
+      SUBROUTINE mucorr(npts,pdeclin, plat, pmu,pfract,phaut,prad,pflat)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day whithout 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         npts             number of points
+c         pdeclin          solar declinaison
+c         plat(npts)        latitude
+c         phaut            hauteur typique de l'atmosphere
+c         prad             rayon planetaire
+c
+c      Output :
+c      --------
+c         pmu(npts)          equivalent cosinus of the solar angle
+c         pfract(npts)       fractionnal day
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+
+c     Arguments :
+c     -----------
+      INTEGER npts
+      REAL plat(npts),pmu(npts), pfract(npts)
+      REAL phaut,prad,pdeclin, pflat
+c
+c     Local variables :
+c     -----------------
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b, tp, rap
+      REAL alph
+
+c-----------------------------------------------------------------------
+
+c----- SG: geometry adapted to a flattened planet (Feb2014)
+
+      pi = 4. * atan(1.0)
+      z = pdeclin
+      cz = cos (z)
+      sz = sin (z)
+      rap = 1./((1.-pflat)**2)
+
+      DO 20 j = 1, npts
+
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -rap*tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+   
+         IF(t.eq.0.) then
+            tp=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) then
+               tp = -atan (-t) + pi
+            ELSE
+               tp = atan(t)
+            ENDIF
+         ENDIF
+         t = tp
+   
+         pmu(j) = (sphi*sz*t*rap) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) then
+            pmu(j) = sphi * sz*rap
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+
+         pmu(j)=pmu(j)/SQRT(cphi**2 + (rap**2) * (sphi**2))
+
+   20 CONTINUE
+
+c-----------------------------------------------------------------------
+c   correction de rotondite:
+c   ------------------------
+
+      ! condition added to avoid errors when rad is not set (e.g. 1D runs)
+      IF (prad.ne.0) THEN
+  
+      alph=phaut/prad
+      DO 30 j=1,npts
+c !!!!!!
+ !!!!!!! AS: how generic is this???
+         pmu(j)=sqrt(1224.*pmu(j)*pmu(j)+1.)/35.
+c    $          (sqrt(alph*alph*pmu(j)*pmu(j)+2.*alph+1.)-alph*pmu(j))
+30    CONTINUE
+
+      ENDIF
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mufract.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mufract.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/mufract.F	(revision 222)
@@ -0,0 +1,92 @@
+      SUBROUTINE mufract(jjm,pdecli, plat, pmu, pfract)
+      IMPLICIT NONE
+c
+c=======================================================================
+c
+c   Calcul of equivalent solar angle and and fraction of day without 
+c   diurnal cycle.
+c
+c   parmeters :
+c   -----------
+c
+c      Input :
+c      -------
+c         jjm              number of points
+c         pdecli           solar declinaison
+c         plat(jjm)        latitude
+c
+c      Output :
+c      --------
+c         pmu(jjm)          equivalent cosinus of the solar angle
+c         pfract(jjm)       fractionnal day
+c
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0. Declarations :
+c    -----------------
+c
+c     Arguments :
+c     -----------
+
+      INTEGER jjm
+      REAL plat(jjm),pmu(jjm), pfract(jjm)
+      REAL pdecli
+c
+c     Local variables :
+c     -----------------
+
+      INTEGER j
+      REAL pi
+      REAL z,cz,sz,tz,phi,cphi,sphi,tphi
+      REAL ap,a,t,b
+c
+c=======================================================================
+c
+      pi = 4. * atan(1.0)
+      z = pdecli
+      cz = cos (z*pi/180.)
+      sz = sin (z*pi/180.)
+c
+      DO 20 j = 1, jjm
+c
+         phi = plat(j)
+         cphi = cos(phi)
+         if (cphi.le.1.e-9) cphi=1.e-9
+         sphi = sin(phi)
+         tphi = sphi / cphi
+         b = cphi * cz
+         t = -tphi * sz / cz
+         a = 1.0 - t*t
+         ap = a
+         IF(t.eq.0.) THEN
+            t=0.5*pi
+         ELSE
+            IF (a.lt.0.) a = 0.
+            t = sqrt(a) / t
+            IF (t.lt.0.) THEN
+               t = -atan (-t) + pi
+            ELSE
+               t = atan(t)
+            ENDIF
+         ENDIF
+         pmu(j) = (sphi*sz*t) / pi + b*sin(t)/pi
+         pfract(j) = t / pi
+         IF (ap .lt.0.) THEN
+            pmu(j) = sphi * sz
+            pfract(j) = 1.0
+         ENDIF
+         IF (pmu(j).le.0.0) pmu(j) = 0.0
+         pmu(j) = pmu(j) / pfract(j)
+         IF (pmu(j).eq.0.) pfract(j) = 0.
+c
+   20 CONTINUE
+c
+      RETURN
+      END
+c
+c* end of mufract
+c=======================================================================
+c
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/multipl.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/multipl.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/multipl.F	(revision 222)
@@ -0,0 +1,17 @@
+      SUBROUTINE multipl(n,x1,x2,y)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   multiplication de deux vecteurs
+c
+c=======================================================================
+c
+      INTEGER n,i
+      REAL x1(n),x2(n),y(n)
+c
+      DO 10 i=1,n
+         y(i)=x1(i)*x2(i)
+10    CONTINUE
+c
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newsedim.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newsedim.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newsedim.F	(revision 222)
@@ -0,0 +1,198 @@
+      SUBROUTINE newsedim(ngrid,nlay,naersize,ptimestep,
+     &  pplev,masse,epaisseur,pt,rd,rho,pqi,wq)
+      IMPLICIT NONE
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!      Calculates sedimentation of 1 tracer 
+!      of radius rd (m) and density rho (kg.m-3) 
+!     
+!==================================================================
+
+!-----------------------------------------------------------------------
+!   declarations
+!   ------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+
+!   arguments
+!   ---------
+
+      integer,intent(in) :: ngrid  ! number of atmospheric columns
+      integer,intent(in) :: nlay  ! number of atmospheric layers
+      integer,intent(in) :: naersize   ! number of particle sizes (1 or number
+                                       ! of grid boxes)
+      real,intent(in) :: ptimestep ! physics time step (s)
+      real,intent(in) :: pplev(ngrid,nlay+1)   ! inter-layer pressures (Pa)
+      real,intent(in) :: pt(ngrid,nlay)    ! mid-layer temperatures (K)
+      real,intent(in) :: masse (ngrid,nlay) ! atmospheric mass (kg)
+      real,intent(in) :: epaisseur (ngrid,nlay)  ! thickness of atm. layers (m)
+      real,intent(in) :: rd(naersize) ! particle radius (m)
+      real,intent(in) :: rho ! particle density (kg.m-3)
+      real,intent(inout) :: pqi(ngrid,nlay)  ! tracer   (e.g. ?/kg)
+      real,intent(out) :: wq(ngrid,nlay+1)  ! flux of tracer during timestep (?/m-2)
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, k, i
+      REAL rfall
+
+      LOGICAL,SAVE :: firstcall=.true.
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      real traversee (ngrid,nlayermx)
+      real vstokes(ngrid,nlayermx)
+      real w(ngrid,nlayermx)
+      real ptop, dztop, Ep, Stra
+
+
+c    Physical constant
+c    ~~~~~~~~~~~~~~~~~
+c     Gas molecular viscosity (N.s.m-2)
+      real,parameter :: visc=1.e-5       ! CO2
+c     Effective gas molecular radius (m)
+      real,parameter :: molrad=2.2e-10   ! CO2
+
+c     local and saved variable
+      real,save :: a,b
+
+c    ** un petit test de coherence
+c       --------------------------
+
+
+      !print*,'temporary fixed particle rad in newsedim!!'
+
+      IF (firstcall) THEN
+         firstcall=.false.
+
+
+
+!=======================================================================
+!     Preliminary calculations for sedimenation velocity
+
+!       - Constant to compute stokes speed simple formulae
+!        (Vstokes =  b * rho* r**2   avec   b= (2/9) * rho * g / visc
+         b = 2./9. * g / visc
+
+!       - Constant  to compute gas mean free path
+!        l= (T/P)*a, avec a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+         a = 0.707*8.31/(4*3.1416* molrad**2  * 6.023e23)
+
+c       - Correction to account for non-spherical shape (Murphy et al.  1990)
+c   (correction = 0.85 for irregular particles, 0.5 for disk shaped particles)
+c        a = a    * 0.85
+
+
+      ENDIF
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c     Sedimentation velocity (m/s)
+c     ~~~~~~~~~~~~~~~~~~~~~~
+c     (stokes law corrected for low pressure by the Cunningham
+c     slip-flow correction  according to Rossow (Icarus 36, 1-50, 1978)
+       
+        do  l=1,nlay
+          do ig=1, ngrid
+            if (naersize.eq.1) then 
+              rfall=rd(1)
+            else
+              i=ngrid*(l-1)+ig
+              rfall=rd(i) ! how can this be correct!!?
+            endif  
+
+            vstokes(ig,l) = b * rho * rfall**2 *
+     &      (1 + 1.333* ( a*pt(ig,l)/pplev(ig,l) )/rfall)
+
+c           Layer crossing time (s) :
+            traversee(ig,l)= epaisseur(ig,l)/vstokes(ig,l)
+          end do
+        end do
+
+
+c     Calcul de la masse d'atmosphere correspondant a q transferee
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     (e.g. on recherche le niveau  en dessous de laquelle le traceur
+c      va traverser le niveau intercouche l : "dztop" est sa hauteur
+c      au dessus de l (m), "ptop" est sa pression (Pa))
+      do  l=1,nlay
+        do ig=1, ngrid
+             
+             dztop = vstokes(ig,l)*  ptimestep 
+             Ep=0
+             k=0
+           w(ig,l) = 0. !! JF+AS ajout initialisation (LK MARS)
+c **************************************************************
+c            Simple Method
+cc             w(ig,l) =
+cc     &       (1- exp(-dztop*g/(r*pt(ig,l))))*pplev(ig,l) / g
+cc             write(*,*) 'OK simple method l,w =', l, w(ig,l)
+cc            write(*,*) 'OK simple method dztop =', dztop
+           w(ig,l) = 1. - exp(-dztop*g/(r*pt(ig,l)))
+             !!! Diagnostic: JF. Fix: AS. Date: 05/11
+             !!! Probleme arrondi avec la quantite ci-dessus
+             !!! ---> vaut 0 pour -dztop*g/(r*pt(ig,l)) trop petit
+             !!! ---> dans ce cas on utilise le developpement limite !
+             !!! ---> exp(-x) = 1 - x lorsque x --> 0 avec une erreur de x^2 / 2  
+
+             IF ( w(ig,l) .eq. 0. ) THEN
+                w(ig,l) = ( dztop*g/(r*pt(ig,l)) ) * pplev(ig,l) / g
+             ELSE
+                w(ig,l) = w(ig,l) * pplev(ig,l) / g
+             ENDIF
+! LK borrowed simple method from Mars model (AS/JF)
+
+!**************************************************************
+cccc         Complex method :
+           if (dztop.gt.epaisseur(ig,l)) then
+cccc            Cas ou on "epuise" la couche l : On calcule le flux
+cccc            Venant de dessus en tenant compte de la variation de Vstokes
+
+               Ep= epaisseur(ig,l)
+               Stra= traversee(ig,l)
+               do while(dztop.gt.Ep.and.l+k+1.le.nlay)
+                 k=k+1
+                 dztop= Ep + vstokes(ig,l+k)*(ptimestep -Stra)
+                 Ep = Ep + epaisseur(ig,l+k)
+                 Stra = Stra + traversee(ig,l+k)
+               enddo 
+               Ep = Ep - epaisseur(ig,l+k)
+!             ptop=pplev(ig,l+k)*exp(-(dztop-Ep)*g/(r*pt(ig,l+k)))
+             ptop=exp(-(dztop-Ep)*g/(r*pt(ig,l+k)))
+	     IF ( ptop .eq. 1. ) THEN
+                !PRINT*, 'newsedim: exposant trop petit ', ig, l
+                ptop=pplev(ig,l+k) * ( 1. - (dztop-Ep)*g/(r*pt(ig,l+k)))
+             ELSE
+                ptop=pplev(ig,l+k) * ptop
+             ENDIF
+
+             w(ig,l) = (pplev(ig,l) - ptop)/g
+
+            endif   !!! complex method
+c
+cc           write(*,*) 'OK new    method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK new    method dztop =', dztop
+cc       if(l.eq.7)write(*,*)'l=7,k,pplev,Ptop',pplev(ig,l),Ptop
+cc       if(l.eq.7)write(*,*)'l=7,dztop,Ep',dztop,Ep
+cc            if(l.eq.6)write(*,*)'l=6,k, w',k, w(1,l)
+cc            if(l.eq.7)write(*,*)'l=7,k, w',k, w(1,l)
+cc            if(l.eq.8)write(*,*)'l=8,k, w',k, w(1,l)
+c **************************************************************
+
+        end do
+      end do
+
+      call vlz_fi(ngrid,pqi,2.,masse,w,wq)
+c         write(*,*) ' newsed: wq(6), wq(7), q(6)',
+c    &                wq(1,6),wq(1,7),pqi(1,6)
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newstart.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newstart.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newstart.F	(revision 222)
@@ -0,0 +1,1590 @@
+C======================================================================
+      PROGRAM newstart
+c=======================================================================
+c
+c
+c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
+c   ------
+c             Derniere modif : 12/03
+c
+c
+c   Objet:  Create or modify the initial state for the LMD Mars GCM
+c   -----           (fichiers NetCDF start et startfi)
+c
+c
+c=======================================================================
+
+      use infotrac, only: iniadvtrac, nqtot, tname
+      USE tracer_h, ONLY: igcm_co2_ice, igcm_h2o_vap, igcm_h2o_ice
+      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, inertiedat
+      USE surfdat_h, ONLY: phisfi, albedodat,
+     &                     zmea, zstd, zsig, zgam, zthe
+      USE comgeomfi_h, ONLY: lati, long, area
+      use datafile_mod, only: datadir
+! to use  'getin'
+      USE ioipsl_getincom, only: getin
+      use control_mod, only: day_step, iphysiq, anneeref
+      use phyredem, only: physdem0, physdem1
+      use iostart, only: open_startphy
+      use comgeomphy, only: initcomgeomphy
+      use slab_ice_h, only:noceanmx
+      implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+#include "logic.h"
+#include "ener.h"
+#include "temps.h"
+#include "comdissnew.h"
+#include "serre.h"
+#include "netcdf.inc"
+!#include "advtrac.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Variables dimension du fichier "start_archive"
+c------------------------------------
+      CHARACTER	relief*3
+
+
+c Variables pour les lectures NetCDF des fichiers "start_archive" 
+c--------------------------------------------------
+      INTEGER nid_dyn, nid_fi,nid,nvarid
+      INTEGER length
+      parameter (length = 100)
+      INTEGER tab0
+      INTEGER   NB_ETATMAX
+      parameter (NB_ETATMAX = 100)
+
+      REAL  date
+      REAL p_rad,p_omeg,p_g,p_cpp,p_mugaz,p_daysec
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL phis(iip1,jjp1)
+      REAL,ALLOCATABLE :: q(:,:,:,:)               ! champs advectes
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+      REAL pks(iip1,jjp1)
+      REAL w(iip1,jjp1,llm+1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
+      REAL phi(iip1,jjp1,llm)
+
+      integer klatdat,klongdat
+      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+c variable physique
+c------------------
+      REAL tsurf(ngridmx)	! surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
+!      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL emis(ngridmx)	! surface emissivity
+      real emisread             ! added by RW
+      REAL,ALLOCATABLE :: qsurf(:,:)
+      REAL q2(ngridmx,nlayermx+1)
+!      REAL rnaturfi(ngridmx)
+      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
+      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
+      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+
+      INTEGER i,j,l,isoil,ig,idum
+      real mugaz ! molar mass of the atmosphere
+
+      integer ierr 
+
+      REAL rnat(ngridmx)
+      REAL tslab(ngridmx,nsoilmx) ! slab ocean temperature
+      REAL pctsrf_sic(ngridmx) ! sea ice cover
+      REAL tsea_ice(ngridmx) ! temperature sea_ice
+      REAL sea_ice(ngridmx) ! mass of sea ice (kg/m2)
+
+c Variables on the new grid along scalar points 
+c------------------------------------------------------
+!      REAL p(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      REAL tset(iip1,jjp1,llm)
+      real phisold_newgrid(iip1,jjp1)
+      REAL :: teta(iip1, jjp1, llm)
+      REAL :: pk(iip1,jjp1,llm)
+      REAL :: pkf(iip1,jjp1,llm)
+      REAL :: ps(iip1, jjp1)
+      REAL :: masse(iip1,jjp1,llm)
+      REAL :: xpn,xps,xppn(iim),xpps(iim)
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: beta(iip1,jjp1,llm)
+!      REAL dteta(ip1jmp1,llm)
+
+c Variable de l'ancienne grille 
+c------------------------------
+      real time
+      real tab_cntrl(100)
+      real tab_cntrl_bis(100)
+
+c variables diverses
+c-------------------
+      real choix_1,pp
+      character*80      fichnom
+      character*250  filestring
+      integer Lmodif,iq,thermo
+      character modif*20
+      real z_reel(iip1,jjp1)
+      real tsud,albsud,alb_bb,ith_bb,Tiso,Tabove
+      real ptoto,pcap,patm,airetot,ptotn,patmn,psea
+!      real ssum
+      character*1 yes
+      logical :: flagtset=.false. ,  flagps0=.false.
+      real val, val2, val3 ! to store temporary variables
+      real :: iceith=2000 ! thermal inertia of subterranean ice
+      integer iref,jref
+
+      INTEGER :: itau
+      
+      INTEGER :: nq,numvanle
+      character(len=20) :: txt ! to store some text
+      character(len=50) :: surfacefile ! "surface.nc" (or equivalent file)
+      character(len=150) :: longline
+      integer :: count
+      real :: profile(llm+1) ! to store an atmospheric profile + surface value
+
+!     added by RW for test
+      real pmean, phi0
+
+!     added by BC for equilibrium temperature startup
+      real teque
+
+!     added by BC for cloud fraction setup
+      REAL hice(ngridmx),cloudfrac(ngridmx,nlayermx)
+      REAL totalfrac(ngridmx)
+
+
+!     added by RW for nuketharsis
+      real fact1
+      real fact2
+
+
+c sortie visu pour les champs dynamiques
+c---------------------------------------
+!      INTEGER :: visuid
+!      real :: time_step,t_ops,t_wrt
+!      CHARACTER*80 :: visu_file
+
+      cpp    = 0.
+      preff  = 0.
+      pa     = 0. ! to ensure disaster rather than minor error if we don`t
+                  ! make deliberate choice of these values elsewhere.
+
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+! allocate arrays
+      allocate(q(iip1,jjp1,llm,nqtot))
+      allocate(qsurf(ngridmx,nqtot))
+
+c=======================================================================
+c   Choice of the start file(s) to use
+c=======================================================================
+      write(*,*) 'From which kind of files do you want to create new',
+     .  'start and startfi files'
+      write(*,*) '    0 - from a file start_archive'
+      write(*,*) '    1 - from files start and startfi'
+ 
+c-----------------------------------------------------------------------
+c   Open file(s) to modify (start or start_archive)
+c-----------------------------------------------------------------------
+
+      DO
+         read(*,*,iostat=ierr) choix_1
+         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
+      ENDDO
+
+c     Open start_archive
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start_archive.nc'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+        tab0 = 50 
+        Lmodif = 1
+
+c     OR open start and startfi files
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      else
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start.nc and ./startfi.nc'
+        write(*,*)
+        fichnom = 'start.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+        fichnom = 'startfi.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+
+        tab0 = 0 
+        Lmodif = 0
+
+      endif
+
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+
+! Initialize global tracer indexes (stored in tracer.h)
+! ... this has to be done before phyetat0
+      call initracer(ngridmx,nqtot,tname)
+
+! Take care of arrays in common modules
+      ! ALLOCATE ARRAYS in surfdat_h (if not already done, e.g. when using start_archive)
+      IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(ngridmx))
+      IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(ngridmx))
+      IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(ngridmx))
+      IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(ngridmx))
+      IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(ngridmx))
+      IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(ngridmx))
+      IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(ngridmx))
+      ! ALLOCATE ARRAYS in comsoil_h (if not already done)
+      IF (.not.ALLOCATED(layer))
+     . ALLOCATE(layer(nsoilmx))
+      IF (.not.ALLOCATED(mlayer))
+     . ALLOCATE(mlayer(0:nsoilmx-1))
+      IF (.not.ALLOCATED(inertiedat))
+     . ALLOCATE(inertiedat(ngridmx,nsoilmx))
+      ! ALLOCATE ARRAYS IN comgeomfi_h (done in inifis usually)
+      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(ngridmx))
+      IF (.not. ALLOCATED(long)) ALLOCATE(long(ngridmx))
+      IF (.not. ALLOCATED(area)) ALLOCATE(area(ngridmx))
+
+c-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run (pour la dynamique)
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+
+        write(*,*) 'reading tab_cntrl START_ARCHIVE'
+c
+        ierr = NF_INQ_VARID (nid, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+c
+      else if (choix_1.eq.1) then
+
+        write(*,*) 'reading tab_cntrl START'
+c
+        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
+#endif
+c
+        write(*,*) 'reading tab_cntrl STARTFI'
+c
+        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
+#else
+        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
+#endif
+c
+        do i=1,50
+          tab_cntrl(i+50)=tab_cntrl_bis(i)
+        enddo
+        write(*,*) 'printing tab_cntrl', tab_cntrl
+        do i=1,100
+          write(*,*) i,tab_cntrl(i)
+        enddo
+	
+        ! Lmodif set to 0 to disable modifications possibility in phyeta0                           
+        write(*,*) 'Reading file START'
+        fichnom = 'start.nc'
+        CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,time)
+
+        write(*,*) 'Reading file STARTFI'
+        fichnom = 'startfi.nc'
+        CALL phyetat0 (ngridmx,fichnom,tab0,Lmodif,nsoilmx,nqtot,
+     .        day_ini,time,
+     .        tsurf,tsoil,emis,q2,qsurf,   !) ! temporary modif by RDW
+     .        cloudfrac,totalfrac,hice,rnat,pctsrf_sic,tslab,tsea_ice,
+     .        sea_ice)
+
+        ! copy albedo and soil thermal inertia on (local) physics grid
+        do i=1,ngridmx
+          albfi(i) = albedodat(i)
+	  do j=1,nsoilmx
+           ithfi(i,j) = inertiedat(i,j)
+	  enddo
+        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
+        ! be needed later on if reinitializing soil thermal inertia
+          surfithfi(i)=ithfi(i,1)
+        enddo
+        ! also copy albedo and soil thermal inertia on (local) dynamics grid
+        ! so that options below can manipulate either (but must then ensure
+        ! to correctly recast things on physics grid)
+        call gr_fi_dyn(1,ngridmx,iip1,jjp1,albfi,alb)
+        call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+        call gr_fi_dyn(1,ngridmx,iip1,jjp1,surfithfi,surfith)
+      
+      endif
+c-----------------------------------------------------------------------
+c		Initialisation des constantes dynamique
+c-----------------------------------------------------------------------
+
+      kappa = tab_cntrl(9) 
+      etot0 = tab_cntrl(12)
+      ptot0 = tab_cntrl(13)
+      ztot0 = tab_cntrl(14)
+      stot0 = tab_cntrl(15)
+      ang0 = tab_cntrl(16)
+      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
+      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
+
+      ! for vertical coordinate
+      preff=tab_cntrl(18) ! reference surface pressure
+      pa=tab_cntrl(17)  ! reference pressure at which coord is purely pressure
+      !NB: in start_archive files tab_cntrl(17)=tab_cntrl(18)=0
+      write(*,*) "Newstart: preff=",preff," pa=",pa
+      yes=' '
+      do while ((yes.ne.'y').and.(yes.ne.'n'))
+        write(*,*) "Change the values of preff and pa? (y/n)"
+        read(*,fmt='(a)') yes
+      end do
+      if (yes.eq.'y') then
+        write(*,*)"New value of reference surface pressure preff?"
+        write(*,*)"   (for Mars, typically preff=610)"
+        read(*,*) preff
+        write(*,*)"New value of reference pressure pa for purely"
+        write(*,*)"pressure levels (for hybrid coordinates)?"
+        write(*,*)"   (for Mars, typically pa=20)"
+        read(*,*) pa
+      endif
+c-----------------------------------------------------------------------
+c   Lecture du tab_cntrl et initialisation des constantes physiques
+c  - pour start:  Lmodif = 0 => pas de modifications possibles
+c                  (modif dans le tabfi de readfi + loin)
+c  - pour start_archive:  Lmodif = 1 => modifications possibles
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+         ! tabfi requires that input file be first opened by open_startphy(fichnom)
+         fichnom = 'start_archive.nc'
+         call open_startphy(fichnom)
+         call tabfi (ngridmx,nid,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
+      else if (choix_1.eq.1) then
+         fichnom = 'startfi.nc'
+         call open_startphy(fichnom)
+         Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
+         call tabfi (ngridmx,nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
+      endif
+
+      rad = p_rad
+      omeg = p_omeg
+      g = p_g
+      cpp = p_cpp
+      mugaz = p_mugaz
+      daysec = p_daysec
+
+      kappa = 8.314*1000./(p_mugaz*p_cpp) ! added by RDW
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+! Load parameters from run.def file
+      CALL defrun_new( 99, .TRUE. )
+      CALL iniconst 
+      CALL inigeom
+      idum=-1
+      idum=0
+
+c Initialisation coordonnees /aires
+c -------------------------------
+! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
+!       rlatu() and rlonv() are given in radians
+      latfi(1)=rlatu(1)
+      lonfi(1)=0.
+      DO j=2,jjm
+         DO i=1,iim
+            latfi((j-2)*iim+1+i)=rlatu(j)
+            lonfi((j-2)*iim+1+i)=rlonv(i)
+         ENDDO
+      ENDDO
+      latfi(ngridmx)=rlatu(jjp1)
+      lonfi(ngridmx)=0.
+       
+      ! build airefi(), mesh area on physics grid
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+      ! Poles are single points on physics grid
+      airefi(1)=airefi(1)*iim
+      airefi(ngridmx)=airefi(ngridmx)*iim
+
+! also initialize various physics flags/settings which might be needed
+!    (for instance initracer needs to know about some flags, and/or
+!      'datafile' path may be changed by user)
+      call inifis(ngridmx,llm,nqtot,day_ini,daysec,dtphys,
+     &                latfi,lonfi,airefi,rad,g,r,cpp)
+
+c=======================================================================
+c   lecture topographie, albedo, inertie thermique, relief sous-maille
+c=======================================================================
+
+      if (choix_1.eq.0) then  ! for start_archive files, 
+                              ! where an external "surface.nc" file is needed
+
+c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
+c       write(*,*)
+c       write(*,*) 'choix du relief (mola,pla)'
+c       write(*,*) '(Topographie MGS MOLA, plat)'
+c       read(*,fmt='(a3)') relief
+        relief="mola"
+c     enddo
+
+!    First get the correct value of datadir, if not already done:
+        ! default 'datadir' is set in "datafile_mod"
+        call getin("datadir",datadir)
+        write(*,*) 'Available surface data files are:'
+        filestring='ls '//trim(datadir)//' | grep .nc'
+        call system(filestring)
+
+        write(*,*) ''
+        write(*,*) 'Please choose the relevant file',
+     &  ' (e.g. "surface_mars.nc")'
+        write(*,*) ' or "none" to not use any (and set planetary'
+        write(*,*) '  albedo and surface thermal inertia)'
+        read(*,fmt='(a50)') surfacefile
+
+        if (surfacefile.ne."none") then
+
+          CALL datareadnc(relief,surfacefile,phis,alb,surfith,
+     &          zmeaS,zstdS,zsigS,zgamS,ztheS)
+        else
+        ! specific case when not using a "surface.nc" file
+          phis(:,:)=0
+          zmeaS(:,:)=0
+          zstdS(:,:)=0
+          zsigS(:,:)=0
+          zgamS(:,:)=0
+          ztheS(:,:)=0
+          
+          write(*,*) "Enter value of albedo of the bare ground:"
+          read(*,*) alb(1,1)
+          alb(:,:)=alb(1,1)
+          
+          write(*,*) "Enter value of thermal inertia of soil:"
+          read(*,*) surfith(1,1)
+          surfith(:,:)=surfith(1,1)
+        
+        endif ! of if (surfacefile.ne."none")
+
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
+
+      endif ! of if (choix_1.eq.0)
+
+
+c=======================================================================
+c  Lecture des fichiers (start ou start_archive)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Reading file START_ARCHIVE'
+        CALL lect_start_archive(date,tsurf,tsoil,emis,q2,
+     &   t,ucov,vcov,ps,teta,phisold_newgrid,q,qsurf,
+     &   surfith,nid,
+     &   rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+        write(*,*) "OK, read start_archive file"
+	! copy soil thermal inertia
+	ithfi(:,:)=inertiedat(:,:)
+	
+        ierr= NF_CLOSE(nid)
+
+      else if (choix_1.eq.1) then 
+         !do nothing, start and startfi have already been read
+      else 
+        CALL exit(1)
+      endif
+
+      dtvr   = daysec/FLOAT(day_step)
+      dtphys   = dtvr * FLOAT(iphysiq)
+
+c=======================================================================
+c 
+c=======================================================================
+
+      do ! infinite loop on list of changes
+
+      write(*,*)
+      write(*,*)
+      write(*,*) 'List of possible changes :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*)
+      write(*,*) 'flat : no topography ("aquaplanet")'
+      write(*,*) 'nuketharsis : no Tharsis bulge'
+      write(*,*) 'bilball : uniform albedo and thermal inertia'
+      write(*,*) 'coldspole : cold subsurface and high albedo at S.pole'
+      write(*,*) 'qname : change tracer name'
+      write(*,*) 't=profile  : read temperature profile in profile.in'
+      write(*,*) 'q=0 : ALL tracer =zero'
+      write(*,*) 'q=x : give a specific uniform value to one tracer'
+      write(*,*) 'q=profile    : specify a profile for a tracer'
+!      write(*,*) 'ini_q : tracers initialisation for chemistry, water an
+!     $d ice   '
+!      write(*,*) 'ini_q-H2O : tracers initialisation for chemistry and 
+!     $ice '
+!      write(*,*) 'ini_q-iceH2O : tracers initialisation for chemistry on
+!     $ly '
+      write(*,*) 'noglacier : Remove tropical H2O ice if |lat|<45'
+      write(*,*) 'watercapn : H20 ice on permanent N polar cap '
+      write(*,*) 'watercaps : H20 ice on permanent S polar cap '
+      write(*,*) 'noacglac  : H2O ice across Noachis Terra'
+      write(*,*) 'oborealis : H2O ice across Vastitas Borealis'
+      write(*,*) 'iceball   : Thick ice layer all over surface'
+      write(*,*) 'wetstart  : start with a wet atmosphere'
+      write(*,*) 'isotherm  : Isothermal Temperatures, wind set to zero'
+      write(*,*) 'radequi   : Earth-like radiative equilibrium temperature
+     $ profile (lat-alt) and winds set to zero'
+      write(*,*) 'coldstart : Start X K above the CO2 frost point and 
+     $set wind to zero (assumes 100% CO2)'
+      write(*,*) 'co2ice=0 : remove CO2 polar cap'
+      write(*,*) 'ptot : change total pressure'
+      write(*,*) 'emis : change surface emissivity'
+      write(*,*) 'therm_ini_s : Set soil thermal inertia to reference sur
+     &face values'
+      write(*,*) 'slab_ocean_0 : initialisation of slab 
+     $ocean variables'
+
+        write(*,*)
+        write(*,*) 'Change to perform ?'
+        write(*,*) '   (enter keyword or return to end)'
+        write(*,*)
+
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ')then
+         exit ! exit loop on changes
+        endif
+
+        write(*,*)
+        write(*,*) trim(modif) , ' : '
+
+c       'flat : no topography ("aquaplanet")'
+c       -------------------------------------
+        if (trim(modif) .eq. 'flat') then
+c         set topo to zero 
+          z_reel(1:iip1,1:jjp1)=0
+          phis(1:iip1,1:jjp1)=g*z_reel(1:iip1,1:jjp1)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+          write(*,*) 'topography set to zero.'
+          write(*,*) 'WARNING : the subgrid topography parameters',
+     &    ' were not set to zero ! => set calllott to F'                    
+
+c        Choice of surface pressure
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to choose homogeneous surface',
+     &                 'pressure (y) or let newstart interpolate ',
+     &                 ' the previous field  (n)?'
+             read(*,fmt='(a)') yes
+         end do
+         if (yes.eq.'y') then
+           flagps0=.true.
+           write(*,*) 'New value for ps (Pa) ?'
+ 201       read(*,*,iostat=ierr) patm
+            if(ierr.ne.0) goto 201
+             write(*,*)
+             write(*,*) ' new ps everywhere (Pa) = ', patm
+             write(*,*)
+             do j=1,jjp1
+               do i=1,iip1
+                 ps(i,j)=patm
+               enddo
+             enddo
+         end if
+
+c       'nuketharsis : no tharsis bulge for Early Mars'
+c       ---------------------------------------------
+        else if (trim(modif) .eq. 'nuketharsis') then
+
+           DO j=1,jjp1        
+              DO i=1,iim
+                 ig=1+(j-2)*iim +i
+                 if(j.eq.1) ig=1
+                 if(j.eq.jjp1) ig=ngridmx
+
+                 fact1=(((rlonv(i)*180./pi)+100)**2 + 
+     &                (rlatu(j)*180./pi)**2)/65**2 
+                 fact2=exp( -fact1**2.5 )
+
+                 phis(i,j) = phis(i,j) - (phis(i,j)+4000.*g)*fact2
+
+!                 if(phis(i,j).gt.2500.*g)then
+!                    if(rlatu(j)*180./pi.gt.-80.)then ! avoid chopping south polar cap
+!                       phis(i,j)=2500.*g
+!                    endif
+!                 endif
+
+              ENDDO
+           ENDDO
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+
+c       bilball : uniform albedo, thermal inertia
+c       -----------------------------------------
+        else if (trim(modif) .eq. 'bilball') then
+          write(*,*) 'constante albedo and iner.therm:'
+          write(*,*) 'New value for albedo (ex: 0.25) ?'
+ 101      read(*,*,iostat=ierr) alb_bb
+          if(ierr.ne.0) goto 101
+          write(*,*)
+          write(*,*) ' uniform albedo (new value):',alb_bb
+          write(*,*)
+
+          write(*,*) 'New value for thermal inertia (eg: 247) ?'
+ 102      read(*,*,iostat=ierr) ith_bb
+          if(ierr.ne.0) goto 102
+          write(*,*) 'uniform thermal inertia (new value):',ith_bb
+          DO j=1,jjp1
+             DO i=1,iip1
+                alb(i,j) = alb_bb	! albedo
+		do isoil=1,nsoilmx
+                  ith(i,j,isoil) = ith_bb	! thermal inertia
+		enddo
+             END DO
+          END DO
+!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+c       coldspole : sous-sol de la calotte sud toujours froid
+c       -----------------------------------------------------
+        else if (trim(modif) .eq. 'coldspole') then
+          write(*,*)'new value for the subsurface temperature',
+     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
+ 103      read(*,*,iostat=ierr) tsud
+          if(ierr.ne.0) goto 103
+          write(*,*)
+          write(*,*) ' new value of the subsurface temperature:',tsud
+c         nouvelle temperature sous la calotte permanente
+          do l=2,nsoilmx
+               tsoil(ngridmx,l) =  tsud
+          end do
+
+
+          write(*,*)'new value for the albedo',
+     &   'of the permanent southern polar cap ? (eg: 0.75)'
+ 104      read(*,*,iostat=ierr) albsud
+          if(ierr.ne.0) goto 104
+          write(*,*)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         Option 1:  only the albedo of the pole is modified :    
+          albfi(ngridmx)=albsud
+          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
+     &    albfi(ngridmx)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
+c           DO j=1,jjp1
+c             DO i=1,iip1
+c                ig=1+(j-2)*iim +i
+c                if(j.eq.1) ig=1
+c                if(j.eq.jjp1) ig=ngridmx
+c                if ((rlatu(j)*180./pi.lt.-84.).and.
+c     &            (rlatu(j)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.lt.0.))         then
+cc    albedo de la calotte permanente fixe a albsud
+c                   alb(i,j)=albsud
+c                   write(*,*) 'lat=',rlatu(j)*180./pi,
+c     &                      ' lon=',rlonv(i)*180./pi
+cc     fin de la condition sur les limites de la calotte permanente
+c                end if
+c             ENDDO
+c          ENDDO
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+
+c       ptot : Modification of the total pressure: ice + current atmosphere 
+c       -------------------------------------------------------------------
+        else if (trim(modif).eq.'ptot') then
+
+          ! check if we have a co2_ice surface tracer:
+          if (igcm_co2_ice.eq.0) then
+            write(*,*) " No surface CO2 ice !"
+            write(*,*) " only atmospheric pressure will be considered!"
+          endif
+c         calcul de la pression totale glace + atm actuelle
+          patm=0.
+          airetot=0.
+          pcap=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+                patm = patm + ps(i,j)*aire(i,j)
+                airetot= airetot + aire(i,j)
+                if (igcm_co2_ice.ne.0) then
+                  !pcap = pcap + aire(i,j)*co2ice(ig)*g
+                  pcap = pcap + aire(i,j)*qsurf(ig,igcm_co2_ice)*g
+                endif
+             ENDDO
+          ENDDO
+          ptoto = pcap + patm
+
+          print*,'Current total pressure at surface (co2 ice + atm) ',
+     &       ptoto/airetot
+
+          print*,'new value?'
+          read(*,*) ptotn
+          ptotn=ptotn*airetot
+          patmn=ptotn-pcap
+          print*,'ptoto,patm,ptotn,patmn'
+          print*,ptoto,patm,ptotn,patmn
+          print*,'Mult. factor for pressure (atm only)', patmn/patm
+          do j=1,jjp1
+             do i=1,iip1
+                ps(i,j)=ps(i,j)*patmn/patm
+             enddo
+          enddo
+
+
+
+c        Correction pour la conservation des traceurs
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to conserve tracer total mass (y)',
+     &              ' or tracer mixing ratio (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'OK : conservation of tracer total mass'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+          else
+            write(*,*) 'OK : conservation of tracer mixing ratio'
+          end if
+
+c        Correction pour la pression au niveau de la mer
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish fix pressure at sea level (y)',
+     &              ' or not (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'Value?'
+		read(*,*,iostat=ierr) psea
+             DO i=1,iip1
+               DO j=1,jjp1
+                    ps(i,j)=psea
+
+                  ENDDO
+               ENDDO
+		write(*,*) 'psea=',psea
+          else
+            write(*,*) 'no'
+          end if
+
+
+c       emis : change surface emissivity (added by RW)
+c       ----------------------------------------------
+        else if (trim(modif).eq.'emis') then
+
+           print*,'new value?'
+           read(*,*) emisread
+
+           do i=1,ngridmx
+              emis(i)=emisread
+           enddo
+
+c       qname : change tracer name
+c       --------------------------
+        else if (trim(modif).eq.'qname') then
+         yes='y'
+         do while (yes.eq.'y')
+          write(*,*) 'Which tracer name do you want to change ?'
+          do iq=1,nqtot
+            write(*,'(i3,a3,a20)')iq,' : ',trim(tname(iq))
+          enddo
+          write(*,'(a35,i3)')
+     &            '(enter tracer number; between 1 and ',nqtot
+          write(*,*)' or any other value to quit this option)'
+          read(*,*) iq
+          if ((iq.ge.1).and.(iq.le.nqtot)) then
+            write(*,*)'Change tracer name ',trim(tname(iq)),' to ?'
+            read(*,*) txt
+            tname(iq)=txt
+            write(*,*)'Do you want to change another tracer name (y/n)?'
+            read(*,'(a)') yes 
+          else
+! inapropiate value of iq; quit this option
+            yes='n'
+          endif ! of if ((iq.ge.1).and.(iq.le.nqtot))
+         enddo ! of do while (yes.ne.'y')
+
+c       q=0 : set tracers to zero
+c       -------------------------
+        else if (trim(modif).eq.'q=0') then
+c          mise a 0 des q (traceurs)
+          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=1.e-30
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+
+c          set surface tracers to zero
+           DO iq =1, nqtot
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+
+c       q=x : initialise tracer manually 
+c       --------------------------------
+        else if (trim(modif).eq.'q=x') then
+             write(*,*) 'Which tracer do you want to modify ?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             write(*,*)'mixing ratio of tracer ',trim(tname(iq)),
+     &                 ' ? (kg/kg)'
+             read(*,*) val
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=val
+                  ENDDO
+               ENDDO
+             ENDDO
+             write(*,*) 'SURFACE value of tracer ',trim(tname(iq)),
+     &                   ' ? (kg/m2)'
+             read(*,*) val
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=val
+             ENDDO
+
+c       t=profile : initialize temperature with a given profile
+c       -------------------------------------------------------
+        else if (trim(modif) .eq. 't=profile') then
+             write(*,*) 'Temperature profile from ASCII file'
+             write(*,*) "'profile.in' e.g. 1D output"
+             write(*,*) "(one value per line in file; starting with"
+             write(*,*) "surface value, the 1st atmospheric layer"
+             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
+             txt="profile.in"
+             open(33,file=trim(txt),status='old',form='formatted',
+     &            iostat=ierr)
+             if (ierr.eq.0) then
+               ! OK, found file 'profile_...', load the profile
+               do l=1,llm+1
+                 read(33,*,iostat=ierr) profile(l)
+                 write(*,*) profile(l)
+                 if (ierr.ne.0) then ! something went wrong
+                   exit ! quit loop
+                 endif
+               enddo
+               if (ierr.eq.0) then
+                 tsurf(1:ngridmx)=profile(1)
+                 tsoil(1:ngridmx,1:nsoilmx)=profile(1)
+                 do l=1,llm
+                   Tset(1:iip1,1:jjp1,l)=profile(l+1)
+                   flagtset=.true.
+                 enddo
+                 ucov(1:iip1,1:jjp1,1:llm)=0.
+                 vcov(1:iip1,1:jjm,1:llm)=0.
+                 q2(1:ngridmx,1:nlayermx+1)=0.
+               else
+                 write(*,*)'problem reading file ',trim(txt),' !'
+                 write(*,*)'No modifications to temperature'
+               endif
+             else
+               write(*,*)'Could not find file ',trim(txt),' !'
+               write(*,*)'No modifications to temperature'
+             endif
+
+c       q=profile : initialize tracer with a given profile
+c       --------------------------------------------------
+        else if (trim(modif) .eq. 'q=profile') then
+             write(*,*) 'Tracer profile will be sought in ASCII file'
+             write(*,*) "'profile_tracer' where 'tracer' is tracer name"
+             write(*,*) "(one value per line in file; starting with"
+             write(*,*) "surface value, the 1st atmospheric layer"
+             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
+             write(*,*) 'Which tracer do you want to set?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             if ((iq.lt.1).or.(iq.gt.nqtot)) then
+               ! wrong value for iq, go back to menu
+               write(*,*) "wrong input value:",iq
+               cycle
+             endif
+             ! look for input file 'profile_tracer'
+             txt="profile_"//trim(tname(iq))
+             open(41,file=trim(txt),status='old',form='formatted',
+     &            iostat=ierr)
+             if (ierr.eq.0) then
+               ! OK, found file 'profile_...', load the profile
+               do l=1,llm+1
+                 read(41,*,iostat=ierr) profile(l)
+                 if (ierr.ne.0) then ! something went wrong
+                   exit ! quit loop
+                 endif
+               enddo
+               if (ierr.eq.0) then
+                 ! initialize tracer values
+                 qsurf(:,iq)=profile(1)
+                 do l=1,llm
+                   q(:,:,l,iq)=profile(l+1)
+                 enddo
+                 write(*,*)'OK, tracer ',trim(tname(iq)),' initialized '
+     &                    ,'using values from file ',trim(txt)
+               else
+                 write(*,*)'problem reading file ',trim(txt),' !'
+                 write(*,*)'No modifications to tracer ',trim(tname(iq))
+               endif
+             else
+               write(*,*)'Could not find file ',trim(txt),' !'
+               write(*,*)'No modifications to tracer ',trim(tname(iq))
+             endif
+             
+
+c      wetstart : wet atmosphere with a north to south gradient
+c      --------------------------------------------------------
+       else if (trim(modif) .eq. 'wetstart') then
+        ! check that there is indeed a water vapor tracer
+        if (igcm_h2o_vap.eq.0) then
+          write(*,*) "No water vapour tracer! Can't use this option"
+          stop
+        endif
+          DO l=1,llm
+            DO j=1,jjp1
+              DO i=1,iip1
+                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
+              ENDDO
+            ENDDO
+          ENDDO
+
+         write(*,*) 'Water mass mixing ratio at north pole='
+     *               ,q(1,1,1,igcm_h2o_vap)
+         write(*,*) '---------------------------south pole='
+     *               ,q(1,jjp1,1,igcm_h2o_vap)
+
+c      noglacier : remove tropical water ice (to initialize high res sim)
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'noglacier') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              write(*,*) 'OK: remove surface ice for |lat|<45'
+              if (abs(rlatu(j)*180./pi).lt.45.) then
+                   qsurf(ig,igcm_h2o_ice)=0.
+              end if
+           end do
+
+
+c      watercapn : H20 ice on permanent northern cap
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'watercapn') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+
+           DO j=1,jjp1        
+              DO i=1,iim
+                 ig=1+(j-2)*iim +i
+                 if(j.eq.1) ig=1
+                 if(j.eq.jjp1) ig=ngridmx
+
+                 if (rlatu(j)*180./pi.gt.80.) then
+                    qsurf(ig,igcm_h2o_ice)=3.4e3
+                    !do isoil=1,nsoilmx
+                    !   ith(i,j,isoil) = 18000. ! thermal inertia
+                    !enddo
+                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+     &                   rlatv(j-1)*180./pi
+                 end if
+              ENDDO
+           ENDDO
+           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+c$$$           do ig=1,ngridmx
+c$$$             j=(ig-2)/iim +2
+c$$$              if(ig.eq.1) j=1
+c$$$              if (rlatu(j)*180./pi.gt.80.) then
+c$$$
+c$$$                   qsurf(ig,igcm_h2o_ice)=1.e5
+c$$$                   qsurf(ig,igcm_h2o_vap)=0.0!1.e5
+c$$$
+c$$$                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
+c$$$     &              qsurf(ig,igcm_h2o_ice)
+c$$$
+c$$$                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+c$$$     &              rlatv(j)*180./pi
+c$$$                end if
+c$$$           enddo
+
+c      watercaps : H20 ice on permanent southern cap
+c      -------------------------------------------------
+        else if (trim(modif) .eq. 'watercaps') then
+           if (igcm_h2o_ice.eq.0) then
+              write(*,*) "No water ice tracer! Can't use this option"
+              stop
+           endif
+
+           DO j=1,jjp1        
+              DO i=1,iim
+                 ig=1+(j-2)*iim +i
+                 if(j.eq.1) ig=1
+                 if(j.eq.jjp1) ig=ngridmx
+
+                 if (rlatu(j)*180./pi.lt.-80.) then
+                    qsurf(ig,igcm_h2o_ice)=3.4e3
+                    !do isoil=1,nsoilmx
+                    !   ith(i,j,isoil) = 18000. ! thermal inertia
+                    !enddo
+                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+     &                   rlatv(j-1)*180./pi
+                 end if
+              ENDDO
+           ENDDO
+           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+c$$$           do ig=1,ngridmx
+c$$$               j=(ig-2)/iim +2
+c$$$               if(ig.eq.1) j=1
+c$$$               if (rlatu(j)*180./pi.lt.-80.) then
+c$$$                  qsurf(ig,igcm_h2o_ice)=1.e5
+c$$$                  qsurf(ig,igcm_h2o_vap)=0.0 !1.e5
+c$$$
+c$$$                  write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
+c$$$     &                 qsurf(ig,igcm_h2o_ice)
+c$$$                  write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+c$$$     &                 rlatv(j-1)*180./pi
+c$$$               end if
+c$$$           enddo
+
+
+c       noacglac : H2O ice across highest terrain
+c       --------------------------------------------
+        else if (trim(modif) .eq. 'noacglac') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                if(phis(i,j).gt.1000.*g)then
+                    alb(i,j) = 0.5 ! snow value
+                    do isoil=1,nsoilmx
+                       ith(i,j,isoil) = 18000. ! thermal inertia
+                       ! this leads to rnat set to 'ocean' in physiq.F90
+                       ! actually no, because it is soil not surface
+                    enddo
+                endif
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+
+
+c       oborealis : H2O oceans across Vastitas Borealis
+c       -----------------------------------------------
+        else if (trim(modif) .eq. 'oborealis') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                if(phis(i,j).lt.-4000.*g)then
+!                if( (phis(i,j).lt.-4000.*g)
+!     &               .and. (rlatu(j)*180./pi.lt.0.) )then ! south hemisphere only
+!                    phis(i,j)=-8000.0*g ! proper ocean
+                    phis(i,j)=-4000.0*g ! scanty ocean
+
+                    alb(i,j) = 0.07 ! oceanic value
+                    do isoil=1,nsoilmx
+                       ith(i,j,isoil) = 18000. ! thermal inertia
+                       ! this leads to rnat set to 'ocean' in physiq.F90
+                       ! actually no, because it is soil not surface
+                    enddo
+                endif
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+c       iborealis : H2O ice in Northern plains
+c       --------------------------------------
+        else if (trim(modif) .eq. 'iborealis') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                if(phis(i,j).lt.-4000.*g)then
+                   !qsurf(ig,igcm_h2o_ice)=1.e3
+                   qsurf(ig,igcm_h2o_ice)=241.4 ! to make total 33 kg m^-2
+                endif
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+
+c       oceanball : H2O liquid everywhere
+c       ----------------------------
+        else if (trim(modif) .eq. 'oceanball') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                qsurf(ig,igcm_h2o_vap)=0.0    ! for ocean, this is infinite source
+                qsurf(ig,igcm_h2o_ice)=0.0
+                alb(i,j) = 0.07 ! ocean value
+
+                do isoil=1,nsoilmx
+                   ith(i,j,isoil) = 18000. ! thermal inertia
+                   !ith(i,j,isoil) = 50. ! extremely low for test
+                   ! this leads to rnat set to 'ocean' in physiq.F90
+                enddo
+
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+c       iceball : H2O ice everywhere
+c       ----------------------------
+        else if (trim(modif) .eq. 'iceball') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                qsurf(ig,igcm_h2o_vap)=-50.    ! for ocean, this is infinite source
+                qsurf(ig,igcm_h2o_ice)=50.     ! == to 0.05 m of oceanic ice
+                alb(i,j) = 0.6 ! ice albedo value
+
+                do isoil=1,nsoilmx
+                   !ith(i,j,isoil) = 18000. ! thermal inertia
+                   ! this leads to rnat set to 'ocean' in physiq.F90
+                enddo
+
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+c       isotherm : Isothermal temperatures and no winds
+c       -----------------------------------------------
+        else if (trim(modif) .eq. 'isotherm') then
+
+          write(*,*)'Isothermal temperature of the atmosphere, 
+     &           surface and subsurface'
+          write(*,*) 'Value of this temperature ? :'
+ 203      read(*,*,iostat=ierr) Tiso
+          if(ierr.ne.0) goto 203
+
+          tsurf(1:ngridmx)=Tiso
+          
+          tsoil(1:ngridmx,1:nsoilmx)=Tiso
+          
+          Tset(1:iip1,1:jjp1,1:llm)=Tiso
+          flagtset=.true.
+          
+          ucov(1:iip1,1:jjp1,1:llm)=0
+          vcov(1:iip1,1:jjm,1:llm)=0
+          q2(1:ngridmx,1:nlayermx+1)=0
+
+c       radequi : Radiative equilibrium profile of temperatures and no winds
+c       --------------------------------------------------------------------
+        else if (trim(modif) .eq. 'radequi') then
+
+          write(*,*)'radiative equilibrium temperature profile'       
+
+          do ig=1, ngridmx
+             teque= 335.0-60.0*sin(latfi(ig))*sin(latfi(ig))-
+     &            10.0*cos(latfi(ig))*cos(latfi(ig))
+             tsurf(ig) = MAX(220.0,teque)
+          end do
+          do l=2,nsoilmx
+             do ig=1, ngridmx
+                tsoil(ig,l) = tsurf(ig)
+             end do
+          end do
+          DO j=1,jjp1
+             DO i=1,iim
+                Do l=1,llm
+                   teque=335.-60.0*sin(rlatu(j))*sin(rlatu(j))-
+     &                  10.0*cos(rlatu(j))*cos(rlatu(j))
+                   Tset(i,j,l)=MAX(220.0,teque)
+                end do
+             end do
+          end do
+          flagtset=.true.
+          ucov(1:iip1,1:jjp1,1:llm)=0
+          vcov(1:iip1,1:jjm,1:llm)=0
+          q2(1:ngridmx,1:nlayermx+1)=0
+
+c       coldstart : T set 1K above CO2 frost point and no winds
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'coldstart') then
+
+          write(*,*)'set temperature of the atmosphere,' 
+     &,'surface and subsurface how many degrees above CO2 frost point?'
+ 204      read(*,*,iostat=ierr) Tabove
+          if(ierr.ne.0) goto 204
+
+            DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+            tsurf(ig) = (-3167.8)/(log(.01*ps(i,j))-23.23)+Tabove
+             END DO
+            END DO
+          do l=1,nsoilmx
+            do ig=1, ngridmx
+              tsoil(ig,l) = tsurf(ig)
+            end do
+          end do
+          DO j=1,jjp1
+           DO i=1,iim
+            Do l=1,llm
+               pp = aps(l) +bps(l)*ps(i,j) 
+               Tset(i,j,l)=(-3167.8)/(log(.01*pp)-23.23)+Tabove
+            end do
+           end do
+          end do
+
+          flagtset=.true.
+          ucov(1:iip1,1:jjp1,1:llm)=0
+          vcov(1:iip1,1:jjm,1:llm)=0
+          q2(1:ngridmx,1:nlayermx+1)=0
+
+
+c       co2ice=0 : remove CO2 polar ice caps'
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'co2ice=0') then
+         ! check that there is indeed a co2_ice tracer ...
+          if (igcm_co2_ice.ne.0) then
+           do ig=1,ngridmx
+              !co2ice(ig)=0
+              qsurf(ig,igcm_co2_ice)=0
+              emis(ig)=emis(ngridmx/2)
+           end do
+          else
+            write(*,*) "Can't remove CO2 ice!! (no co2_ice tracer)"
+          endif
+        
+!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
+!       ----------------------------------------------------------------------
+
+	else if (trim(modif) .eq. 'therm_ini_s') then
+!          write(*,*)"surfithfi(1):",surfithfi(1)
+	  do isoil=1,nsoilmx
+	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+	  enddo
+          write(*,*)'OK: Soil thermal inertia has been reset to referenc
+     &e surface values'
+!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
+	  ithfi(:,:)=inertiedat(:,:)
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+
+
+c       slab_ocean_initialisation
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'slab_ocean_0') then
+        write(*,*)'OK: initialisation of slab ocean' 
+
+      DO ig=1, ngridmx
+         rnat(ig)=1.
+         tslab(ig,1)=0.
+         tslab(ig,2)=0.
+         tsea_ice(ig)=0.
+         sea_ice(ig)=0.
+         pctsrf_sic(ig)=0.
+         
+         if(ithfi(ig,1).GT.10000.)then
+           rnat(ig)=0.
+           phisfi(ig)=0.
+           tsea_ice(ig)=273.15-1.8
+           tslab(ig,1)=tsurf(ig)
+           tslab(ig,2)=tsurf(ig)!*2./3.+(273.15-1.8)/3.
+          endif
+
+      ENDDO
+          CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,phisfi,phis)
+
+
+
+        else
+          write(*,*) '       Unknown (misspelled?) option!!!'
+        end if ! of if (trim(modif) .eq. '...') elseif ...
+
+
+
+       enddo ! of do ! infinite loop on liste of changes
+
+ 999  continue
+
+ 
+c=======================================================================
+c   Initialisation for cloud fraction and oceanic ice (added by BC 2010)
+c=======================================================================
+      DO ig=1, ngridmx
+         totalfrac(ig)=0.5
+         DO l=1,llm
+            cloudfrac(ig,l)=0.5
+         ENDDO
+! Ehouarn, march 2012: also add some initialisation for hice
+         hice(ig)=0.0
+      ENDDO
+      
+c========================================================
+
+!      DO ig=1,ngridmx
+!         IF(tsurf(ig) .LT. 273.16-1.8) THEN
+!            hice(ig)=(273.16-1.8-tsurf(ig))/(273.16-1.8-240)*1.
+!            hice(ig)=min(hice(ig),1.0)
+!         ENDIF
+!      ENDDO
+
+
+
+
+c=======================================================================
+c   Correct pressure on the new grid (menu 0)
+c=======================================================================
+
+
+      if ((choix_1.eq.0).and.(.not.flagps0)) then
+        r = 1000.*8.31/mugaz
+
+        do j=1,jjp1
+          do i=1,iip1
+             ps(i,j) = ps(i,j) *
+     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
+     .                                  (t(i,j,1) * r))
+          end do
+        end do
+
+c periodicite de ps en longitude
+        do j=1,jjp1
+          ps(1,j) = ps(iip1,j)
+        end do
+      end if
+
+         
+c=======================================================================
+c=======================================================================
+
+c=======================================================================
+c    Initialisation de la physique / ecriture de newstartfi :
+c=======================================================================
+
+
+      CALL inifilr 
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+
+c-----------------------------------------------------------------------
+c   Initialisation  pks:
+c-----------------------------------------------------------------------
+
+      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+! Calcul de la temperature potentielle teta
+
+      if (flagtset) then
+          DO l=1,llm
+             DO j=1,jjp1
+                DO i=1,iim
+                   teta(i,j,l) = Tset(i,j,l) * cpp/pk(i,j,l)
+                ENDDO
+                teta (iip1,j,l)= teta (1,j,l)
+             ENDDO
+          ENDDO
+      else if (choix_1.eq.0) then
+         DO l=1,llm
+            DO j=1,jjp1
+               DO i=1,iim
+                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
+               ENDDO
+               teta (iip1,j,l)= teta (1,j,l)
+            ENDDO
+         ENDDO
+      endif
+
+C Calcul intermediaire
+c
+      if (choix_1.eq.0) then
+         CALL massdair( p3d, masse  )
+c
+         print *,' ALPHAX ',alphax
+
+         DO  l = 1, llm
+           DO  i    = 1, iim
+             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
+             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
+           ENDDO
+             xpn      = SUM(xppn)/apoln
+             xps      = SUM(xpps)/apols
+           DO i   = 1, iip1
+             masse(   i   ,   1     ,  l )   = xpn
+             masse(   i   ,   jjp1  ,  l )   = xps
+           ENDDO
+         ENDDO
+      endif
+      phis(iip1,:) = phis(1,:)
+
+      itau=0
+      if (choix_1.eq.0) then
+         day_ini=int(date)
+      endif
+c
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+
+      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     *                phi,w, pbaru,pbarv,day_ini+time )
+
+          
+      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqtot)
+      CALL dynredem1("restart.nc",0.0,vcov,ucov,teta,q,nqtot,masse,ps) 
+C
+C Ecriture etat initial physique
+C
+
+      call physdem0("restartfi.nc",lonfi,latfi,nsoilmx,ngridmx,llm,
+     &              nqtot,dtphys,real(day_ini),0.0,
+     &              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("restartfi.nc",nsoilmx,ngridmx,llm,nq,
+     &                dtphys,real(day_ini),
+     &                tsurf,tsoil,emis,q2,qsurf,
+     &                cloudfrac,totalfrac,hice,
+     &                rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+c=======================================================================
+c	Formats 
+c=======================================================================
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+
+      write(*,*) "newstart: All is well that ends well."
+
+      end
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newtrelax.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newtrelax.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/newtrelax.F90	(revision 222)
@@ -0,0 +1,132 @@
+subroutine newtrelax(ngrid,mu0,sinlat,popsk,temp,pplay,pplev,dtrad,firstcall) 
+        
+  implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "netcdf.inc"
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Alternative Newtonian radiative transfer scheme.
+!     
+!     Authors
+!     -------
+!     R. Wordsworth (2010)
+!     
+!==================================================================
+ 
+  integer ngrid
+ 
+  ! Input
+  real mu0(ngrid)                    ! cosine of sun incident angle
+  real sinlat(ngrid)                 ! sine of latitude
+  real temp(ngrid,nlayermx)          ! temperature at each layer (K)
+  real pplay(ngrid,nlayermx)         ! pressure at each layer (Pa)
+  real pplev(ngrid,nlayermx+1)       ! pressure at each level (Pa)
+  real popsk(ngrid,nlayermx)         ! pot. T to T converter
+
+  ! Output
+  real dtrad(ngrid,nlayermx) 
+
+  ! Internal
+  real Trelax_V, Trelax_H
+  real,allocatable,dimension(:,:),save :: Trelax
+
+  real T_trop ! relaxation temperature at tropopause (K)
+  real T_surf ! relaxation temperature at surface (K)
+  real dT_EP  ! Equator-Pole relaxation temperature difference (K)
+
+  real sig, f_sig, sig_trop
+  integer l,ig
+  logical firstcall
+
+
+  logical tidallocked
+  parameter (tidallocked = .true.)
+
+  ! Setup relaxation temperature  
+  if(firstcall) then
+
+     ALLOCATE(Trelax(ngrid,nlayermx))
+
+     print*,'-----------------------------------------------------'
+     print*,'| ATTENTION: You are using a Newtonian cooling scheme'
+     print*,'| for the radiative transfer. This means that ALL'
+     print*,'| other physics subroutines must be switched off.'
+     print*,'-----------------------------------------------------'
+
+     if(tidallocked)then
+        do ig=1,ngrid
+
+           T_surf = 126. + 239.*mu0(ig)
+           T_trop = 140. + 52.*mu0(ig)
+           do l=1,nlayermx
+
+              if(mu0(ig).le.0.0)then ! night side
+                 Trelax(ig,l)=0.0
+              else                   ! day side
+                 Trelax(ig,l) = T_surf*popsk(ig,l)
+                 if (Trelax(ig,l).lt.T_trop) Trelax(ig,l) = T_trop
+              endif
+
+           enddo
+        enddo
+
+     else
+
+        T_trop = 200.
+        T_surf = 288.
+        dT_EP  = 70.
+
+        sig_trop=(T_trop/T_surf)**(1./rcp)
+
+        do l=1,nlayermx
+           do ig=1,ngrid
+
+              ! vertically varying component
+              Trelax_V = T_surf*popsk(ig,l)
+              if (Trelax_V.lt.T_trop) Trelax_V = T_trop
+              
+              ! horizontally varying component
+              sig = pplay(ig,l)/pplev(ig,1)
+              if(sig.ge.sig_trop)then
+                 f_sig=sin((pi/2)*((sig-sig_trop)/(1-sig_trop)))
+              else
+                 f_sig=0.0
+              endif
+              Trelax_H = -f_sig*dT_EP*(sinlat(ig)**2 - 1./3.)
+              
+              Trelax(ig,l) = Trelax_V + Trelax_H            
+           
+           enddo
+        enddo
+
+     endif
+
+     firstcall=.false.
+ 
+  endif
+
+  ! Calculate radiative forcing
+  do l=1,nlayermx
+     do ig=1,ngrid
+        dtrad(ig,l) = -(temp(ig,l) - Trelax(ig,l)) / tau_relax
+        if(temp(ig,l).gt.500.)then ! Trelax(ig,l))then
+           print*,'ig=',ig
+           print*,'l=',l
+           print*,'temp=',temp(ig,l)
+           print*,'Trelax=',Trelax(ig,l)
+        endif
+     enddo
+  enddo
+
+  call writediagfi(ngrid,'Tref','rad forc temp','K',3,Trelax)
+  !call writediagfi(ngrid,'ThetaZ','stellar zenith angle','deg',2,mu0)
+
+  return
+end subroutine newtrelax
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ocean_slab_mod.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ocean_slab_mod.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/ocean_slab_mod.F90	(revision 222)
@@ -0,0 +1,787 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ocean_slab_mod.F90,v 1.3 2008-02-04 16:24:28 fairhead Exp $
+!
+MODULE ocean_slab_mod
+!
+! This module is used for both surface ocean and sea-ice when using the slab ocean,
+! "ocean=slab".
+!
+
+
+      use slab_ice_h
+      use watercommon_h, only: T_h2O_ice_liq
+      use surf_heat_transp_mod
+      implicit none
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+
+
+
+  
+  !LOGICAL, PRIVATE, SAVE  :: ok_slab_sic,ok_slab_heaT_h2O_ice_liqBS
+  !$OMP THREADPRIVATE(ok_slab_sic,ok_slab_heaT_h2O_ice_liqBS)
+  !INTEGER, PRIVATE, SAVE                           :: slab_ekman, slab_cadj
+  !$OMP THREADPRIVATE(slab_ekman,slab_cadj)
+  INTEGER, PRIVATE, SAVE                           :: lmt_pas, julien, idayvrai
+  !$OMP THREADPRIVATE(lmt_pas,julien,idayvrai)
+  INTEGER, PRIVATE, SAVE                           :: cpl_pas
+  !$OMP THREADPRIVATE(cpl_pas)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE   :: tmp_seaice
+  !$OMP THREADPRIVATE(tmp_seaice)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: tmp_tslab_loc
+  !$OMP THREADPRIVATE(tmp_tslab_loc)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE   :: slab_bils
+  !$OMP THREADPRIVATE(slab_bils)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE , SAVE  :: lmt_bils
+  !$OMP THREADPRIVATE(lmt_bils)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tmp_pctsrf_slab
+  !$OMP THREADPRIVATE(tmp_pctsrf_slab)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: tmp_tslab
+  !$OMP THREADPRIVATE(tmp_tslab)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE   :: tmp_radsol
+  !$OMP THREADPRIVATE(tmp_radsol)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: dt_hdiff
+  !$OMP THREADPRIVATE(dt_hdiff)
+  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: dt_ekman
+  !$OMP THREADPRIVATE(dt_ekman)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE   :: tmp_flux_o, tmp_flux_g
+  !$OMP THREADPRIVATE(tmp_flux_o,tmp_flux_g)
+  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE   :: slabh
+  !$OMP THREADPRIVATE(slabh)
+  LOGICAL, PRIVATE, SAVE                           :: check = .FALSE.
+  !$OMP THREADPRIVATE(check)
+
+CONTAINS
+!
+!****************************************************************************************
+!
+  SUBROUTINE ocean_slab_init(ngrid,dtime, tslab_rst, seaice_rst, pctsrf_rst)
+
+      use slab_ice_h
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+
+
+! Input variables
+!****************************************************************************************
+        
+    integer,intent(in) :: ngrid ! number of atmospherci columns
+    REAL, INTENT(IN)                         :: dtime
+! Variables read from restart file
+    REAL, DIMENSION(ngrid,noceanmx), INTENT(IN)  :: tslab_rst         
+    REAL, DIMENSION(ngrid), INTENT(IN)        :: seaice_rst
+    REAL, DIMENSION(ngrid), INTENT(IN) :: pctsrf_rst
+
+
+! Local variables
+!****************************************************************************************
+    INTEGER                :: error
+    CHARACTER (len = 80)   :: abort_message
+    CHARACTER (len = 20)   :: modname = 'ocean_slab_intit'
+
+
+    print*,'************************'
+    print*,'SLAB OCEAN est actif, prenez precautions !'
+    print*,'************************'    
+
+! Lecture des parametres:
+!    CALL getpar('ok_slab_sic',.true.,ok_slab_sic,'glace de mer dans slab')
+!    CALL getpar('slab_ekman',0,slab_ekman,'type transport Ekman pour slab (0=rien)')
+!    CALL getpar('slab_cadj',1,slab_cadj,'type ajustement conv slab 2 couches')
+
+! Allocate variables initialize from restart fields
+      ALLOCATE(tmp_tslab(ngrid,noceanmx), stat = error)
+      IF (error /= 0) THEN
+         abort_message='Pb allocation tmp_tslab'
+         CALL abort_gcm(modname,abort_message,1)
+      ENDIF
+      tmp_tslab(:,:) = tslab_rst(:,:)
+      ALLOCATE(tmp_tslab_loc(ngrid,noceanmx), stat = error)
+      IF (error /= 0) THEN
+         abort_message='Pb allocation tmp_tslab_loc'
+         CALL abort_gcm(modname,abort_message,1)
+      ENDIF
+      tmp_tslab_loc(:,:) = tslab_rst(:,:)
+
+    ALLOCATE(tmp_seaice(ngrid), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation tmp_seaice'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    tmp_seaice(:) = seaice_rst(:)
+
+    ALLOCATE(tmp_pctsrf_slab(ngrid), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation tmp_pctsrf_slab'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    tmp_pctsrf_slab(:) = pctsrf_rst(:)
+    
+! Allocate some other variables internal in module mod_oceanslab
+    ALLOCATE(tmp_radsol(ngrid), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation tmp_radsol'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+
+    ALLOCATE(tmp_flux_o(ngrid), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation tmp_flux_o'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    
+    ALLOCATE(tmp_flux_g(ngrid), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation tmp_flux_g'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+
+! a mettre un slab_bils aussi en force !!!
+    ALLOCATE(slab_bils(ngrid), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation slab_bils'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    slab_bils(:) = 0.0   
+
+    ALLOCATE(dt_hdiff(ngrid,noceanmx), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation dt_hdiff'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    dt_hdiff = 0.0   
+
+    ALLOCATE(dt_ekman(ngrid,noceanmx), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation dt_hdiff'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    dt_ekman = 0.0   
+
+
+    ALLOCATE(lmt_bils(ngrid), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation lmt_bils'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    lmt_bils(:) = 0.0
+
+    ALLOCATE(slabh(noceanmx), stat = error)
+    IF (error /= 0) THEN
+       abort_message='Pb allocation slabh'
+       CALL abort_gcm(modname,abort_message,1)
+    ENDIF
+    slabh(1)=50.
+    IF (noceanmx.GE.2) slabh(2)=150.
+    IF (noceanmx.GE.3) slabh(3)=2800.
+
+
+!       CALL init_masquv
+
+
+
+
+  END SUBROUTINE ocean_slab_init
+!
+!****************************************************************************************
+!
+ 
+!
+!****************************************************************************************
+!
+  SUBROUTINE ocean_slab_ice(dtime, &
+       ngrid, knindex, tsurf, radsol, &
+       precip_snow, snow, evap, &
+       fluxsens,tsurf_new, pctsrf_sic, &
+       taux_slab,tauy_slab,icount)
+
+      use slab_ice_h
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+
+! Input arguments  
+!****************************************************************************************
+    INTEGER, INTENT(IN)                     :: ngrid
+    INTEGER, DIMENSION(ngrid), INTENT(IN) :: knindex
+    REAL, INTENT(IN)                        :: dtime
+    REAL, DIMENSION(ngrid), INTENT(IN)    :: tsurf
+    REAL, DIMENSION(ngrid), INTENT(IN)    :: taux_slab
+    REAL, DIMENSION(ngrid), INTENT(IN)    :: tauy_slab
+    REAL, DIMENSION(ngrid), INTENT(IN)    :: evap, fluxsens
+    REAL, DIMENSION(ngrid), INTENT(IN)    :: precip_snow
+    REAL, DIMENSION(ngrid), INTENT(IN)    :: radsol
+    INTEGER, INTENT(IN)                     :: icount
+
+
+!In/Output arguments
+!****************************************************************************************l
+    REAL, DIMENSION(ngrid), INTENT(INOUT)          :: snow
+
+!    REAL, DIMENSION(ngridmx), INTENT(INOUT)          :: agesno
+
+
+! Output arguments
+!****************************************************************************************
+!    REAL, DIMENSION(ngridmx), INTENT(OUT)            :: alb1_new  ! new albedo in visible SW interval
+!    REAL, DIMENSION(ngridmx), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
+    REAL, DIMENSION(ngrid), INTENT(OUT)            :: tsurf_new     
+    REAL, DIMENSION(ngrid), INTENT(OUT)            :: pctsrf_sic
+
+! Local variables
+!****************************************************************************************
+    INTEGER                                 :: i
+    REAL, DIMENSION(ngrid)                :: cal, beta, dif_grnd, capsol
+    REAL, DIMENSION(ngrid)                :: alb_neig, alb_ice!, tsurf_temp
+    REAL, DIMENSION(ngrid)                :: soilcap, soilflux
+    REAL, DIMENSION(ngrid)                :: zfra
+    REAL                                    :: snow_evap, fonte 
+    REAL, DIMENSION(ngrid,noceanmx)        :: tslab
+    REAL, DIMENSION(ngrid)                :: seaice,tsea_ice ! glace de mer (kg/m2)
+    REAL, DIMENSION(ngrid)                :: pctsrf_new
+
+
+!*****************************************************************************
+
+
+! Initialization of output variables
+!    alb1_new(:) = 0.0
+
+!******************************************************************************
+! F. Codron: 3 cas 
+! -Glace interactive, quantité seaice : T glace suit modèle simple
+! -Pas de glace: T oce peut descendre en dessous de 0°C sans geler
+!*****************************************************************************
+
+       pctsrf_new(:)=tmp_pctsrf_slab(:)
+       tmp_radsol(:)=radsol(:)
+       tmp_flux_o(:)=fluxsens(:)
+
+    DO i = 1, ngrid
+       tsurf_new(i) = tsurf(knindex(i))
+       seaice(i)=tmp_seaice(knindex(i))
+
+
+
+       IF (pctsrf_new(knindex(i)) < EPSFRA) THEN
+          snow(i) = 0.0
+          tsurf_new(i) = T_h2O_ice_liq - 1.8
+          !IF (soil_model) tsoil(i,:) = T_h2O_ice_liq -1.8
+       ENDIF
+    ENDDO
+    tmp_flux_g(:) = 0.0
+    tsea_ice(:)=T_h2O_ice_liq-1.8
+! Calculs flux glace/mer et glace/air
+    IF (ok_slab_sic) THEN   
+!*********************************
+! Calcul de beta, heat capacity
+!********************************* 
+!    CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
+    
+!    IF ((soil_model)) THEN 
+
+!    ELSE 
+!       dif_grnd = 1.0 / tau_gl
+!       cal = RCPD * calice
+!       WHERE (snow > 0.0) cal = RCPD * calsno 
+!    ENDIF
+!    tsurf_temp = tsurf_new
+!    beta = 1.0
+
+
+! **********************************************
+! Evolution avec glace interactive:
+! *************************************
+!      tsurf_new=tsurf_temp
+      DO i = 1, ngrid
+        IF (pctsrf_new(knindex(i)) .GT. epsfra) THEN
+! *************************************
+! + Calcul Flux entre glace et océan 
+! *************************************
+          tmp_flux_g(knindex(i))=(tsurf_new(i)-(T_h2O_ice_liq-1.8)) &
+            * ice_cond*ice_den/seaice(i)
+
+! ****************************************
+! + Calcul nouvelle température de la glace 
+! ****************************************
+          tsurf_new(i)=tsurf_new(i)+2*(radsol(i)+fluxsens(i) &
+             -tmp_flux_g(knindex(i))) &
+             /(ice_cap*seaice(i))*dtime
+
+! ***************************************
+! + Precip and evaporation of snow and ice
+! ***************************************
+! Add precip
+          IF (precip_snow(i).GT.0.) THEN
+            snow(i)=snow(i)+precip_snow(i)*dtime
+          ENDIF
+! Evaporation 
+          snow_evap=0.
+          IF (evap(i).GT.0.) THEN
+            snow_evap = MIN (snow(i) / dtime, evap(i))
+            snow(i) = snow(i) - snow_evap*dtime
+            snow(i) = MAX(0.0, snow(i))
+            seaice(i)=MAX(0.0,seaice(i)-(evap(i)-snow_evap)*dtime)
+          ENDIF
+        
+! *****************************************
+! + Fonte neige & glace par le haut
+! *****************************************
+! Snow melt
+          IF ((snow(i) > epsfra) .AND. (tsurf_new(i) >= T_h2O_ice_liq)) THEN
+            fonte=MIN(MAX((tsurf_new(i)-T_h2O_ice_liq)*seaice(i) &
+                  /2.*ice_cap/ice_lat,0.0),snow(i))
+            snow(i) = MAX(0.,(snow(i)-fonte))
+            tsurf_new(i)=tsurf_new(i)-fonte*2*ice_lat/(seaice(i)*ice_cap)
+          ENDIF
+          snow(i)=MIN(snow(i),3000.)
+! Ice melt
+          IF ((seaice(i) > epsfra) .AND. (tsurf_new(i) >= T_h2O_ice_liq)) THEN       
+             fonte=seaice(i)*ice_cap*(tsurf_new(i)-T_h2O_ice_liq) &
+                  /(2*ice_lat+ice_cap*1.8)
+             CALL icemelt(fonte,pctsrf_new(knindex(i)),seaice(i))
+             tmp_flux_g(knindex(i))=tmp_flux_g(knindex(i)) &
+                                 +fonte*ice_lat/dtime
+             tsurf_new(i)=T_h2O_ice_liq
+          ENDIF  
+          tmp_seaice(knindex(i))=seaice(i)
+        ENDIF!(pctsrf_new(knindex(i)) .GT. epsfra)
+          tsea_ice(knindex(i))=tsurf_new(i)
+
+      ENDDO
+    ENDIF
+! ******************************************
+! CALL interfoce:
+! cumul/calcul nouvelle T_h2O_ice_liqce
+! fonte/formation de glace en dessous
+! ******************************************   
+    tslab = tmp_tslab
+    
+    CALL interfoce_slab(ngrid, dtime, &
+         tmp_radsol, tmp_flux_o, tmp_flux_g, tmp_pctsrf_slab, &
+         tslab, tsea_ice, pctsrf_new,taux_slab,tauy_slab,icount)
+    
+    tmp_pctsrf_slab(:)=pctsrf_new(:)
+!    tmp_pctsrf_slab(:,is_oce)=1.0-tmp_pctsrf_slab(:) &
+!            -tmp_pctsrf_slab(:,is_lic)-tmp_pctsrf_slab(:,is_ter)
+
+    DO i=1, ngrid
+       tmp_tslab(knindex(i),:)=tslab(knindex(i),:)
+       seaice(i)=tmp_seaice(knindex(i))
+       tsurf_new(i)=tsea_ice(knindex(i))
+
+    ENDDO
+
+! ****************************
+! calcul new albedo
+! ****************************
+! Albedo neige
+!    CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))  
+!    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
+! Fraction neige (hauteur critique 45kg/m2~15cm)
+!    zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/45.0))
+! Albedo glace
+!    IF (ok_slab_sicOBS) THEN
+!       alb_ice=0.6
+!    ELSE
+!       alb_ice(1:knon)=alb_ice_max-(alb_ice_max-alb_ice_min) &
+!         *exp(-seaice(1:knon)/h_alb_ice)
+!    ENDIF
+!Albedo final
+!    alb1_new(1 : knon) = alb_neig(1 : knon) *zfra(1:knon) + & 
+!         alb_ice * (1.0-zfra(1:knon))
+!    alb2_new(:) = alb1_new(:)
+
+        
+! ********************************
+! Return the fraction of sea-ice
+! ********************************
+    pctsrf_sic(:) =  tmp_pctsrf_slab(:)
+
+
+  END SUBROUTINE ocean_slab_ice
+
+
+! 
+!***************************************************************************
+!
+  SUBROUTINE interfoce_slab(ngrid, dtime, &
+       radsol, fluxo, fluxg, pctsrf, &
+       tslab, tsea_ice, pctsrf_slab, &
+       taux_slab, tauy_slab,icount)
+!
+! Cette routine calcule la temperature d'un slab ocean, la glace de mer 
+! et les pourcentages de la maille couverte par l'ocean libre et/ou 
+! la glace de mer pour un "slab" ocean de 50m
+!
+! Conception: Laurent Li
+! Re-ecriture + adaptation LMDZ4: I. Musat
+! Transport, nouveau modèle glace, 2 couches: F.Codron
+!
+! input:
+!   klon         nombre T_h2O_ice_liqtal de points de grille
+!   itap         numero du pas de temps
+!   dtime        pas de temps de la physique (en s)
+!   ijour        jour dans l'annee en cours
+!   radsol       rayonnement net au sol (LW + SW)
+!   fluxo        flux turbulent (sensible + latent) sur les mailles oceaniques 
+!   fluxg        flux de conduction entre la surface de la glace de mer et l'ocean
+!   pctsrf       tableau des pourcentages de surface de chaque maille
+! output: 
+!   tslab        temperature de l'ocean libre
+!   tsea_ice         temperature de la glace (surface)
+!   pctsrf_slab  "pourcentages" (valeurs entre 0. et 1.) surfaces issus du slab
+
+    use slab_ice_h 
+
+#include "dimensions.h"
+#include "comcstfi.h"
+!    INCLUDE "iniprint.h"
+#include "callkeys.h"
+
+! Input arguments
+!****************************************************************************************
+    INTEGER, INTENT(IN)                       :: ngrid,icount
+!    INTEGER, INTENT(IN)                       :: itap
+    REAL, INTENT(IN)                          :: dtime       ! not used
+!    INTEGER, INTENT(IN)                       :: ijour
+    REAL, DIMENSION(ngrid), INTENT(IN)         :: radsol
+    REAL, DIMENSION(ngrid), INTENT(IN)         :: fluxo
+    REAL, DIMENSION(ngrid), INTENT(IN)         :: fluxg
+    REAL, DIMENSION(ngrid), INTENT(IN)  :: pctsrf
+    REAL, DIMENSION(ngrid), INTENT(IN)  :: taux_slab
+    REAL, DIMENSION(ngrid), INTENT(IN)  :: tauy_slab
+
+! Output arguments
+!****************************************************************************************
+    REAL, DIMENSION(ngrid,noceanmx), INTENT(OUT) :: tslab
+    REAL, DIMENSION(ngrid), INTENT(INOUT)       :: pctsrf_slab
+    REAL, DIMENSION(ngrid), INTENT(INOUT)       :: tsea_ice
+
+! Local variables
+!****************************************************************************************
+    REAL                    :: fonte,t_cadj
+    INTEGER                 :: i,k,kt,kb
+    REAL                    :: zz, za, zb
+    REAL                    :: cyang ! capacite calorifique slab J/(m2 K)
+    REAL, PARAMETER         :: tau_conv=432000. ! temps ajust conv (5 jours)
+    REAL, DIMENSION(ngrid,noceanmx) :: dtdiff_loc,dtekman_loc
+
+
+
+!***************************************************
+! Capacite calorifique de la couche de surface
+    cyang=capcalocean!slabh(1)*4.228e+06
+    cpl_pas=1!4*iradia
+
+!
+! lecture du bilan au sol lmt_bils issu d'une simulation forcee en debut de journee
+!!    julien = MOD(ijour,360)
+!!    IF (ok_slab_heaT_h2O_ice_liqBS .and. (MOD(itap,lmt_pas) .EQ. 1)) THEN  
+!!       ! 1er pas de temps de la journee
+!!       idayvrai = ijour
+!!       CALL condsurf(julien,idayvrai, lmt_bils)
+!!    ENDIF
+
+! ----------------------------------------------
+! A chaque pas de temps: cumul flux de chaleur
+! ----------------------------------------------
+! bilan du flux de chaleur dans l'ocean :
+!
+    DO i = 1, ngrid
+       za = radsol(i) + fluxo(i)
+       zb = fluxg(i)
+!       IF(((1-pctsrf(i)).GT.epsfra).OR. &
+!            (pctsrf(i).GT.epsfra)) THEN
+          slab_bils(i)=slab_bils(i)+(za*(1-pctsrf(i)) &
+               +zb*pctsrf(i))/ cpl_pas
+!       ENDIF
+
+    ENDDO !klon
+
+! ---------------------------------------------
+! T_h2O_ice_liqus les cpl_pas: update de tslab et seaice
+! ---------------------------------------------
+
+    IF (mod(icount-1,cpl_pas).eq.0) THEN !fin de journee
+!
+! ---------------------------------------------
+! Transport de chaleur par circulation
+! Decoupage par pas de temps pour stabilite numérique 
+! (diffusion, schema centre pour advection)
+! ---------------------------------------------
+      dt_hdiff(:,:)=0.
+      dt_ekman(:,:)=0.
+
+      IF (ok_slab_heat_transp) THEN
+!       DO i=1,cpl_pas
+!  Transport diffusif
+!         IF (ok_soil_hdiff) THEN
+             CALL divgrad_phy(noceanmx,tmp_tslab_loc,dtdiff_loc)
+             dtdiff_loc=dtdiff_loc*soil_hdiff*50./SUM(slabh)!*100.
+ !           dtdiff_loc(:,1)=dtdiff_loc(:,1)*soil_hdiff*50./SUM(slabh)*0.8
+ !           dtdiff_loc(:,2)=dtdiff_loc(:,2)*soil_hdiff*50./SUM(slabh)*0.2
+             dt_hdiff=dt_hdiff+dtdiff_loc
+             tmp_tslab_loc=tmp_tslab_loc+dtdiff_loc*dtime
+!         END IF
+
+! Calcul  de transport par Ekman
+
+          CALL slab_ekman2(taux_slab,tauy_slab,tslab,dtekman_loc)
+
+
+!        END SELECT
+!        IF (slab_ekman.GT.0) THEN
+          do k=1,noceanmx
+            dtekman_loc(:,k)=dtekman_loc(:,k)/(slabh(k)*1000.)!*0.
+          enddo
+          dt_ekman(:,:)=dt_ekman(:,:)+dtekman_loc(:,:)
+          tmp_tslab_loc=tmp_tslab_loc+dtekman_loc*dtime
+!        ENDIF
+!      ENDDO ! time splitting 1,cpl_pas     
+!      IF (slab_ekman.GT.0) THEN
+!	  taux_slab(:)=0.
+!	  tauy_slab(:)=0.
+!      ENDIF
+
+!       print*, 'slab_bils=',slab_bils(1)
+
+
+      ENDIF!(ok_slab_heat_transp)
+
+      DO i = 1, ngrid
+!      IF (((1-pctsrf(i)).GT.epsfra).OR. &
+!             (pctsrf(i).GT.epsfra)) THEN
+! ---------------------------------------------
+! Ajout des flux de chaleur dans l'océan
+! ---------------------------------------
+
+!print*, 'T_h2O_ice_liqcean1=',tmp_tslab_loc(i,1)
+        tmp_tslab_loc(i,1) = tmp_tslab_loc(i,1) + &
+             slab_bils(i)/cyang*dtime*cpl_pas
+
+!print*, 'capcalocean=',capcalocean
+!print*, 'cyang=',cyang
+!print*, 'dT_h2O_ice_liqcean=',slab_bils(i)/cyang*dtime
+!print*, 'T_h2O_ice_liqcean2=',tmp_tslab_loc(i,1)
+
+
+! on remet l'accumulation a 0
+        slab_bils(i) = 0.
+! ---------------------------------------------
+! Glace interactive 
+! ---------------------------------------------
+        IF (ok_slab_sic) THEN
+! Fondre la glace si température > 0. 
+! -----------------------------------
+          IF ((tmp_tslab_loc(i,1).GT.T_h2O_ice_liq-1.8) .AND. (tmp_seaice(i).GT.0.0)) THEN
+            fonte=(tmp_tslab_loc(i,1)-T_h2O_ice_liq+1.8)*cyang &
+                /(ice_lat+ice_cap/2*(T_h2O_ice_liq-1.8-tsea_ice(i)))
+            CALL icemelt(fonte,pctsrf_slab(i),tmp_seaice(i))
+                 tmp_tslab_loc(i,1)=T_h2O_ice_liq-1.8+fonte*ice_lat/cyang
+          ENDIF 
+! fabriquer de la glace si congelation atteinte:
+! ----------------------------------------------
+          IF (tmp_tslab_loc(i,1).LT.(T_h2O_ice_liq-1.8)) THEN
+
+            IF (tmp_seaice(i).LT.h_ice_min) THEN
+! Creation glace nouvelle
+!             IF (pctsrf_slab(i).LT.(epsfra)) THEN
+                 fonte=(T_h2O_ice_liq-1.8-tmp_tslab_loc(i,1))*cyang/ice_lat
+              IF (fonte.GT.h_ice_min*ice_frac_min) THEN
+                tmp_seaice(i)=MIN(h_ice_thin,fonte/ice_frac_min)
+                tmp_seaice(i)=MAX(tmp_seaice(i),fonte/ice_frac_max)
+!             IF (fonte.GT.0) THEN
+!               tmp_seaice(i)=fonte
+                tsea_ice(i)=T_h2O_ice_liq-1.8
+                pctsrf_slab(i)=(1-pctsrf_slab(i))*fonte/tmp_seaice(i)
+!                pctsrf_slab(i)=1.
+                tmp_tslab_loc(i,1)=T_h2O_ice_liq-1.8
+              ENDIF
+            ELSE  
+! glace déjà présente 
+! Augmenter epaisseur
+              fonte=(T_h2O_ice_liq-1.8-tmp_tslab_loc(i,1))*cyang &
+                   /(ice_lat+ice_cap/2*(T_h2O_ice_liq-1.8-tsea_ice(i)))           
+              zz=tmp_seaice(i)
+              tmp_seaice(i)=MAX(zz,MIN(h_ice_thick,fonte+zz))
+! Augmenter couverture (oce libre et h>h_thick) 
+              za=1-pctsrf_slab(i)
+              zb=pctsrf_slab(i)
+              fonte=fonte*za+MAX(0.0,fonte+zz-tmp_seaice(i))*zb
+              pctsrf_slab(i)=MIN(zb+fonte/tmp_seaice(i), &
+                                    (za+zb)*ice_frac_max)
+              fonte=MAX(0.0,fonte-(pctsrf_slab(i)-zb)*tmp_seaice(i))
+! Augmenter epaisseur si couverture complete
+              tmp_seaice(i)=tmp_seaice(i)+fonte/pctsrf_slab(i)
+              tmp_tslab_loc(i,1) = T_h2O_ice_liq-1.8
+            ENDIF ! presence glace
+          ENDIF !congelation
+! vérifier limites de hauteur de glace
+          IF(tmp_seaice(i).GT.h_ice_min) THEN
+            tmp_seaice(i) = MIN(tmp_seaice(i),h_ice_max)
+          ELSE
+            tmp_seaice(i) = 0. 
+            pctsrf_slab(i)=0.
+          ENDIF! (tmp_seaice(i).GT.h_ice_min)
+       
+        ENDIF !(ok_slab_sic) Glace interactive
+! ----------------------------------
+! Ajustement convectif si > 1 layers
+! ----------------------------------
+
+        IF ((noceanmx.GT.1)) THEN
+          DO kt=1,noceanmx-1
+            kb=kt           
+            DO k=kt+1,noceanmx !look for instability
+              IF (tmp_tslab_loc(i,k).GT.tmp_tslab_loc(i,kt)) THEN
+                kb=k
+              ENDIF
+            ENDDO
+            IF (kb.GT.kt) THEN !ajust conv
+!               IF (slab_cadj.EQ.1) THEN
+!             :   t_cadj=SUM(tmp_tslab_loc(i,kt:kb)*slabh(kt:kb))/SUM(slabh(kt:kb))
+!                DO k=kt,kb
+!                  tmp_tslab_loc(i,k)=t_cadj
+!                ENDDO
+!              ELSEIF (slab_cadj.EQ.2) THEN
+                t_cadj=(tmp_tslab_loc(i,kb)-tmp_tslab_loc(i,kt))*dtime/tau_conv*cpl_pas
+                tmp_tslab_loc(i,kt)=tmp_tslab_loc(i,kt)+t_cadj
+                tmp_tslab_loc(i,kb)=tmp_tslab_loc(i,kb)-t_cadj*slabh(kt)/slabh(kb)
+              !ENDIF 
+            ENDIF
+          ENDDO 
+        ENDIF !ajust 2 layers
+!      ENDIF !pctsrf
+      ENDDO !klon
+
+! On met a jour la temperature et la glace
+    tslab  = tmp_tslab_loc
+
+
+    ENDIF !(mod(icount-1,cpl_pas).eq.0)
+
+  END SUBROUTINE interfoce_slab
+!
+!******************************************************************************  
+  SUBROUTINE icemelt(fonte,pctsrf,seaice)
+
+      use slab_ice_h
+
+
+
+     REAL, INTENT(INOUT)  :: pctsrf
+     REAL , INTENT(INOUT)   ::fonte,seaice !kg/m2
+     REAL :: hh !auxilliary
+     REAL :: ff !auxilliary
+
+
+! ice gt h_ice_thick: decrease thickness up T_h2O_ice_liq h_ice_thick
+     IF (seaice.GT.h_ice_thick) THEN
+        hh=seaice
+!        ff=fonte
+        seaice=max(h_ice_thick,hh-fonte)    
+        fonte=max(0.0,fonte+h_ice_thick-hh)
+
+!        seaice=max(0.,hh-fonte)    
+!        fonte=max(0.0,fonte-(seaice-hh))
+!     IF (seaice.LT.epsfra) THEN
+!        pctsrf=0.
+!        seaice=0.
+!        fonte=ff-hh
+!     ENDIF
+
+     ENDIF
+! ice gt h_ice_thin: partially decrease thickness
+     IF ((seaice.GE.h_ice_thin).AND.(fonte.GT.0.0)) THEN
+       hh=seaice
+       seaice=MAX(hh-0.6*fonte,h_ice_thin)
+       fonte=MAX(0.0,fonte-hh+seaice)
+     ENDIF
+! use rest T_h2O_ice_liq decrease area
+       hh=pctsrf
+       pctsrf=MIN(hh,MAX(0.0,hh-fonte/seaice))
+       fonte=MAX(0.0,fonte-(hh-pctsrf)*seaice)
+
+    END SUBROUTINE icemelt
+
+!****************************************************************************************
+!
+  SUBROUTINE ocean_slab_final!(tslab_rst, seaice_rst)
+
+! This subroutine will send T_h2O_ice_liq phyredem the variables concerning the slab 
+! ocean that should be written T_h2O_ice_liq restart file.
+
+!****************************************************************************************
+
+!    REAL, DIMENSION(ngridmx,noceanmx), INTENT(OUT) :: tslab_rst
+!    REAL, DIMENSION(ngridmx), INTENT(OUT) :: seaice_rst
+
+!****************************************************************************************
+! Set the output variables
+!    tslab_rst(:,:)  = tmp_tslab(:,:)
+!    tslab_rst(:)  = tmp_tslab_loc(:)
+!    seaice_rst(:) = tmp_seaice(:)
+
+! Deallocation of all variables in module
+    DEALLOCATE(tmp_tslab, tmp_tslab_loc, tmp_pctsrf_slab)
+    DEALLOCATE(tmp_seaice, tmp_radsol, tmp_flux_o, tmp_flux_g)
+    DEALLOCATE(slab_bils, lmt_bils)
+    DEALLOCATE(dt_hdiff)
+
+  END SUBROUTINE ocean_slab_final
+!
+!****************************************************************************************
+!
+  SUBROUTINE ocean_slab_get_vars(ngrid,tslab_loc, seaice_loc, flux_o_loc, flux_g_loc, &
+       dt_hdiff_loc,dt_ekman_loc)
+  
+! "Get some variables from module ocean_slab_mod"
+! This subroutine prints variables T_h2O_ice_liq a external routine
+
+    INTEGER, INTENT(IN)                     :: ngrid
+    REAL, DIMENSION(ngrid,noceanmx), INTENT(OUT) :: tslab_loc
+    REAL, DIMENSION(ngrid), INTENT(OUT) :: seaice_loc
+    REAL, DIMENSION(ngrid), INTENT(OUT) :: flux_o_loc
+    REAL, DIMENSION(ngrid), INTENT(OUT) :: flux_g_loc
+    REAL, DIMENSION(ngrid,noceanmx), INTENT(OUT) :: dt_hdiff_loc
+    REAL, DIMENSION(ngrid,noceanmx), INTENT(OUT) :: dt_ekman_loc
+    INTEGER :: i
+
+
+! Set the output variables
+    tslab_loc=0.
+    dt_hdiff_loc=0.
+    dt_ekman_loc=0.
+    tslab_loc  = tmp_tslab
+    seaice_loc(:) = tmp_seaice(:)
+    flux_o_loc(:) = tmp_flux_o(:)
+    flux_g_loc(:) = tmp_flux_g(:)
+    DO i=1,noceanmx
+      dt_hdiff_loc(:,i) = dt_hdiff(:,i)*slabh(i)*1000.*4228. !Convert en W/m2
+      dt_ekman_loc(:,i) = dt_ekman(:,i)*slabh(i)*1000.*4228. 
+    ENDDO
+  
+  
+
+  END SUBROUTINE ocean_slab_get_vars
+!
+!****************************************************************************************
+!
+END MODULE ocean_slab_mod
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/optci.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/optci.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/optci.F90	(revision 222)
@@ -0,0 +1,399 @@
+subroutine optci(PLEV,TLEV,DTAUI,TAUCUMI,      &
+     QXIAER,QSIAER,GIAER,COSBI,WBARI,TAUAERO,  &
+     TMID,PMID,TAUGSURF,QVAR,MUVAR)
+
+  use radinc_h
+  use radcommon_h, only: gasi,tlimit,wrefVAR,Cmk,tgasref,pfgasref,wnoi,scalep,indi,glat_ig
+  use gases_h
+  implicit none
+
+  !==================================================================
+  !     
+  !     Purpose
+  !     -------
+  !     Calculates longwave optical constants at each level. For each
+  !     layer and spectral interval in the IR it calculates WBAR, DTAU
+  !     and COSBAR. For each level it calculates TAU.
+  !     
+  !     TAUI(L,LW) is the cumulative optical depth at level L (or alternatively
+  !     at the *bottom* of layer L), LW is the spectral wavelength interval.
+  !     
+  !     TLEV(L) - Temperature at the layer boundary (i.e., level)
+  !     PLEV(L) - Pressure at the layer boundary (i.e., level)
+  !
+  !     Authors
+  !     -------
+  !     Adapted from the NASA Ames code by R. Wordsworth (2009)
+  !     
+  !==================================================================
+
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+  real*8 DTAUI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+  real*8 DTAUKI(L_LEVELS+1,L_NSPECTI,L_NGAUSS)
+  real*8 TAUI(L_NLEVRAD,L_NSPECTI,L_NGAUSS)
+  real*8 TAUCUMI(L_LEVELS,L_NSPECTI,L_NGAUSS)
+  real*8 PLEV(L_LEVELS)
+  real*8 TLEV(L_LEVELS)
+  real*8 TMID(L_LEVELS), PMID(L_LEVELS)
+  real*8 COSBI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+  real*8 WBARI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+
+  ! for aerosols
+  real*8  QXIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
+  real*8  QSIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
+  real*8  GIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
+  real*8  TAUAERO(L_LEVELS+1,NAERKIND)
+  real*8  TAUAEROLK(L_LEVELS+1,L_NSPECTI,NAERKIND)
+  real*8  TAEROS(L_LEVELS,L_NSPECTI,NAERKIND)
+
+  integer L, NW, NG, K, LK, IAER
+  integer MT(L_LEVELS), MP(L_LEVELS), NP(L_LEVELS)
+  real*8  ANS, TAUGAS
+  real*8  DPR(L_LEVELS), U(L_LEVELS)
+  real*8  LCOEF(4), LKCOEF(L_LEVELS,4)
+
+  real*8 taugsurf(L_NSPECTI,L_NGAUSS-1)
+  real*8 DCONT,DAERO
+  double precision wn_cont, p_cont, p_air, T_cont, dtemp, dtempc
+  double precision p_cross
+
+  ! variable species mixing ratio variables
+  real*8  QVAR(L_LEVELS), WRATIO(L_LEVELS), MUVAR(L_LEVELS)
+  real*8  KCOEF(4)
+  integer NVAR(L_LEVELS)
+
+  ! temporary variables for multiple aerosol calculation
+  real*8 atemp
+  real*8 btemp(L_NLAYRAD,L_NSPECTI)
+
+  ! variables for k in units m^-1
+  real*8 dz(L_LEVELS)
+  !real*8 rho !! see test below
+
+  integer igas, jgas
+
+  integer interm
+
+  !--- Kasting's CIA ----------------------------------------
+  !real*8, parameter :: Ci(L_NSPECTI)=[                         &
+  !     3.8E-5, 1.2E-5, 2.8E-6, 7.6E-7, 4.5E-7, 2.3E-7,    &
+  !     5.4E-7, 1.6E-6, 0.0,                               &
+  !     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,            & 
+  !     0.0, 4.0E-7, 4.0E-6, 1.4E-5,    &
+  !     1.0E-5, 1.2E-6, 2.0E-7, 5.0E-8, 3.0E-8, 0.0 ] 
+  !real*8, parameter :: Ti(L_NSPECTI)=[ -2.2, -1.9,             &
+  !     -1.7, -1.7, -1.7, -1.7, -1.7, -1.7,                &
+  !     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+  !     -1.7,-1.7,-1.7,-1.7,-1.7,-1.7,-1.7, -1.7,0.0 ]
+  !----------------------------------------------------------
+
+  !! AS: to save time in computing continuum (see bilinearbig)
+  IF (.not.ALLOCATED(indi)) THEN
+      ALLOCATE(indi(L_NSPECTI,ngasmx,ngasmx))
+      indi = -9999  ! this initial value means "to be calculated"
+  ENDIF
+
+  !=======================================================================
+  !     Determine the total gas opacity throughout the column, for each
+  !     spectral interval, NW, and each Gauss point, NG.
+
+  taugsurf(:,:) = 0.0
+  dpr(:)        = 0.0
+  lkcoef(:,:)   = 0.0
+
+  do K=2,L_LEVELS
+     DPR(k) = PLEV(K)-PLEV(K-1)
+
+     !--- Kasting's CIA ----------------------------------------
+     !dz(k)=dpr(k)*189.02*TMID(K)/(0.03720*PMID(K))
+     ! this is CO2 path length (in cm) as written by Francois
+     ! delta_z = delta_p * R_specific * T / (g * P)
+     ! But Kasting states that W is in units of _atmosphere_ cm
+     ! So we do
+     !dz(k)=dz(k)*(PMID(K)/1013.25)
+     !dz(k)=dz(k)/100.0 ! in m for SI calc
+     !----------------------------------------------------------
+
+     ! if we have continuum opacities, we need dz
+     if(kastprof)then
+        dz(k) = dpr(k)*(1000.0d0*8.3145d0/muvar(k))*TMID(K)/(g*PMID(K))
+        U(k)  = Cmk*DPR(k)*mugaz/muvar(k) 
+     else
+        dz(k) = dpr(k)*R*TMID(K)/(glat_ig*PMID(K))*mugaz/muvar(k)
+        U(k)  = Cmk*DPR(k)*mugaz/muvar(k)     ! only Cmk line in optci.F  
+	    !JL13 the mugaz/muvar factor takes into account water meanmolecular weight if water is present
+     endif
+
+     call tpindex(PMID(K),TMID(K),QVAR(K),pfgasref,tgasref,WREFVAR, &
+          LCOEF,MT(K),MP(K),NVAR(K),WRATIO(K))
+
+     do LK=1,4
+        LKCOEF(K,LK) = LCOEF(LK)
+     end do
+  end do                    ! levels
+
+
+  do iaer=1,naerkind
+     DO NW=1,L_NSPECTI
+        do K=2,L_LEVELS
+           TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXIAER(K,NW,IAER)
+        end do                    ! levels
+     END DO
+  end do
+
+  do NW=1,L_NSPECTI
+
+     do K=2,L_LEVELS
+
+! continuum absorption
+        DCONT = 0.0d0 
+
+        if(continuum.and.(.not.graybody))then
+           ! include continua if necessary
+           wn_cont = dble(wnoi(nw))
+           T_cont  = dble(TMID(k))
+           do igas=1,ngasmx
+
+              if(gfrac(igas).eq.-1)then ! variable
+                 p_cont  = dble(PMID(k)*scalep*QVAR(k)) ! qvar = mol/mol
+              else
+                 p_cont  = dble(PMID(k)*scalep*gfrac(igas)*(1.-QVAR(k)))
+              endif
+
+              dtemp=0.0d0
+              if(igas.eq.igas_N2)then
+
+                 interm = indi(nw,igas,igas)
+                 call interpolateN2N2(wn_cont,T_cont,p_cont,dtemp,.false.,interm)
+                 indi(nw,igas,igas) = interm
+
+              elseif(igas.eq.igas_H2)then
+
+                 ! first do self-induced absorption
+                 interm = indi(nw,igas,igas)
+                 call interpolateH2H2(wn_cont,T_cont,p_cont,dtemp,.false.,interm)
+                 indi(nw,igas,igas) = interm
+
+                 ! then cross-interactions with other gases
+                 do jgas=1,ngasmx
+                    p_cross = dble(PMID(k)*scalep*gfrac(jgas)*(1.-QVAR(k)))
+                    dtempc  = 0.0d0
+                    if(jgas.eq.igas_N2)then 
+                       interm = indi(nw,igas,jgas)
+                       call interpolateN2H2(wn_cont,T_cont,p_cross,p_cont,dtempc,.false.,interm)
+                       indi(nw,igas,jgas) = interm
+                    elseif(jgas.eq.igas_He)then 
+                       interm = indi(nw,igas,jgas)
+                       call interpolateH2He(wn_cont,T_cont,p_cross,p_cont,dtempc,.false.,interm)
+                       indi(nw,igas,jgas) = interm
+                    endif
+                    dtemp = dtemp + dtempc
+                 enddo
+
+              elseif(igas.eq.igas_H2O.and.T_cont.gt.200.0)then
+
+                 p_air = dble(PMID(k)*scalep) - p_cont ! note assumes background is air!
+                 if(H2Ocont_simple)then
+                    call interpolateH2Ocont_PPC(wn_cont,T_cont,p_cont,p_air,dtemp,.false.)
+                 else
+                    interm = indi(nw,igas,igas)
+                    call interpolateH2Ocont_CKD(wn_cont,T_cont,p_cont,p_air,dtemp,.false.,interm)
+                    indi(nw,igas,igas) = interm
+                 endif
+
+              endif
+
+              DCONT = DCONT + dtemp
+
+           enddo
+
+           ! Oobleck test
+           !rho = PMID(k)*scalep / (TMID(k)*286.99)
+           !if(WNOI(nw).gt.300.0 .and. WNOI(nw).lt.500.0)then
+           !   DCONT = rho * 0.125 * 4.6e-4
+           !elseif(WNOI(nw).gt.500.0 .and. WNOI(nw).lt.700.0)then
+           !   DCONT = 1000*dpr(k) * 1.0 * 4.6e-4 / g
+           !   DCONT = rho * 1.0 * 4.6e-4
+           !elseif(WNOI(nw).gt.700.0 .and. WNOI(nw).lt.900.0)then
+           !   DCONT = rho * 0.125 * 4.6e-4
+           !endif
+
+           DCONT = DCONT*dz(k)
+
+        endif
+
+! aerosol absorption
+	DAERO=SUM(TAEROS(K,NW,1:naerkind))
+
+        do ng=1,L_NGAUSS-1
+
+           ! Now compute TAUGAS
+
+           ! Interpolate between water mixing ratios
+           ! WRATIO = 0.0 if the requested water amount is equal to, or outside the
+           ! the water data range
+
+           if(L_REFVAR.eq.1)then ! added by RW for special no variable case
+              KCOEF(1) = GASI(MT(K),MP(K),1,NW,NG)
+              KCOEF(2) = GASI(MT(K),MP(K)+1,1,NW,NG)
+              KCOEF(3) = GASI(MT(K)+1,MP(K)+1,1,NW,NG)
+              KCOEF(4) = GASI(MT(K)+1,MP(K),1,NW,NG)
+           else
+
+              KCOEF(1) = GASI(MT(K),MP(K),NVAR(K),NW,NG) + WRATIO(K)*     &
+                   (GASI(MT(K),MP(K),NVAR(K)+1,NW,NG) -                   &
+                   GASI(MT(K),MP(K),NVAR(K),NW,NG))
+
+              KCOEF(2) = GASI(MT(K),MP(K)+1,NVAR(K),NW,NG) + WRATIO(K)*   &
+                   (GASI(MT(K),MP(K)+1,NVAR(K)+1,NW,NG) -                 &
+                   GASI(MT(K),MP(K)+1,NVAR(K),NW,NG))
+
+              KCOEF(3) = GASI(MT(K)+1,MP(K)+1,NVAR(K),NW,NG) + WRATIO(K)* &
+                   (GASI(MT(K)+1,MP(K)+1,NVAR(K)+1,NW,NG) -               &
+                   GASI(MT(K)+1,MP(K)+1,NVAR(K),NW,NG))
+
+              KCOEF(4) = GASI(MT(K)+1,MP(K),NVAR(K),NW,NG) + WRATIO(K)*   &
+                   (GASI(MT(K)+1,MP(K),NVAR(K)+1,NW,NG) -                 &
+                   GASI(MT(K)+1,MP(K),NVAR(K),NW,NG))
+
+           endif
+
+           ! Interpolate the gaseous k-coefficients to the requested T,P values
+
+           ANS = LKCOEF(K,1)*KCOEF(1) + LKCOEF(K,2)*KCOEF(2) +            &
+                LKCOEF(K,3)*KCOEF(3) + LKCOEF(K,4)*KCOEF(4)
+
+           TAUGAS  = U(k)*ANS
+
+           TAUGSURF(NW,NG) = TAUGSURF(NW,NG) + TAUGAS + DCONT
+           DTAUKI(K,nw,ng) = TAUGAS    & 
+                             + DCONT   & ! For parameterized continuum absorption
+			     + DAERO     ! For aerosol absorption
+
+        end do
+
+        ! Now fill in the "clear" part of the spectrum (NG = L_NGAUSS),
+        ! which holds continuum opacity only
+
+        NG              = L_NGAUSS
+        DTAUKI(K,nw,ng) = 0.d0      & 
+                          + DCONT   & ! For parameterized continuum absorption
+	                  + DAERO     ! For aerosol absorption
+
+     end do
+  end do
+
+  DTAUKI(L_LEVELS+1,1:L_NSPECTI,1:L_NGAUSS)=0.d0
+  !=======================================================================
+  !     Now the full treatment for the layers, where besides the opacity
+  !     we need to calculate the scattering albedo and asymmetry factors
+
+  do iaer=1,naerkind
+    DO NW=1,L_NSPECTI
+     DO K=2,L_LEVELS+1
+           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER)*QSIAER(K,NW,IAER)
+     ENDDO
+    ENDDO
+  end do
+  
+  DO NW=1,L_NSPECTI
+     DO L=1,L_NLAYRAD
+        K              = 2*L+1
+        btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
+     END DO ! L vertical loop
+  END DO                    ! NW spectral loop
+  
+
+  DO NW=1,L_NSPECTI
+     NG = L_NGAUSS
+     DO L=1,L_NLAYRAD
+
+        K              = 2*L+1
+        DTAUI(L,nw,ng) = DTAUKI(K,NW,NG) + DTAUKI(K+1,NW,NG)! + 1.e-50
+
+        atemp = 0.
+        if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
+           do iaer=1,naerkind
+              atemp = atemp +                                     &
+                   GIAER(K,NW,IAER)   * TAUAEROLK(K,NW,IAER) +    &
+                   GIAER(K+1,NW,IAER) * TAUAEROLK(K+1,NW,IAER)
+           end do
+           WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
+        else
+           WBARI(L,nw,ng) = 0.0D0
+           DTAUI(L,NW,NG) = 1.0D-9
+        endif
+
+        if(btemp(L,nw) .GT. 0.0d0) then
+           cosbi(L,NW,NG) = atemp/btemp(L,nw)
+        else
+           cosbi(L,NW,NG) = 0.0D0
+        end if
+
+     END DO ! L vertical loop
+
+     ! Now the other Gauss points, if needed.
+
+     DO NG=1,L_NGAUSS-1
+        IF(TAUGSURF(NW,NG) .gt. TLIMIT) THEN
+
+           DO L=1,L_NLAYRAD
+              K              = 2*L+1
+              DTAUI(L,nw,ng) = DTAUKI(K,NW,NG)+DTAUKI(K+1,NW,NG)! + 1.e-50
+
+              if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
+
+                 WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
+
+              else
+                 WBARI(L,nw,ng) = 0.0D0
+                 DTAUI(L,NW,NG) = 1.0D-9
+              endif
+
+              cosbi(L,NW,NG) = cosbi(L,NW,L_NGAUSS)
+           END DO ! L vertical loop
+        END IF
+
+     END DO                 ! NG Gauss loop
+  END DO                    ! NW spectral loop
+
+  ! Total extinction optical depths
+
+  DO NG=1,L_NGAUSS       ! full gauss loop
+     DO NW=1,L_NSPECTI       
+        TAUCUMI(1,NW,NG)=0.0D0
+        DO K=2,L_LEVELS
+           TAUCUMI(K,NW,NG)=TAUCUMI(K-1,NW,NG)+DTAUKI(K,NW,NG)
+        END DO
+     END DO                 ! end full gauss loop
+  END DO
+
+  ! be aware when comparing with textbook results 
+  ! (e.g. Pierrehumbert p. 218) that 
+  ! taucumi does not take the <cos theta>=0.5 factor into
+  ! account. It is the optical depth for a vertically 
+  ! ascending ray with angle theta = 0.
+
+  !open(127,file='taucum.out')
+  !do nw=1,L_NSPECTI
+  !   write(127,*) taucumi(L_LEVELS,nw,L_NGAUSS)
+  !enddo
+  !close(127)
+  
+!  print*,'WBARI'
+!  print*,WBARI
+!  print*,'DTAUI'
+!  print*,DTAUI
+!  call abort
+  
+
+  return
+
+
+end subroutine optci
+
+
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/optcv.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/optcv.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/optcv.F90	(revision 222)
@@ -0,0 +1,353 @@
+SUBROUTINE OPTCV(DTAUV,TAUV,TAUCUMV,PLEV,  &
+     QXVAER,QSVAER,GVAER,WBARV,COSBV,       &
+     TAURAY,TAUAERO,TMID,PMID,TAUGSURF,QVAR,MUVAR)
+
+  use radinc_h
+  use radcommon_h, only: gasv, tlimit, wrefVAR, Cmk, tgasref, pfgasref,wnov,scalep,indv,glat_ig
+  use gases_h
+
+  implicit none
+
+  !==================================================================
+  !     
+  !     Purpose
+  !     -------
+  !     Calculates shortwave optical constants at each level.
+  !     
+  !     Authors
+  !     -------
+  !     Adapted from the NASA Ames code by R. Wordsworth (2009)
+  !     
+  !==================================================================
+  !     
+  !     THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE VISUAL  
+  !     IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE VISUAL
+  !     LAYER: WBAR, DTAU, COSBAR
+  !     LEVEL: TAU
+  !     
+  !     TAUV(L,NW,NG) is the cumulative optical depth at the top of radiation code
+  !     layer L. NW is spectral wavelength interval, ng the Gauss point index.
+  !     
+  !     TLEV(L) - Temperature at the layer boundary
+  !     PLEV(L) - Pressure at the layer boundary (i.e. level)
+  !     GASV(NT,NPS,NW,NG) - Visible k-coefficients 
+  !     
+  !-------------------------------------------------------------------
+
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+  real*8 DTAUV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+  real*8 DTAUKV(L_LEVELS+1,L_NSPECTV,L_NGAUSS)
+  real*8 TAUV(L_NLEVRAD,L_NSPECTV,L_NGAUSS)
+  real*8 TAUCUMV(L_LEVELS,L_NSPECTV,L_NGAUSS)
+  real*8 PLEV(L_LEVELS)
+  real*8 TMID(L_LEVELS), PMID(L_LEVELS)
+  real*8 COSBV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+  real*8 WBARV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+
+  ! for aerosols
+  real*8  QXVAER(L_LEVELS+1,L_NSPECTV,NAERKIND)
+  real*8  QSVAER(L_LEVELS+1,L_NSPECTV,NAERKIND)
+  real*8  GVAER(L_LEVELS+1,L_NSPECTV,NAERKIND)
+  real*8  TAUAERO(L_LEVELS+1,NAERKIND)
+  real*8  TAUAEROLK(L_LEVELS+1,L_NSPECTV,NAERKIND)
+  real*8  TAEROS(L_LEVELS,L_NSPECTV,NAERKIND)
+
+  integer L, NW, NG, K, LK, IAER
+  integer MT(L_LEVELS), MP(L_LEVELS), NP(L_LEVELS)
+  real*8  ANS, TAUGAS
+  real*8  TAURAY(L_NSPECTV)
+  real*8  TRAY(L_LEVELS,L_NSPECTV)
+  real*8  TRAYAER
+  real*8  DPR(L_LEVELS), U(L_LEVELS)
+  real*8  LCOEF(4), LKCOEF(L_LEVELS,4)
+
+  real*8 taugsurf(L_NSPECTV,L_NGAUSS-1)
+  real*8 DCONT,DAERO
+  double precision wn_cont, p_cont, p_air, T_cont, dtemp, dtempc
+  double precision p_cross
+
+  ! variable species mixing ratio variables
+  real*8  QVAR(L_LEVELS), WRATIO(L_LEVELS), MUVAR(L_LEVELS)
+  real*8  KCOEF(4)
+  integer NVAR(L_LEVELS)
+
+  ! temporary variables for multiple aerosol calculation
+  real*8 atemp(L_NLAYRAD,L_NSPECTV)
+  real*8 btemp(L_NLAYRAD,L_NSPECTV)
+  real*8 ctemp(L_NLAYRAD,L_NSPECTV)
+
+  ! variables for k in units m^-1
+  real*8 dz(L_LEVELS)
+
+  integer igas, jgas
+
+  integer interm
+
+  !! AS: to save time in computing continuum (see bilinearbig)
+  IF (.not.ALLOCATED(indv)) THEN
+      ALLOCATE(indv(L_NSPECTV,ngasmx,ngasmx))
+      indv = -9999 ! this initial value means "to be calculated"
+  ENDIF
+
+  !=======================================================================
+  !     Determine the total gas opacity throughout the column, for each
+  !     spectral interval, NW, and each Gauss point, NG.
+  !     Calculate the continuum opacities, i.e., those that do not depend on
+  !     NG, the Gauss index.
+
+  taugsurf(:,:) = 0.0
+  dpr(:)        = 0.0
+  lkcoef(:,:)   = 0.0
+
+  do K=2,L_LEVELS
+     DPR(k) = PLEV(K)-PLEV(K-1)
+
+     ! if we have continuum opacities, we need dz
+     if(kastprof)then
+        dz(k) = dpr(k)*(1000.0d0*8.3145d0/muvar(k))*TMID(K)/(g*PMID(K))
+        U(k)  = Cmk*DPR(k)*mugaz/muvar(k) 
+     else
+        dz(k) = dpr(k)*R*TMID(K)/(glat_ig*PMID(K))*mugaz/muvar(k)
+        U(k)  = Cmk*DPR(k)*mugaz/muvar(k)     ! only Cmk line in optci.F  
+	    !JL13 the mugaz/muvar factor takes into account water meanmolecular weight if water is present
+     endif
+
+     call tpindex(PMID(K),TMID(K),QVAR(K),pfgasref,tgasref,WREFVAR, &
+          LCOEF,MT(K),MP(K),NVAR(K),WRATIO(K))
+
+     do LK=1,4
+        LKCOEF(K,LK) = LCOEF(LK)
+     end do
+  end do                    ! levels
+
+
+  do iaer=1,naerkind
+     do NW=1,L_NSPECTV
+        do K=2,L_LEVELS
+           TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXVAER(K,NW,IAER)
+        end do                    ! levels
+     end do
+  end do
+  do NW=1,L_NSPECTV
+     do K=2,L_LEVELS
+        TRAY(K,NW)   = TAURAY(NW) * DPR(K)
+     end do                    ! levels
+  end do
+  
+  !     we ignore K=1...
+  do K=2,L_LEVELS
+
+     do NW=1,L_NSPECTV
+
+        TRAYAER = TRAY(K,NW)
+        !     TRAYAER is Tau RAYleigh scattering, plus AERosol opacity
+        do iaer=1,naerkind
+           TRAYAER = TRAYAER + TAEROS(K,NW,IAER)
+        end do
+
+        DCONT = 0.0 ! continuum absorption
+
+        if(continuum.and.(.not.graybody).and.callgasvis)then
+           ! include continua if necessary
+           wn_cont = dble(wnov(nw))
+           T_cont  = dble(TMID(k))
+           do igas=1,ngasmx
+
+              if(gfrac(igas).eq.-1)then ! variable
+                 p_cont  = dble(PMID(k)*scalep*QVAR(k)) ! qvar = mol/mol
+              else
+                 p_cont  = dble(PMID(k)*scalep*gfrac(igas)*(1.-QVAR(k)))
+              endif
+
+              dtemp=0.0
+              if(igas.eq.igas_N2)then
+
+                 interm = indv(nw,igas,igas)
+!                 call interpolateN2N2(wn_cont,T_cont,p_cont,dtemp,.false.,interm)
+                 indv(nw,igas,igas) = interm
+                 ! only goes to 500 cm^-1, so unless we're around a cold brown dwarf, this is irrelevant in the visible
+
+              elseif(igas.eq.igas_H2)then
+
+                 ! first do self-induced absorption
+                 interm = indv(nw,igas,igas)
+                 call interpolateH2H2(wn_cont,T_cont,p_cont,dtemp,.false.,interm)
+                 indv(nw,igas,igas) = interm
+
+                 ! then cross-interactions with other gases
+                 do jgas=1,ngasmx
+                    p_cross = dble(PMID(k)*scalep*gfrac(jgas)*(1.-QVAR(k)))
+                    dtempc  = 0.0
+                    if(jgas.eq.igas_N2)then 
+                       interm = indv(nw,igas,jgas)
+                       call interpolateN2H2(wn_cont,T_cont,p_cross,p_cont,dtempc,.false.,interm)
+                       indv(nw,igas,jgas) = interm
+                       ! should be irrelevant in the visible
+                    elseif(jgas.eq.igas_He)then 
+                       interm = indv(nw,igas,jgas)
+                       call interpolateH2He(wn_cont,T_cont,p_cross,p_cont,dtempc,.false.,interm)
+                       indv(nw,igas,jgas) = interm
+                    endif
+                    dtemp = dtemp + dtempc
+                 enddo
+
+              elseif(igas.eq.igas_H2O.and.T_cont.gt.200.0)then
+
+                 p_air = dble(PMID(k)*scalep) - p_cont ! note assumes background is air!
+                 if(H2Ocont_simple)then
+                    call interpolateH2Ocont_PPC(wn_cont,T_cont,p_cont,p_air,dtemp,.false.)
+                 else
+                    interm = indv(nw,igas,igas)
+                    call interpolateH2Ocont_CKD(wn_cont,T_cont,p_cont,p_air,dtemp,.false.,interm)
+                    indv(nw,igas,igas) = interm
+                 endif
+
+              endif
+
+              DCONT = DCONT + dtemp
+
+           enddo
+
+           DCONT = DCONT*dz(k)
+
+        endif
+
+        do ng=1,L_NGAUSS-1
+
+           ! Now compute TAUGAS
+
+           ! Interpolate between water mixing ratios
+           ! WRATIO = 0.0 if the requested water amount is equal to, or outside the
+           ! the water data range
+
+           if(L_REFVAR.eq.1)then ! added by RW for special no variable case
+              KCOEF(1) = GASV(MT(K),MP(K),1,NW,NG)
+              KCOEF(2) = GASV(MT(K),MP(K)+1,1,NW,NG)
+              KCOEF(3) = GASV(MT(K)+1,MP(K)+1,1,NW,NG)
+              KCOEF(4) = GASV(MT(K)+1,MP(K),1,NW,NG)
+           else
+
+              KCOEF(1) = GASV(MT(K),MP(K),NVAR(K),NW,NG) + WRATIO(K)*    &
+                   (GASV(MT(K),MP(K),NVAR(K)+1,NW,NG) -                  &
+                   GASV(MT(K),MP(K),NVAR(K),NW,NG))
+
+              KCOEF(2) = GASV(MT(K),MP(K)+1,NVAR(K),NW,NG) + WRATIO(K)*  &
+                   (GASV(MT(K),MP(K)+1,NVAR(K)+1,NW,NG) -                &
+                   GASV(MT(K),MP(K)+1,NVAR(K),NW,NG))
+
+              KCOEF(3) = GASV(MT(K)+1,MP(K)+1,NVAR(K),NW,NG) + WRATIO(K)*&
+                   (GASV(MT(K)+1,MP(K)+1,NVAR(K)+1,NW,NG) -              &
+                   GASV(MT(K)+1,MP(K)+1,NVAR(K),NW,NG))
+
+              KCOEF(4) = GASV(MT(K)+1,MP(K),NVAR(K),NW,NG) + WRATIO(K)*  &
+                   (GASV(MT(K)+1,MP(K),NVAR(K)+1,NW,NG) -                &
+                   GASV(MT(K)+1,MP(K),NVAR(K),NW,NG))
+
+           endif
+
+           ! Interpolate the gaseous k-coefficients to the requested T,P values
+
+           ANS = LKCOEF(K,1)*KCOEF(1) + LKCOEF(K,2)*KCOEF(2) +            &
+                LKCOEF(K,3)*KCOEF(3) + LKCOEF(K,4)*KCOEF(4)
+
+           TAUGAS  = U(k)*ANS
+
+           TAUGSURF(NW,NG) = TAUGSURF(NW,NG) + TAUGAS + DCONT
+           DTAUKV(K,nw,ng) = TAUGAS & 
+                             + TRAYAER & ! TRAYAER includes all scattering contributions
+                             + DCONT ! For parameterized continuum aborption
+
+        end do
+
+        ! Now fill in the "clear" part of the spectrum (NG = L_NGAUSS),
+        ! which holds continuum opacity only
+
+        NG              = L_NGAUSS
+        DTAUKV(K,nw,ng) = TRAY(K,NW) + DCONT ! For parameterized continuum absorption
+
+        do iaer=1,naerkind
+           DTAUKV(K,nw,ng) = DTAUKV(K,nw,ng) +  TAEROS(K,NW,IAER)
+        end do ! a bug was here!
+
+     end do
+  end do
+
+
+  !=======================================================================
+  !     Now the full treatment for the layers, where besides the opacity
+  !     we need to calculate the scattering albedo and asymmetry factors
+
+  do iaer=1,naerkind
+    DO NW=1,L_NSPECTV
+      DO K=2,L_LEVELS   ! AS: shouldn't this be L_LEVELS+1 ? (see optci)
+           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER) * QSVAER(K,NW,IAER)
+      ENDDO
+    ENDDO
+  end do
+
+  DO NW=1,L_NSPECTV
+     DO L=1,L_NLAYRAD-1
+        K              = 2*L+1
+	atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind))+SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind))
+        btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
+	ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW))
+	btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW)
+	COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
+     END DO ! L vertical loop
+     
+     !last level
+     L              = L_NLAYRAD
+     K              = 2*L+1
+     atemp(L,NW)    = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind))
+     btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind))
+     ctemp(L,NW) = btemp(L,NW) + 0.9999*TRAY(K,NW)
+     btemp(L,NW) = btemp(L,NW) + TRAY(K,NW)
+     COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
+     
+     
+  END DO                    ! NW spectral loop
+
+  DO NG=1,L_NGAUSS
+    DO NW=1,L_NSPECTV
+     DO L=1,L_NLAYRAD-1
+
+        K              = 2*L+1
+        DTAUV(L,nw,ng) = DTAUKV(K,NW,NG) + DTAUKV(K+1,NW,NG)
+        WBARV(L,nw,ng) = ctemp(L,NW) / DTAUV(L,nw,ng)
+
+      END DO ! L vertical loop
+
+        !     No vertical averaging on bottom layer
+
+        L              = L_NLAYRAD
+        K              = 2*L+1
+	DTAUV(L,nw,ng) = DTAUKV(K,NW,NG)
+
+        WBARV(L,NW,NG) = ctemp(L,NW) / DTAUV(L,NW,NG)
+     END DO                 ! NW spectral loop
+  END DO                    ! NG Gauss loop
+
+  ! Total extinction optical depths
+
+  DO NG=1,L_NGAUSS       ! full gauss loop
+     DO NW=1,L_NSPECTV       
+        TAUV(1,NW,NG)=0.0D0
+        DO L=1,L_NLAYRAD
+           TAUV(L+1,NW,NG)=TAUV(L,NW,NG)+DTAUV(L,NW,NG)
+        END DO
+
+        TAUCUMV(1,NW,NG)=0.0D0
+        DO K=2,L_LEVELS
+           TAUCUMV(K,NW,NG)=TAUCUMV(K-1,NW,NG)+DTAUKV(K,NW,NG)
+        END DO
+     END DO            
+  END DO                 ! end full gauss loop
+
+
+  return
+
+
+end subroutine optcv
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/orbite.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/orbite.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/orbite.F	(revision 222)
@@ -0,0 +1,52 @@
+      subroutine orbite(pls,pdist_star,pdecli)
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Distance from star and declination as a function of the stellar
+!     longitude Ls
+!     
+!     Inputs
+!     ------
+!     pls          Ls
+!
+!     Outputs
+!     -------
+!     pdist_star    Distance Star-Planet in UA
+!     pdecli        declinaison ( in radians )
+!
+!=======================================================================
+
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_star,pdecli,pls,i
+
+c-----------------------------------------------------------------------
+
+c Star-Planet Distance
+
+      pdist_star = p_elips/(1.+e_elips*cos(pls+timeperi))
+
+c Stellar declination
+
+c ********************* version before 01/01/2000 *******
+
+      pdecli = asin (sin(pls)*sin(obliquit*pi/180.))
+
+c ********************* version after 01/01/2000 *******
+c     i=obliquit*pi/180.
+c     pdecli=asin(sin(pls)*sin(i)/sqrt(sin(pls)**2+
+c    & cos(pls)**2*cos(i)**2))
+c ******************************************************
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/params_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/params_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/params_h.F90	(revision 222)
@@ -0,0 +1,16 @@
+      module params_h
+
+!  for use with kcm subroutines
+!  RDW 22/09/11
+
+      implicit none
+
+      double precision rc,cp_n,m_n,m_v,rmn
+      save cp_n,m_n,m_v,rmn
+
+      logical ideal_v
+      save ideal_v
+
+      parameter (rc  = 8.314462d0) ! ideal gas constant [J mol^-1 K^-1]
+
+      end module params_h
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phasechange_kcm.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phasechange_kcm.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phasechange_kcm.F90	(revision 222)
@@ -0,0 +1,1286 @@
+!  ----------------------------------------------------------------
+!  Purpose: Thermodynamic data on H2O, NH3
+!  Authour: Adapted from various sources by R. Wordsworth (2011)
+
+
+! ---------------------
+! NH3
+! ---------------------
+subroutine psat_NH3 ( T, p )
+!
+!  PSAT_NH3 makes a rough estimate of the vapor pressure.
+!
+!  Interpolated from www.engineeringtoolbox.com data by RDW 21/09/11 for
+!  temperatures between 223 and 323 K.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision P, the vapor pressure, in MegaPascals.
+!
+
+  implicit none
+
+  double precision p,T
+
+  p=exp(-1.5609d-004*T**2 + 0.1236*T - 9.1530)/1d6
+
+end subroutine psat_NH3
+
+subroutine latheat_NH3 ( T, sc, sv )
+!
+!  PSAT_NH3 makes a rough estimate of the entropies of condensation /
+!  vapourisation.
+! 
+!  Interpolated from www.engineeringtoolbox.com data by RDW 21/09/11 for
+!  temperatures between 223 and 323 K.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision sc, the entropy of condensate, in J kg^-1 K^-1.
+!            double precision sv, the entropy of gas, in J kg^-1 K^-1.
+!
+
+  implicit none
+
+  double precision T,sc,sv
+
+  sv = 0.0492*T**2 - 40.4199*T + 1.2708e+004
+  sc = -0.0215*T**2 + 28.7138*T - 5.5267e+003
+
+  !L = -11.2373*T**2 + 2.5326d+03*T + 1.4099d+06
+
+end subroutine latheat_NH3
+
+
+! ---------------------
+! H2O
+! ---------------------
+
+subroutine base ( t, rho, ab, cvb, dpdrb, dpdtb, gb, hb, pb, sb, ub )
+!
+!*******************************************************************************
+!
+!! BASE calculates quantities associated with the base Helmholtz function.
+!
+!
+!  Discussion:
+!
+!    The equation for the base Helmholtz function AB(T,RHO) is:
+!
+!      AB(T,RHO) = R * T * (
+!        - ln ( 1 - y ) 
+!        - ( beta - 1 ) / ( 1 - y ) 
+!        + ( alpha + beta + 1 ) / ( 2 * ( 1 - y )**2 )
+!        + 4 * y * ( ( Bbar / b ) - gamma ) 
+!        - 0.5 * ( alpha - beta + 3 ) 
+!        + ln ( RHO * R * T / P0 ) )
+!                                                      (Equation 2)
+!   where 
+!
+!     y = b * rho / 4, 
+!     alpha = 11,
+!     beta = 133/3, 
+!     gamma = 7/2, 
+!     P0 = 0.101325 MegaPascals = 1 atm
+!
+!   and
+!
+!     b(T) = b1 * ln(T/T0) + sum(j=0,1,3,5) b(j)*(T0/T)**j  (Equation 3)
+!
+!     Bbar(T) = sum(j=0,1,2,4) B(j)*(T0/T)**j               (Equation 4).
+!
+!   where 
+!
+!     T0=647.073 K and the coefficients b(j) and B(j) are
+!    
+!     j    b(j)                         B(j)
+!    --    -----------                  ----------
+!     0    0.7478629                    1.1278334
+!     1   -0.3540782                   -0.5944001
+!     2    0                           -5.010996
+!     3    0.007159876                  0
+!     4    0                            0.63684256
+!     5   -0.003528426                  0
+!
+!  For the derived quantities, the following relations are used:
+!
+!    Pressure:                  PB      = RHO**2 * dAB/dRHO
+!    Density derivative:        DPDRB   = 2*PB/RHO + RHO**2 * d2AB/dRHO2
+!    Temperature derivative:    DPDTB   = RHO**2 * d2AB/(dRHO dT)
+!    Specific entropy:          SB      = ( UB - AB ) / T
+!    Specific internal energy:  UB      = AB + T * SB
+!    Specific enthalpy:         HB      = UB + PB / RHO
+!    Specific heat capacity
+!      at constant volume:      CVB     = - T * d2AB/dT2
+!    Specific Gibbs function:   GB      = AB + PB / RHO
+!
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Modified:
+!
+!    03 February 2002
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Input, double precision RHO, the density, in G/CM3.
+!
+!    Output, double precision AB, the base value of the Helmholtz function,
+!    in KJ/kg.
+!
+!    Output, double precision CVB, the base value of the isochoric (constant 
+!    volume) heat capacity, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision DPDRB, the base value of the partial
+!    derivative dP(T,RHO)/dRHO, with T held fixed, in (MegaPascals CM3)/G.
+!
+!    Output, double precision DPDTB, the base value of the partial
+!    derivative dP(T,RHO)/dT, with RHO held fixed, in 
+!    MegaPascals/degrees Kelvin.
+!
+!    Output, double precision GB, the base value of the Gibbs free energy,
+!    in KJ/kg.
+!
+!    Output, double precision HB, the base value of enthalpy, in KJ/kg.
+!
+!    Output, double precision PB, the base pressure, in MegaPascals.
+!
+!    Output, double precision SB, the base value of entropy, 
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision UB, the base value of internal energy, 
+!    in KJ/kg.
+!
+  implicit none
+!
+  double precision ab
+  double precision, parameter :: alpha = 11.0D+00
+  double precision b1
+  double precision b1t
+  double precision b1tt
+  double precision b2
+  double precision b2t
+  double precision b2tt
+  double precision, parameter :: beta = 44.333333333333D+00
+  double precision cvb
+  double precision dpdrb
+  double precision dpdtb
+  double precision dz
+  double precision dz0
+  double precision, parameter :: gamma = 3.5D+00
+  double precision gascon
+  double precision gb
+  double precision hb
+  double precision, parameter :: p_zero = 0.101325D+00
+  double precision pb
+  double precision rho
+  double precision sb
+  double precision t
+  double precision ub
+  double precision x
+  double precision y
+  double precision z
+  double precision z0
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'BASE - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Refuse to handle zero or negative density.
+!
+  if ( rho <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'BASE - Fatal error!'
+    write ( *, '(a)' ) '  The input density RHO must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
+    stop
+  end if
+!
+!  Compute auxilliary quantities for Equation 2.
+!
+  call bb ( t, b1, b2, b1t, b2t, b1tt, b2tt )
+
+  y = 0.25D+00 * b1 * rho
+
+  x = 1.0D+00 - y
+!
+!  Evaluate Equation 2.
+!
+  ab =   - log ( 1.0D+00 - y ) &
+         - ( beta - 1.0D+00 ) / ( 1.0D+00 - y ) &
+         + ( alpha + beta + 1.0D+00 ) / ( 2.0D+00 * ( 1.0D+00 - y )**2 ) &
+         + 4.0D+00 * y * ( ( b2 / b1 ) - gamma ) &
+         - 0.5D+00 * ( alpha - beta + 3.0D+00 ) &
+         + log ( rho * gascon() * t / p_zero )
+!
+!  Determine quantities defined in terms of AB.
+!
+  pb = ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**3 &
+    + 4.0D+00 * y * ( b2 / b1 - gamma )
+
+  z0 = ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**3
+
+  z = z0 + 4.0D+00 * y * ( b2 / b1 - gamma )
+
+  dz0 = ( alpha + 2.0D+00 * beta * y ) / ( 1.0D+00 - y )**3 &
+    + 3.0D+00 * ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**4
+
+  dz = dz0 + 4.0D+00 * ( b2 / b1 - gamma )
+
+  gb = ab + pb
+
+  ub = - t * b1t * ( pb - 1.0D+00 - rho * b2 ) / b1 - rho * t * b2t
+
+  hb = pb + ub
+!
+!  An incorrect version of this equation began:
+!
+!    cvb = 2.0D+00 * ub + ( pb - 1.0D+00 ) &
+!
+!  and caused me no end of trouble.  My fault, JVB, 03 February 2002
+!
+  cvb = 2.0D+00 * ub + ( z0 - 1.0D+00 ) &
+    * ( ( t * b1t / b1 )**2 - t**2 * b1tt / b1 ) &
+    - rho * t**2 * ( b2tt - gamma * b1tt ) - ( t * b1t / b1 )**2 * y * dz0
+
+  dpdtb = pb / t + rho * ( 0.25D+00 * ( dz0 + 4.0D+00 * ( b2 / b1 - gamma ) ) &
+    * b1t + b2t - b2 / b1 * b1t )
+
+  sb = ub - ab
+
+  dpdrb = pb + y * ( dz0 + 4.0D+00 * ( b2 / b1 - gamma ) )
+!
+!  Assign dimensions.
+!
+  ab =    gascon() * t       * ab
+  cvb =   gascon()           * cvb
+  dpdrb = gascon() * t       * dpdrb
+  dpdtb = gascon() * t * rho * dpdtb
+  gb =    gascon() * t       * gb
+  hb =    gascon() * t       * hb
+  pb =    gascon() * t * rho * pb
+  sb =    gascon()           * sb
+  ub =    gascon() * t       * ub
+
+  return
+end subroutine base
+
+subroutine bb ( t, b1, b2, b1t, b2t, b1tt, b2tt )
+!
+!*******************************************************************************
+!
+!! BB calculates the B's of equations 3 and 4.  
+!
+!
+!  Discussion:
+!
+!    Here
+!
+!      b(T) = b1 * ln(T/T0) + sum(j=0,1,3,5) b(j)*(T0/T)**j  (Equation 3)
+!
+!      Bbar(T) = sum(j=0,1,2,4) B(j)*(T0/T)**j               (Equation 4).
+!
+!    where 
+!
+!      T0 = 647.073 K 
+!
+!    and the coefficients b(j) and B(j) are
+!    
+!      j    b(j)                         B(j)
+!     --    -----------                  ----------
+!      0    0.7478629                    1.1278334
+!      1   -0.3540782                   -0.5944001
+!      2    0                           -5.010996
+!      3    0.007159876                  0
+!      4    0                            0.63684256
+!      5   -0.003528426                  0
+!
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision B1, the coefficient b from equation 3, 
+!    in CM3/G.
+!
+!    Output, double precision B2, the coefficient Bbar from equation 4, 
+!    in CM3/G.
+!
+!    Output, double precision B1T, the derivative dB1/dT, 
+!    in (CM3)/(G Degrees Kelvin).
+!
+!    Output, double precision B2T, the derivative dB2/dT, 
+!    in (CM3)/(G Degrees Kelvin).
+!
+!    Output, double precision B1TT, the second derivative of B1 with 
+!    respect to T, in (CM3)/(G (Degrees Kelvin)**2 ).
+!
+!    Output, double precision B2TT, the second derivative of B2 with 
+!    respect to T, in (CM3)/(G (Degrees Kelvin)**2 ).
+!
+  implicit none
+!
+  double precision b1
+  double precision b1t
+  double precision b1tt
+  double precision b2
+  double precision b2t
+  double precision b2tt
+  double precision, parameter, dimension ( 10 ) :: bp = (/ &
+    0.7478629D+00,   -0.3540782D+00,    0.0D+00,           0.0D+00, &
+    0.007159876D+00,  0.0D+00,         -0.003528426D+00,   0.0D+00, &
+    0.0D+00,          0.0D+00 /)
+  double precision, parameter, dimension ( 10 ) :: bq = (/ &
+    1.1278334D+00,    0.0D+00,         -0.5944001D+00,   -5.010996D+00, &
+    0.0D+00,          0.63684256D+00,   0.0D+00,          0.0D+00, &
+    0.0D+00,          0.0D+00 /)
+  integer i
+  double precision t
+  double precision, parameter :: t_ref = 647.073D+00
+  double precision v(10)
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'BB - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Set V(I) = ( T_REF / T )**(I-1).
+!
+  v(1) = 1.0D+00
+  do i = 2, 10
+    v(i) = v(i-1) * t_ref / t
+  end do
+!
+!  Set B1, B1T, B1TT.
+!
+  b1 = bp(1) + bp(2) * log ( 1.0D+00 / v(2) )
+  b1t = bp(2) * v(2) / t_ref
+  b1tt = 0.0D+00
+  do i = 3, 10
+    b1 = b1 + bp(i) * v(i-1)
+    b1t = b1t - dble ( i - 2 ) * bp(i) * v(i-1) / t
+    b1tt = b1tt + bp(i) * dble ( i - 2 )**2 * v(i-1) / t**2
+  end do
+
+  b1tt = b1tt -  ( b1t / t )
+!
+!  Set B2, B2T, B2TT.
+!
+  b2 = bq(1)
+  b2t = 0.0D+00
+  b2tt = 0.0D+00
+  do i = 3, 10
+    b2 = b2 + bq(i) * v(i-1)
+    b2t = b2t - dble ( i - 2 ) * bq(i) * v(i-1) / t
+    b2tt = b2tt + bq(i) * dble ( i - 2 )**2 * v(i-1) / t**2
+  end do
+
+  b2tt = b2tt - ( b2t / t )
+
+  return
+end subroutine bb
+
+
+subroutine ideal ( t, ai, cpi, cvi, gi, hi, si, ui )
+!
+!*******************************************************************************
+!
+!! IDEAL computes ideal gas thermodynamic properties of water.
+!
+!
+!  Discussion:
+!
+!    Values for thermodynamic properties of water in the ideal
+!    gas state were reported by Woolley.  The formula for the ideal gas
+!    term of the Helmholtz function approximates a term by term summation of 
+!    contributions from each of the rotation and vibration states.  
+!    The formula, equation #6 in the reference, is:
+!   
+!    A(ideal)(T) = -R * T * ( 1 + ( C(1)/Tr + C(2) ) * ln(Tr)
+!      + Sum ( 3 <= I <= 18) C(I) * Tr**(I-6)
+!   
+!    where Tr=T/100 K.  The C(i) are tabulated coefficients.  Equation
+!    6 can be used for temperatures below 3000 K, and is accurate to
+!    within the tolerance of the gas constant for 50<=T<=2000 K.
+!     
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision AI, the Helmholtz function, in KJ/kg.
+!
+!    Output, double precision CPI, the heat capacity at constant pressure,
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision CVI, the heat capacity at constant volume,
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision GI, the Gibbs free energy, in KJ/kg.
+!
+!    Output, double precision HI, the enthalpy, in KJ/kg.
+!
+!    Output, double precision SI, the entropy, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision UI, the internal energy, in KJ/kg.
+!
+  implicit none
+!
+  double precision ai
+  double precision, parameter, dimension ( 18 ) :: c = (/ &
+   19.730271018D+00,      20.9662681977D+00,     -0.483429455355D+00, &
+    6.05743189245D+00,    22.56023885D+00,       -9.87532442D+00, &
+   -4.3135538513D+00,      0.458155781D+00,      -0.047754901883D+00, &
+    0.0041238460633D+00,  -0.00027929052852D+00,  0.14481695261D-04, &
+   -0.56473658748D-06,     0.16200446D-07,       -0.3303822796D-09, &
+    0.451916067368D-11,   -0.370734122708D-13,    0.137546068238D-15 /)
+  double precision cpi
+  double precision cvi
+  double precision gascon
+  double precision gi
+  double precision hi
+  integer i
+  double precision si
+  double precision t
+  double precision temp
+  double precision tt
+  double precision ui
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'IDEAL - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+
+  tt = t / 100.0D+00
+
+  gi = - ( c(1) / tt + c(2) ) * log ( tt )
+  do i = 3, 18
+    gi = gi - c(i) * tt**(i-6)
+  end do
+
+  hi = c(2) + c(1) * ( 1.0D+00 - log ( tt ) ) / tt
+  do i = 3, 18
+    hi = hi + dble ( i - 6 ) * c(i) * tt**(i-6)
+  end do
+
+  cpi = c(2) - c(1) / tt
+  do i = 3, 18
+    cpi = cpi + dble ( ( i - 6 ) * ( i - 5 ) ) * c(i) * tt**(i-6)
+  end do
+
+  ai = gi - 1.0D+00
+  ui = hi - 1.0D+00
+  cvi = cpi - 1.0D+00
+  si = hi - gi
+!
+!  Assign dimensions.
+!
+  ai =  gascon() * t * ai
+  cpi = gascon()     * cpi
+  cvi = gascon()     * cvi
+  gi =  gascon() * t * gi
+  hi =  gascon() * t * hi
+  si =  gascon()     * si
+  ui =  gascon() * t * ui
+
+  return
+end subroutine ideal
+
+
+subroutine resid ( t, rho, ar, cvr, dpdrr, dpdtr, gr, hr, pr, sr, ur )
+!
+!*******************************************************************************
+!
+!! RESID calculates residual contributions to thermodynamic quantities.
+!
+!
+!  Discussion:
+!
+!    The residual function consists of 40 terms.  The first 36 are
+!    used in a global least squares fit to experimental data.
+!
+!    Three terms were added that contribute only in the immediate
+!    neighborhood of the critical point 
+!      (tk-5) <= T <= (tk+5) C
+!      0.20   <= rho <= 0.44 g/cm3, 
+!
+!    A single term was added for the region of high pressure and 
+!    low temperature: T < 75 C, P > 300 MPa.
+!
+!    Except in these limited regions, the residual function is
+!    given by the first 36 terms.  The equation is
+!   
+!      A(residual)(rho,T)=
+!        sum(i=1 to 36) (g(i)/k(i)) * (T0/T)**(l(i)) (1-exp(-rho))**(k(i))
+!      + sum(i=37 to 40) g(i)*delta(i)**(k(i))
+!        * exp(-alpha(i)*delta(i)**(k(i)) - beta(i)*tau(i)**2)
+!                                                     (Equation 5)
+!   
+!    where
+!
+!      g(i) are coefficients determined by fits to data,
+!      delta(i) are reduced densities (delta(i)=((rho-rho(i))/rho(i))
+!      tau(i) are reduced temperatures (tau(i)=((T-tau(i))/tau(i))
+!      rho(i) are specified densities.
+!      tau(i) are specified temperatures.
+!      The k(i) and l(i) are specified integers.
+!   
+!  Modified:
+!
+!    22 November 1998
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Input, double precision RHO, the density, in G/CM3.
+!
+!    Output, double precision AR, the residual contribution to the 
+!    Helmholtz function, in KJ/kg.
+!
+!    Output, double precision CVR, the residual contribution to the 
+!    isochoric (constant volume) heat capacity, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision DPDRR, the residual contribution to 
+!    the partial derivative dP(T,RHO)/dRHO, with T held fixed, in 
+!    (MegaPascals CM3)/G.
+!
+!    Output, double precision DPDTR, the residual contribution to 
+!    the partial derivative dP(T,RHO)/dT, with RHO held fixed, 
+!    in MegaPascals/degrees Kelvin.
+!
+!    Output, double precision GR, the residual contribution to the Gibbs 
+!    function, in KJ/kg.
+!
+!    Output, double precision HR, the residual contribution to the 
+!    enthalpy, in KJ/kg.
+!
+!    Output, double precision PR, the residual contribution to the pressure, 
+!    in MegaPascals.
+!
+!    Output, double precision SR, the residual contribution to the entropy, 
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision UR, the residual contribution to the 
+!    internal energy, in KJ/kg.
+!
+  implicit none
+!
+  double precision, parameter, dimension ( 4 ) :: aad = (/ &
+    34.0D+00, 40.0D+00, 30.0D+00, 1050.0D+00 /)
+  double precision, parameter, dimension ( 4 ) :: aat = (/ &
+    20000.0D+00, 20000.0D+00, 40000.0D+00, 25.0D+00 /)
+  double precision, parameter, dimension ( 4 ) :: adz = (/ &
+    0.319D+00, 0.319D+00, 0.319D+00, 1.55D+00 /)
+  double precision ar
+  double precision att
+  double precision, parameter, dimension ( 4 ) ::  atz = (/ &
+    640.0D+00, 640.0D+00, 641.6D+00, 270.0D+00 /)
+  double precision cvr
+  double precision dadt
+  double precision ddz
+  double precision del
+  double precision dex
+  double precision dfdt
+  double precision dpdrr
+  double precision dpdtr
+  double precision e
+  double precision errtol
+  double precision ex0
+  double precision ex1
+  double precision ex2
+  double precision fct
+  double precision, parameter, dimension ( 40 ) :: g = (/ &
+    -530.62968529023D+00,  0.22744901424408D+04, 0.78779333020687D+03, &
+    -69.830527374994D+00,  0.17863832875422D+05,-0.39514731563338D+05, &
+    0.33803884280753D+05, -0.13855050202703D+05,-0.25637436613260D+06, &
+    0.48212575981415D+06, -0.34183016969660D+06, 0.12223156417448D+06, &
+    0.11797433655832D+07, -0.21734810110373D+07, 0.10829952168620D+07, &
+   -0.25441998064049D+06, -0.31377774947767D+07, 0.52911910757704D+07, &
+   -0.13802577177877D+07, -0.25109914369001D+06, 0.46561826115608D+07, &
+   -0.72752773275387D+07,  0.41774246148294D+06, 0.14016358244614D+07, &
+   -0.31555231392127D+07,  0.47929666384584D+07, 0.40912664781209D+06, &
+   -0.13626369388386D+07,  0.69625220862664D+06,-0.10834900096447D+07, &
+   -0.22722827401688D+06,  0.38365486000660D+06, 0.68833257944332D+04, &
+    0.21757245522644D+05, -0.26627944829770D+04,-0.70730418082074D+05, &
+   -0.225D+00, -1.68D+00, 0.055D+00, -93.0D+00 /)
+  double precision gascon
+  double precision gr
+  double precision hr
+  integer i
+  integer, parameter, dimension ( 40 ) :: ii = (/ &
+    0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6, &
+    8,8,8,8,2,2,0,4,2,2,2,4 /)
+  integer j
+  integer, parameter, dimension ( 40 ) :: jj = (/ &
+    2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,&
+    2,3,5,7,1,4,4,4,0,2,0,0 /)
+  integer k
+  integer l
+  integer nc
+  double precision pr
+  double precision q10
+  double precision q20
+  double precision q2a
+  double precision q5t
+  double precision qm
+  double precision qp
+  double precision qr(11)
+  double precision qt(10)
+  double precision rho
+  double precision sr
+  double precision, parameter :: s_ref = 7.6180720166752D+00
+  double precision t
+  double precision, parameter :: t_ref = 647.073D+00
+  double precision tau
+  double precision tx
+  double precision, parameter :: u_ref = - 4328.4549774261D+00
+  double precision ur
+  double precision v
+!
+  errtol = sqrt ( epsilon ( errtol ) )
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'RESID - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Refuse to handle zero or negative density.
+!
+  if ( rho <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'RESID - Fatal error!'
+    write ( *, '(a)' ) '  The input density RHO must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
+    stop
+  end if
+
+  nc = 36
+  dpdrr = 0.0D+00
+  pr = 0.0D+00
+  ar = 0.0D+00
+  dadt = 0.0D+00
+  cvr = 0.0D+00
+  dpdtr = 0.0D+00
+
+  ex0 = - rho
+! ex0 = max ( ex0, - 225.0D+00 )
+! ex0 = min ( ex0, 225.0D+00 )
+  e = exp ( ex0 )
+
+  q10 = rho * rho * e
+  q20 = 1.0D+00 - e
+
+  qr(1) = 0.0D+00
+  qr(2) = q10
+  do i = 2, 10
+    qr(i+1) = qr(i) * q20
+  end do
+
+  v = t_ref / t
+  qt(1) = t / t_ref
+  do i = 2, 10
+    qt(i) = qt(i-1) * v
+  end do
+
+  do i = 1, nc
+
+    k = ii(i) + 1
+    l = jj(i)
+    qp = g(i) * qr(k+1) * qt(l+1)
+    pr = pr + qp
+
+    dpdrr = dpdrr + ( 2.0D+00 / rho - ( 1.0D+00 - e * dble ( k - 1 ) / &
+      ( 1.0D+00 - e ) ) ) * qp
+
+    ar = ar + g(i) * qr(k+2) * qt(l+1) / ( rho**2 * e * dble ( k ) &
+      * gascon ( ) * t )
+
+    dfdt = ( 1.0D+00 - e )**k * dble ( 1 - l ) * qt(l+2) / t_ref / dble ( k )
+
+    dadt = dadt + g(i) * dfdt
+
+    dpdtr = dpdtr + g(i) * dfdt * rho**2 * e * dble ( k ) / ( 1.0D+00 - e )
+
+    cvr = cvr + g(i) * dble ( l ) * dfdt / gascon()
+
+  end do
+
+  qp = 0.0D+00
+  q2a = 0.0D+00
+
+  do j = 37, 40
+
+    k = ii(j)
+    ddz = adz(j-36)
+    del = rho / ddz - 1.0D+00
+
+    if ( abs ( del ) < errtol ) then
+      del = errtol
+    end if
+
+    ex1 = - aad(j-36) * del**k
+!   ex1 = max ( ex1, - 225.0D+00 )
+!   ex1 = min ( ex1, 225.0D+00 )
+    dex = exp ( ex1 ) * del**jj(j)
+
+    att = aat(j-36)
+    tx = atz(j-36)
+    tau = ( t / tx ) - 1.0D+00
+
+    ex2 = - att * tau**2
+!   ex2 = max ( ex2, - 225.0D+00 )
+!   ex2 = min ( ex2, 225.0D+00 )
+    q10 = dex * exp ( ex2 )
+
+    qm = dble ( jj(j) ) / del - dble ( k ) * aad(j-36) * del**(k-1)
+    fct = qm * rho**2 * q10 / ddz
+
+    q5t = fct * ( 2.0D+00 / rho + qm / ddz ) - ( rho / ddz )**2 * q10 * &
+      ( dble ( jj(j) ) / del**2 + dble ( k * ( k - 1 ) ) * aad(j-36) * &
+      del**(k-2) )
+
+    dpdrr = dpdrr + q5t * g(j)
+    qp = qp + g(j) * fct
+    dadt = dadt - 2.0D+00 * g(j) * att * tau * q10 / tx
+    dpdtr = dpdtr - 2.0D+00 * g(j) * att * tau * fct / tx
+
+    q2a = q2a + t * g(j) * att * ( 4.0D+00 * ex2 + 2.0D+00 ) * q10 / tx**2
+
+    ar = ar + q10 * g(j) / ( gascon() * t )
+
+  end do
+
+  cvr = cvr + q2a / gascon()
+  pr = pr + qp
+  sr = - dadt / gascon()
+  ur = ar + sr
+!
+!  Assign dimensions.
+!
+  ar =  gascon() * t *  ar
+  cvr = gascon() *     cvr
+  sr =  gascon() *      sr
+  ur =  gascon() * t *  ur
+!
+!  Adjust energies.
+!
+  ar = ar + gascon ( ) * t * s_ref - gascon ( ) * u_ref
+  sr = sr - gascon ( ) * s_ref
+  ur = ur - gascon ( ) * u_ref
+
+  gr = ar + pr / rho
+  hr = ur + pr / rho
+
+  return
+end subroutine resid
+
+subroutine psat_H2O ( t, p )
+!
+!*******************************************************************************
+!
+!! PSAT_H2O makes a rough estimate of the vapor pressure.
+!
+!
+!  Discussion:
+!
+!    The calculation agrees with tabulated data to within
+!    0.02% for temperature to within a degree or so of the critical
+!    temperature.  The approximate vapor pressure can be refined
+!    by imposing the condition that the Gibbs functions of the vapor
+!    and liquid phases be equal.
+!
+!  Modified:
+!
+!    21 November 1998
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision P, the vapor pressure, in MegaPascals.
+!
+  implicit none
+!
+  double precision, parameter, dimension ( 8 ) :: a = (/ &
+    -7.8889166D+00,   2.5514255D+00,   -6.716169D+00, 33.239495D+00, &
+    -105.38479D+00,   174.35319D+00,  -148.39348D+00, 48.631602D+00 /)
+  double precision b
+  integer i
+  double precision p
+  double precision q
+  double precision t
+  double precision, parameter :: t_ref = 647.25D+00
+  double precision v
+  double precision w
+  double precision z
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'PSAT_H2O - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+
+  if ( t <= 314.0D+00 ) then
+
+    p = 0.1D+00 * exp ( 6.3573118D+00 - 8858.843D+00 / t &
+      + 607.56335D+00 * t**( -0.6D+00 ) )
+
+  else
+
+    v = t / t_ref
+    w = abs ( 1.0D+00 - v )
+    b = 0.0D+00
+    do i = 1, 8
+      z = i
+      b = b + a(i) * w**( ( z + 1.0D+00 ) / 2.0D+00 )
+    end do
+
+    q = b / v
+    p = 22.093D+00 * exp ( q )
+
+  end if
+
+  return
+end subroutine psat_H2O
+
+
+subroutine tdpsdt ( t, dp )
+!
+!*******************************************************************************
+!
+!! TDPSDT computes the quantity T * dP(Sat)/dT.
+!
+!
+!  Discussion:
+!
+!    Here T is the temperature and P(Sat) is the vapor pressure.  
+!    It is used by TSAT_EST and TSAT.
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision DP, the value T*(dP(Sat)/dT), 
+!    in MegaPascals.
+!
+  implicit none
+!
+  double precision, parameter, dimension ( 8 ) :: a = (/ &
+      -7.8889166D+00,   2.5514255D+00,   -6.716169D+00, 33.239495D+00, &
+    -105.38479D+00,   174.35319D+00,   -148.39348D+00,  48.631602D+00 /)
+  double precision b
+  double precision c
+  double precision dp
+  integer i
+  double precision q
+  double precision t
+  double precision, parameter :: t_ref = 647.25D+00
+  double precision v
+  double precision w
+  double precision y
+  double precision z
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'TDPSDT - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+
+  v = t / t_ref
+  w = 1.0D+00 - v
+  b = 0.0D+00
+  c = 0.0D+00
+  do i = 1, 8
+    z = dble ( i + 1 ) / 2.0D+00
+    y = a(i) * w**z
+    c = c + ( y / w ) * ( 0.5D+00 - 0.5D+00 * dble ( i ) - 1.0D+00 / v )
+    b = b + y
+  end do
+
+  q = b / v
+  dp = 22.093D+00 * exp ( q ) * c
+
+  return
+end subroutine tdpsdt
+
+
+
+subroutine therm ( t, rho, a, cjth, cjtt, cp, cv, dpdr, dpdt, g, h, p, s, u )
+!
+!*******************************************************************************
+!
+!! THERM calculates thermodynamic functions given temperature and density.
+!
+!
+!  Discussion:
+!
+!    Thermodynamic values were calculated from an analytic equation
+!    that approximates the Helmholtz function (specific Helmholtz
+!    energy) for ordinary water and steam, of the form A=A(rho,T)
+!    where A is the Helmholtz function, rho the density, and T
+!    the absolute (thermodynamic) temperature.  Any thermodynamic
+!    value for any state, liquid, vapor or metastable, may be
+!    calculated by differentiation of this equation in accord with
+!    the first and second laws of thermodynamics.
+! 
+!    The International Association for the Properties of Steam
+!    has provisionally accepted this formulation for the range
+!    273.15 <= T <= 1273.15 degrees Kelvin, where, for 423.15 <= T,
+!    the maximum pressure is Pmax = 1500 MPa = 15000 bar, and for
+!    273.15 <= T < 423.15, the maximum pressure is
+!    Pmax = 100 * (5 + (T-273.15)/15) MPa.
+! 
+!    Close to the critical point, a small region is excluded:
+!    Abs(T-Tk) < 1, abs((rho-rhok)/rhok) < 0.3.
+! 
+!    The equation has a wider useful range, namely, fluid states
+!    of pure, undissociated water and steam defined by
+!    260 <= T <= 2500 K and 0 <= P <= 3000 MPa.
+! 
+!    Thermodynamic property values for specific volume, density,
+!    specific internal energy, specific enthalpy, and specific
+!    entropy of water and steam were tabulated over the range
+!    0 <= t <= 2000 C, 0 <= P <= 3000 MPa.  The reference
+!    state is the liquid at the triple point, for which the
+!    internal energy and entropy have been assigned the value zero.
+!     
+!    Thermodynamic quantities are determined from the Helmholtz function
+!    A(rho,T), which is computed as the sum of three terms:
+!
+!      A(rho,T) = A(base)(rho,T) + A(residual)(rho,T) + A(ideal)(T)
+!                                                       (Equation 1)
+!
+!    Because A(rho,T) is everywhere single valued and analytic,
+!    we can derive closed form relations for all other properties.
+!    In the following, unless otherwise indicated, the independent
+!    variables are temperature T and density RHO, and differentiation
+!    with respect to one variable is to imply that the other is fixed.
+! 
+!    Pressure:                  P       = RHO**2 * dA/dRHO
+!    Density derivative:        dP/dRHO = 2*P/RHO + RHO**2 * d2A/dRHO2
+!    Temperature derivative:    dP/dT   = RHO**2 * d2A/(dRHO dT)
+!    Specific entropy:          S       = - dA/dT
+!    Specific internal energy:  U       = A + T*S
+!    Specific enthalpy:         H       = U + P/RHO
+!    Specific heat capacity
+!      at constant volume:      Cv      = - T * d2A/dT2
+!    Specific Gibbs function:   G       = A + P/RHO
+!    Specific heat capacity
+!      at constant pressure:    Cp      = Cv + (T*(dP/dT)**2)/(RHO**2*dP/dRHO)
+!    Speed of sound:            Omega   = Sqrt ((Cp/Cv) * dP/dRHO)
+!    Second virial coefficient: B       = 1/(2*R*T) * (d2P/dRHO2) (at RHO=0)
+!    Isothermal Joule-Thomson
+!      coefficient:             DeltaT  = (dH/dP) (fixed T) =
+!                                         (1/RHO)-(T*dP/dT)/(RHO**2*dP/dRHO)
+!    Joule-Thomson coefficient: Mu      = (dT/dP) (fixed H) = DeltaT/Cp
+!    Isentropic temperature-
+!      pressure coefficient:    BetaS   = (dT/dP) (fixed S) =
+!                                         (DeltaT - 1/RHO)/Cp
+!   
+!  Modified:
+!
+!    19 November 1998
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Input, double precision RHO, the fluid density, in G/CM3.
+!
+!    Output, double precision A, the Helmholtz function, in KJ/kg.
+!
+!    Output, double precision CJTH, the Joule-Thomson coefficient,
+!    in K/MegaPascals.
+!
+!    Output, double precision CJTT, the isothermal Joule-Thomson coefficient,
+!    in CM3/G.
+!
+!    Output, double precision CP, the isobaric (constant pressure) heat
+!    capacity, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision CV, the isochoric (constant volume) heat capacity,
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision DPDR, the partial derivative 
+!    dP(T,RHO)/dRHO, with T held fixed, in MegaPascals*CM3/G.
+!
+!    Output, double precision DPDT, the partial derivative 
+!    dP(T,RHO)/dT, with RHO held fixed, in MegaPascals/degrees Kelvin.
+!
+!    Output, double precision G, the Gibbs free energy, in KJ/kg.
+!
+!    Output, double precision H, the enthalpy, in KJ/kg.
+!
+!    Output, double precision P, the pressure, in MegaPascals.
+!
+!    Output, double precision S, the entropy, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision U, the internal energy, in KJ/kg.
+!
+  implicit none
+!
+  double precision a
+  double precision ab
+  double precision ai
+  double precision ar
+  double precision cjth
+  double precision cjtt
+  double precision cp
+  double precision cpi
+  double precision cv
+  double precision cvb
+  double precision cvi
+  double precision cvr
+  logical, parameter :: debug = .false.
+!  logical, parameter :: debug = .true.
+  double precision dpdr
+  double precision dpdrb
+  double precision dpdrr
+  double precision dpdt
+  double precision dpdtb
+  double precision dpdtr
+  double precision g
+  double precision gb
+  double precision gi
+  double precision gr
+  double precision h
+  double precision hb
+  double precision hi
+  double precision hr
+  double precision p
+  double precision pb
+  double precision pr
+  double precision rho
+  double precision s
+  double precision sb
+  double precision si
+  double precision sr
+  double precision t
+  double precision u
+  double precision ub
+  double precision ui
+  double precision ur
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'THERM - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Refuse to handle zero or negative density.
+!
+  if ( rho <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'THERM - Fatal error!'
+    write ( *, '(a)' ) '  The input density RHO must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
+    stop
+  end if
+
+  call ideal ( t, ai, cpi, cvi, gi, hi, si, ui )
+
+  call resid ( t, rho, ar, cvr, dpdrr, dpdtr, gr, hr, pr, sr, ur )
+
+  call base ( t, rho, ab, cvb, dpdrb, dpdtb, gb, hb, pb, sb, ub )
+
+  a =       ab +    ar +  ai
+  cv =     cvb +   cvr + cvi
+
+  if ( debug ) then
+    write ( *, * ) ' '
+    write ( *, * ) 'THERM:'
+    write ( *, * ) '  CVB = ', cvb
+    write ( *, * ) '  CVR = ', cvr
+    write ( *, * ) '  CVI = ', cvi
+    write ( *, * ) '  CV  = ', cv
+  end if
+
+
+  dpdr = dpdrb + dpdrr
+  dpdt = dpdtb + dpdtr
+  p =       pb +    pr
+  s =       sb +    sr +  si
+  u =       ub +    ur +  ui
+
+  if ( debug ) then
+    write ( *, * ) ' '
+    write ( *, * ) 'THERM:'
+    write ( *, * ) '  UB = ', ub
+    write ( *, * ) '  UR = ', ur
+    write ( *, * ) '  UI = ', ui
+  end if
+
+  g = a + p / rho
+  h = u + p / rho
+  cp = cv + t * dpdt**2 / ( dpdr * rho**2 )
+  cjtt = 1.0D+00 / rho - t * dpdt / ( dpdr * rho**2 )
+  cjth = - cjtt / cp
+
+  return
+end subroutine therm
+
+function gascon ( )
+!
+!*******************************************************************************
+!
+!! GASCON returns the value of the specific gas constant.
+!
+!
+!  Note:
+!
+!    The specific gas constant R is related to the universal gas
+!    constant R-bar = 8.31441 J/(mol degrees Kelvin) by the molar mass 
+!    M = 18.0152 g/mol:
+!
+!      R = R-bar / M.
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Output, double precision GASCON, the value of the specific gas 
+!    constant, in J/(g degrees Kelvin).
+!
+  implicit none
+!
+  double precision gascon
+!
+  gascon = 0.461522D+00
+ 
+  return
+end function gascon
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phyetat0.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phyetat0.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phyetat0.F90	(revision 222)
@@ -0,0 +1,399 @@
+subroutine phyetat0 (ngrid,fichnom,tab0,Lmodif,nsoil,nq, &
+                     day_ini,time,tsurf,tsoil, &
+                     emis,q2,qsurf,cloudfrac,totcloudfrac,hice, &
+                     rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+
+  USE infotrac, ONLY: tname
+  USE surfdat_h, only: phisfi, albedodat, zmea, zstd, zsig, zgam, zthe
+  use iostart, only: nid_start, open_startphy, close_startphy, &
+                     get_field, get_var, inquire_field, &
+                     inquire_dimension, inquire_dimension_length
+  use slab_ice_h, only: noceanmx
+
+  implicit none
+
+!======================================================================
+! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+!  Adaptation à Mars : Yann Wanherdrick 
+! Objet: Lecture de l etat initial pour la physique
+!======================================================================
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "dimphys.h"
+#include "planete.h"
+#include "comcstfi.h"
+
+!======================================================================
+!  INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+!  PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+!======================================================================
+!  Arguments:
+!  ---------
+!  inputs:
+  integer,intent(in) :: ngrid
+  character*(*),intent(in) :: fichnom ! "startfi.nc" file
+  integer,intent(in) :: tab0
+  integer,intent(in) :: Lmodif
+  integer,intent(in) :: nsoil ! # of soil layers
+  integer,intent(in) :: nq
+  integer,intent(in) :: day_ini
+  real,intent(in) :: time
+
+!  outputs:
+  real,intent(out) :: tsurf(ngrid) ! surface temperature
+  real,intent(out) :: tsoil(ngrid,nsoil) ! soil temperature
+  real,intent(out) :: emis(ngrid) ! surface emissivity
+  real,intent(out) :: q2(ngrid, llm+1) ! 
+  real,intent(out) :: qsurf(ngrid,nq) ! tracers on surface
+! real co2ice(ngrid) ! co2 ice cover
+  real,intent(out) :: cloudfrac(ngrid,nlayermx)
+  real,intent(out) :: hice(ngrid), totcloudfrac(ngrid)
+  real,intent(out) :: pctsrf_sic(ngrid),tslab(ngrid,noceanmx)  
+  real,intent(out) :: tsea_ice(ngrid),sea_ice(ngrid)
+  real,intent(out) :: rnat(ngrid)
+
+!======================================================================
+!  Local variables:
+
+!      INTEGER radpas
+!      REAL co2_ppm
+!      REAL solaire
+
+      real xmin,xmax ! to display min and max of a field
+!
+      INTEGER ig,iq,lmax
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf
+!      integer isoil 
+!      INTEGER length
+!      PARAMETER (length=100)
+      CHARACTER*7 str7
+      CHARACTER*2 str2
+      CHARACTER*1 yes
+!
+      REAL p_rad,p_omeg,p_g,p_cpp,p_mugaz,p_daysec
+      INTEGER nqold
+
+! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...)
+!      logical :: oldtracernames=.false.
+      integer :: count
+      character(len=30) :: txt ! to store some text
+      
+      INTEGER :: indextime=1 ! index of selected time, default value=1
+      logical :: found
+
+!
+! ALLOCATE ARRAYS IN surfdat_h
+!
+IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(ngrid))
+IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(ngrid))
+IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(ngrid))
+IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(ngrid))
+IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(ngrid))
+IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(ngrid))
+IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(ngrid))
+
+
+! open physics initial state file:
+call open_startphy(fichnom)
+
+
+! possibility to modify tab_cntrl in tabfi
+write(*,*)
+write(*,*) 'TABFI in phyeta0: Lmodif=',Lmodif," tab0=",tab0
+call tabfi (ngrid,nid_start,Lmodif,tab0,day_ini,lmax,p_rad, &
+                   p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
+
+!c
+!c Lecture des latitudes (coordonnees):
+!c
+!      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+!         CALL abort
+!      ENDIF
+!#ifdef NC_DOUBLE
+!      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,lati)
+!#else
+!      ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,lati)
+!#endif
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
+!         CALL abort
+!      ENDIF
+!c
+!c Lecture des longitudes (coordonnees):
+!c
+!      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+!         CALL abort
+!      ENDIF
+!#ifdef NC_DOUBLE
+!      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,long)
+!#else
+!      ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,long)
+!#endif
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
+!         CALL abort
+!      ENDIF
+!c
+!c Lecture des aires des mailles:
+!c
+!      ierr = NF_INQ_VARID (nid, "area", nvarid)
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Le champ <area> est absent'
+!         CALL abort
+!      ENDIF
+!#ifdef NC_DOUBLE
+!      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,sta,ngrid,area)
+!#else
+!      ierr = NF_GET_VARA_REAL(nid,nvarid,sta,ngrid,area)
+!#endif
+!      IF (ierr.NE.NF_NOERR) THEN
+!         PRINT*, 'phyetat0: Lecture echouee pour <area>'
+!         CALL abort
+!      ENDIF
+!      xmin = 1.0E+20
+!      xmax = -1.0E+20
+!      xmin = MINVAL(area)
+!      xmax = MAXVAL(area)
+!      PRINT*,'Aires des mailles <area>:', xmin, xmax
+
+! Load surface geopotential:
+call get_field("phisfi",phisfi,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <phisfi>"
+  call abort
+else
+  write(*,*) "phyetat0: surface geopotential <phisfi> range:", &
+             minval(phisfi), maxval(phisfi)
+endif
+
+! Load bare ground albedo:
+call get_field("albedodat",albedodat,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <albedodat>"
+  call abort
+else
+  write(*,*) "phyetat0: Bare ground albedo <albedodat> range:", &
+             minval(albedodat), maxval(albedodat)
+endif
+
+! ZMEA
+call get_field("ZMEA",zmea,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZMEA>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZMEA> range:", &
+             minval(zmea), maxval(zmea)
+endif
+
+! ZSTD
+call get_field("ZSTD",zstd,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZSTD>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZSTD> range:", &
+             minval(zstd), maxval(zstd)
+endif
+
+! ZSIG
+call get_field("ZSIG",zsig,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZSIG>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZSIG> range:", &
+             minval(zsig), maxval(zsig)
+endif
+
+! ZGAM
+call get_field("ZGAM",zgam,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZGAM>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZGAM> range:", &
+             minval(zgam), maxval(zgam)
+endif
+
+! ZTHE
+call get_field("ZTHE",zthe,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZTHE>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZTHE> range:", &
+             minval(zthe), maxval(zthe)
+endif
+
+! Surface temperature :
+call get_field("tsurf",tsurf,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <tsurf>"
+  call abort
+else
+  write(*,*) "phyetat0: Surface temperature <tsurf> range:", &
+             minval(tsurf), maxval(tsurf)
+endif
+
+! Surface emissivity
+call get_field("emis",emis,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <emis>"
+  call abort
+else
+  write(*,*) "phyetat0: Surface emissivity <emis> range:", &
+             minval(emis), maxval(emis)
+endif
+
+! Cloud fraction (added by BC 2010)
+call get_field("cloudfrac",cloudfrac,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <cloudfrac>"
+  call abort
+else
+  write(*,*) "phyetat0: Cloud fraction <cloudfrac> range:", &
+             minval(cloudfrac), maxval(cloudfrac)
+endif
+
+! Total cloud fraction (added by BC 2010)
+call get_field("totcloudfrac",totcloudfrac,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <totcloudfrac>"
+  call abort
+else
+  write(*,*) "phyetat0: Total cloud fraction <totcloudfrac> range:", &
+             minval(totcloudfrac), maxval(totcloudfrac)
+endif
+
+! Height of oceanic ice (added by BC 2010)
+call get_field("hice",hice,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <hice>"
+!  call abort
+      do ig=1,ngrid
+      hice(ig)=0.
+      enddo
+else
+  write(*,*) "phyetat0: Height of oceanic ice <hice> range:", &
+             minval(hice), maxval(hice)
+endif
+
+! SLAB OCEAN (added by BC 2014)
+! nature of the surface
+call get_field("rnat",rnat,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <rnat>"
+      do ig=1,ngrid
+        rnat(ig)=1.
+      enddo
+else
+      do ig=1,ngrid
+        if((nint(rnat(ig)).eq.2).or.(nint(rnat(ig)).eq.0))then
+          rnat(ig)=0.
+        else
+          rnat(ig)=1.
+        endif      
+      enddo
+
+  write(*,*) "phyetat0: Nature of surface <rnat> range:", &
+             minval(rnat), maxval(rnat)
+endif
+! Pourcentage of sea ice cover
+call get_field("pctsrf_sic",pctsrf_sic,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <pctsrf_sic>"
+      do ig=1,ngrid
+      pctsrf_sic(ig)=0.
+      enddo
+else
+  write(*,*) "phyetat0: Pourcentage of sea ice cover <pctsrf_sic> range:", &
+             minval(pctsrf_sic), maxval(pctsrf_sic)
+endif
+! Slab ocean temperature (2 layers)
+call get_field("tslab",tslab,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <tslab>"
+      do ig=1,ngrid
+      do iq=1,noceanmx
+      tslab(ig,iq)=tsurf(ig)
+      enddo
+      enddo
+else
+  write(*,*) "phyetat0: Slab ocean temperature <tslab> range:", &
+             minval(tslab), maxval(tslab)
+endif
+! Oceanic ice temperature
+call get_field("tsea_ice",tsea_ice,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <tsea_ice>"
+      do ig=1,ngrid
+      tsea_ice(ig)=273.15-1.8
+      enddo
+else
+  write(*,*) "phyetat0: Oceanic ice temperature <tsea_ice> range:", &
+             minval(tsea_ice), maxval(tsea_ice)
+endif
+!  Oceanic ice quantity (kg/m^2)
+call get_field("sea_ice",sea_ice,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <sea_ice>"
+      do ig=1,ngrid
+      tsea_ice(ig)=0.
+      enddo
+else
+  write(*,*) "phyetat0: Oceanic ice quantity <sea_ice> range:", &
+             minval(sea_ice), maxval(sea_ice)
+endif
+
+
+
+
+! pbl wind variance
+call get_field("q2",q2,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <q2>"
+  call abort
+else
+  write(*,*) "phyetat0: PBL wind variance <q2> range:", &
+             minval(q2), maxval(q2)
+endif
+
+! tracer on surface
+if (nq.ge.1) then
+  do iq=1,nq
+    txt=tname(iq)
+    if (txt.eq."h2o_vap") then
+      ! There is no surface tracer for h2o_vap;
+      ! "h2o_ice" should be loaded instead
+      txt="h2o_ice"
+      write(*,*) 'phyetat0: loading surface tracer', &
+                           ' h2o_ice instead of h2o_vap'
+    endif
+    call get_field(txt,qsurf(:,iq),found,indextime)
+    if (.not.found) then
+      write(*,*) "phyetat0: Failed loading <",trim(txt),">"
+      write(*,*) "         ",trim(txt)," is set to zero"
+    else
+      write(*,*) "phyetat0: Surface tracer <",trim(txt),"> range:", &
+                 minval(qsurf(:,iq)), maxval(qsurf(:,iq))
+    endif
+  enddo
+endif ! of if (nq.ge.1)
+
+
+! Call to soil_settings, in order to read soil temperatures,
+! as well as thermal inertia and volumetric heat capacity
+call soil_settings(nid_start,ngrid,nsoil,tsurf,tsoil,indextime)
+!
+! close file:
+!
+call close_startphy
+
+END SUBROUTINE phyetat0
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phyredem.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phyredem.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/phyredem.F90	(revision 222)
@@ -0,0 +1,222 @@
+module phyredem
+
+implicit none
+
+contains
+
+subroutine physdem0(filename,lonfi,latfi,nsoil,ngrid,nlay,nq, &
+                         phystep,day_ini,time,airefi, &
+                         alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
+! create physics restart file and write time-independent variables
+  use comsoil_h, only: volcapa, mlayer
+  use comgeomfi_h, only: area
+  use surfdat_h, only: zmea, zstd, zsig, zgam, zthe, &
+                       albedice, emisice, emissiv, &
+                       iceradius, dtemisice, phisfi
+  use iostart, only : open_restartphy, close_restartphy, & 
+                      put_var, put_field, length
+  use mod_grid_phy_lmdz, only : klon_glo
+
+  implicit none
+#include "planete.h"
+#include "comcstfi.h"
+  character(len=*), intent(in) :: filename
+  real,intent(in) :: lonfi(ngrid)
+  real,intent(in) :: latfi(ngrid)
+  integer,intent(in) :: nsoil
+  integer,intent(in) :: ngrid
+  integer,intent(in) :: nlay
+  integer,intent(in) :: nq
+  real,intent(in) :: phystep
+  real,intent(in) :: day_ini
+  real,intent(in) :: time
+  real,intent(in) :: airefi(ngrid)
+  real,intent(in) :: alb(ngrid)
+  real,intent(in) :: ith(ngrid,nsoil)
+  real,intent(in) :: pzmea(ngrid)
+  real,intent(in) :: pzstd(ngrid)
+  real,intent(in) :: pzsig(ngrid)
+  real,intent(in) :: pzgam(ngrid)
+  real,intent(in) :: pzthe(ngrid)
+ 
+  real :: tab_cntrl(length) ! nb "length=100" defined in iostart module
+  
+  ! Create physics start file
+  call open_restartphy(filename)
+
+! tab_cntrl() contains run parameters
+  tab_cntrl(:)=0 ! initialization
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! Fill control array tab_cntrl(:) with paramleters for this run
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! Informations on the physics grid
+  tab_cntrl(1) = float(klon_glo)  ! number of nodes on physics grid
+  tab_cntrl(2) = float(nlay) ! number of atmospheric layers
+  tab_cntrl(3) = day_ini + int(time)         ! final day 
+  tab_cntrl(4) = time -int(time)            ! final time of day
+
+! Informations about Mars, used by dynamics and physics
+  tab_cntrl(5) = rad      ! radius of Mars (m) ~3397200
+  tab_cntrl(6) = omeg     ! rotation rate (rad.s-1)
+  tab_cntrl(7) = g        ! gravity (m.s-2) ~3.72
+  tab_cntrl(8) = mugaz    ! Molar mass of the atmosphere (g.mol-1) ~43.49
+  tab_cntrl(9) = rcp      !  = r/cp  ~0.256793 (=kappa dans dynamique)
+  tab_cntrl(10) = daysec  ! length of a sol (s)  ~88775
+
+  tab_cntrl(11) = phystep  ! time step in the physics
+  tab_cntrl(12) = 0.
+  tab_cntrl(13) = 0.
+
+! Informations about Mars, only for physics
+  tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
+  tab_cntrl(15) = periastr  ! min. star-planet distance (AU)
+  tab_cntrl(16) = apoastr   ! max. star-planet distance (AU) 
+  tab_cntrl(17) = peri_day  ! date of periastron (sols since N. spring)
+  tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
+
+! Boundary layer and turbulence
+  tab_cntrl(19) = z0        ! surface roughness (m) ~0.01
+  tab_cntrl(20) = lmixmin   ! mixing length ~100
+  tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
+
+! Optical properties of polar caps and ground emissivity
+  tab_cntrl(22) = albedice(1)  ! Albedo of northern cap ~0.5
+  tab_cntrl(23) = albedice(2)  ! Albedo of southern cap ~0.5
+  tab_cntrl(24) = emisice(1)   ! Emissivity of northern cap ~0.95
+  tab_cntrl(25) = emisice(2)   ! Emissivity of southern cap ~0.95
+  tab_cntrl(26) = emissiv      ! Emissivity of martian soil ~.95
+  tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
+  tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
+  tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
+  tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
+
+  tab_cntrl(28) = 0. 
+  tab_cntrl(29) = 0.
+  tab_cntrl(30) = 0.
+
+! Soil properties:
+  tab_cntrl(35) = volcapa ! soil volumetric heat capacity
+
+  call put_var("controle","Control parameters",tab_cntrl)
+  
+  ! Write the mid-layer depths
+  call put_var("soildepth","Soil mid-layer depth",mlayer)
+  
+  ! Write longitudes
+  call put_field("longitude","Longitudes of physics grid",lonfi)
+  
+  ! Write latitudes
+  call put_field("latitude","Latitudes of physics grid",latfi)
+  
+  ! Write mesh areas
+  call put_field("area","Mesh area",area)
+  
+  ! Write surface geopotential
+  call put_field("phisfi","Geopotential at the surface",phisfi)
+  
+  ! Write surface albedo
+  call put_field("albedodat","Albedo of bare ground",alb)
+  
+  ! Subgrid topogaphy variables
+  call put_field("ZMEA","Relief: mean relief",zmea)
+  call put_field("ZSTD","Relief: standard deviation",zstd)
+  call put_field("ZSIG","Relief: sigma parameter",zsig)
+  call put_field("ZGAM","Relief: gamma parameter",zgam)
+  call put_field("ZTHE","Relief: theta parameter",zthe)
+  
+  ! Soil thermal inertia
+  call put_field("inertiedat","Soil thermal inertia",ith)
+  
+  ! Close file
+  call close_restartphy
+  
+end subroutine physdem0
+
+subroutine physdem1(filename,nsoil,ngrid,nlay,nq, &
+                    phystep,time,tsurf,tsoil,emis,q2,qsurf, &
+                    cloudfrac,totcloudfrac,hice, &
+                    rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+  ! write time-dependent variable to restart file
+  use iostart, only : open_restartphy, close_restartphy, & 
+                      put_var, put_field
+  use infotrac, only: tname
+  use slab_ice_h, only: noceanmx
+
+  implicit none
+!======================================================================
+!#include "temps.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "callkeys.h"
+!======================================================================
+  character(len=*),intent(in) :: filename
+  integer,intent(in) :: nsoil
+  integer,intent(in) :: ngrid
+  integer,intent(in) :: nlay
+  integer,intent(in) :: nq
+  real,intent(in) :: phystep
+  real,intent(in) :: time
+  real,intent(in) :: tsurf(ngrid)
+  real,intent(in) :: tsoil(ngrid,nsoil)
+  real,intent(in) :: emis(ngrid)
+  real,intent(in) :: q2(ngrid,nlay+1)
+  real,intent(in) :: qsurf(ngrid,nq)
+  real,intent(in) :: cloudfrac(ngrid,nlay)
+  real,intent(in) :: totcloudfrac(ngrid)
+  real,intent(in) :: hice(ngrid)
+  real,intent(in) :: rnat(ngrid)
+  real,intent(in) :: pctsrf_sic(ngrid)
+  real,intent(in) :: tslab(ngrid,noceanmx)
+  real,intent(in) :: tsea_ice(ngrid)
+  real,intent(in) :: sea_ice(ngrid)
+
+  integer :: iq
+  
+  ! Open file
+  call open_restartphy(filename)
+
+  ! First variable to write must be "Time", in order to correctly
+  ! set time counter in file
+  !call put_var("Time","Temps de simulation",time)
+  
+  ! Surface temperature
+  call put_field("tsurf","Surface temperature",tsurf)
+  
+  ! Soil temperature
+  call put_field("tsoil","Soil temperature",tsoil)
+  
+  ! Emissivity of the surface
+  call put_field("emis","Surface emissivity",emis)
+  
+  ! Planetary Boundary Layer
+  call put_field("q2","pbl wind variance",q2)
+  
+! cloud fraction and sea ice (NB: these should be optional... to be improved)
+  call put_field("cloudfrac","Cloud fraction",cloudfrac)
+  call put_field("totcloudfrac","Total fraction",totcloudfrac)
+  call put_field("hice","Height of oceanic ice",hice)
+
+ !Slab ocean 
+ if(ok_slab_ocean) then
+   call put_field("rnat","Nature of surface",rnat)
+   call put_field("pctsrf_sic","Pourcentage sea ice",pctsrf_sic)
+   call put_field("tslab","Temperature slab ocean",tslab)
+   call put_field("tsea_ice","Temperature sea ice",tsea_ice)
+   call put_field("sea_ice","Sea ice mass",sea_ice)
+ endif!(ok_slab_ocean)
+
+
+! tracers
+  if (nq>0) then
+    do iq=1,nq
+      call put_field(tname(iq),"tracer on surface",qsurf(:,iq))
+    enddo
+  endif ! of if (nq>0)
+
+! close file
+      CALL close_restartphy
+!$OMP BARRIER
+
+end subroutine physdem1
+
+end module phyredem
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/physiq.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/physiq.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/physiq.F90	(revision 222)
@@ -0,0 +1,2273 @@
+      subroutine physiq(ngrid,nlayer,nq,   &
+                  nametrac,                & 
+                  firstcall,lastcall,      &
+                  pday,ptime,ptimestep,    &
+                  pplev,pplay,pphi,        &
+                  pu,pv,pt,pq,             &
+                  pw,                      &
+                  pdu,pdv,pdt,pdq,pdpsrf,tracerdyn)
+ 
+      use radinc_h, only : L_NSPECTI,L_NSPECTV,naerkind
+      use watercommon_h, only : RLVTT, Psat_water,epsi
+      use gases_h, only: gnom, gfrac
+      use radcommon_h, only: sigma, eclipse, glat, grav
+      use radii_mod, only: h2o_reffrad, co2_reffrad, h2o_cloudrad
+      use aerosol_mod, only: iaero_co2, iaero_h2o
+      use surfdat_h, only: phisfi, albedodat, zmea, zstd, zsig, zgam, zthe, &
+                           dryness, watercaptag
+      use comdiurn_h, only: coslat, sinlat, coslon, sinlon
+      use comsaison_h, only: mu0, fract, dist_star, declin
+      use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat
+      USE comgeomfi_h, only: long, lati, area, totarea, totarea_planet
+      USE tracer_h, only: noms, mmol, radius, rho_q, qext, &
+                          alpha_lift, alpha_devil, qextrhor, &
+                          igcm_h2o_ice, igcm_h2o_vap, igcm_dustbin, &
+                          igcm_co2_ice
+      use control_mod, only: ecritphy, iphysiq, nday
+      use phyredem, only: physdem0, physdem1
+      use slab_ice_h
+      use ocean_slab_mod, only :ocean_slab_init, ocean_slab_ice, &
+                                ocean_slab_get_vars,ocean_slab_final
+      use surf_heat_transp_mod,only :init_masquv
+      use planetwide_mod, only: planetwide_minval,planetwide_maxval,planetwide_sumval
+      use mod_phys_lmdz_para, only : is_master
+
+
+      implicit none
+
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Central subroutine for all the physics parameterisations in the
+!     universal model. Originally adapted from the Mars LMDZ model.
+!
+!     The model can be run without or with tracer transport
+!     depending on the value of "tracer" in file "callphys.def".
+!
+!
+!   It includes:
+!
+!      1.  Initialization:
+!      1.1 Firstcall initializations
+!      1.2 Initialization for every call to physiq
+!      1.2.5 Compute mean mass and cp, R and thermal conduction coeff.
+!      2. Compute radiative transfer tendencies
+!         (longwave and shortwave).
+!      4. Vertical diffusion (turbulent mixing):
+!      5. Convective adjustment
+!      6. Condensation and sublimation of gases (currently just CO2).
+!      7. TRACERS
+!       7a. water and water ice
+!       7c. other schemes for tracer transport (lifting, sedimentation)
+!       7d. updates (pressure variations, surface budget)
+!      9. Surface and sub-surface temperature calculations
+!     10. Write outputs :
+!           - "startfi", "histfi" if it's time
+!           - Saving statistics if "callstats = .true."
+!           - Output any needed variables in "diagfi" 
+!     10. Diagnostics: mass conservation of tracers, radiative energy balance etc.
+!
+!   arguments
+!   ---------
+!
+!   input
+!   -----
+!    ecri                  period (in dynamical timestep) to write output
+!    ngrid                 Size of the horizontal grid.
+!                          All internal loops are performed on that grid.
+!    nlayer                Number of vertical layers.
+!    nq                    Number of advected fields
+!    firstcall             True at the first call
+!    lastcall              True at the last call
+!    pday                  Number of days counted from the North. Spring
+!                          equinoxe.
+!    ptime                 Universal time (0<ptime<1): ptime=0.5 at 12:00 UT
+!    ptimestep             timestep (s)
+!    pplay(ngrid,nlayer)   Pressure at the middle of the layers (Pa)
+!    pplev(ngrid,nlayer+1) intermediate pressure levels (pa)
+!    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2s-2)
+!    pu(ngrid,nlayer)      u component of the wind (ms-1)
+!    pv(ngrid,nlayer)      v component of the wind (ms-1)
+!    pt(ngrid,nlayer)      Temperature (K)
+!    pq(ngrid,nlayer,nq)   Advected fields
+!    pudyn(ngrid,nlayer)    \
+!    pvdyn(ngrid,nlayer)     \ Dynamical temporal derivative for the
+!    ptdyn(ngrid,nlayer)     / corresponding variables
+!    pqdyn(ngrid,nlayer,nq) /
+!    pw(ngrid,?)           vertical velocity
+!
+!   output
+!   ------
+!
+!    pdu(ngrid,nlayermx)        \
+!    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+!    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+!    pdq(ngrid,nlayermx)        /
+!    pdpsrf(ngrid)             /
+!    tracerdyn                 call tracer in dynamical part of GCM ?
+!
+!
+!     Authors
+!     -------
+!           Frederic Hourdin	15/10/93
+!           Francois Forget	1994
+!           Christophe Hourdin	02/1997 
+!           Subroutine completely rewritten by F. Forget (01/2000)
+!           Water ice clouds: Franck Montmessin (update 06/2003)
+!           Radiatively active tracers: J.-B. Madeleine (10/2008-06/2009)
+!           New correlated-k radiative scheme: R. Wordsworth (2009)
+!           Many specifically Martian subroutines removed: R. Wordsworth (2009)       
+!           Improved water cycle: R. Wordsworth / B. Charnay (2010)
+!           To F90: R. Wordsworth (2010)
+!           New turbulent diffusion scheme: J. Leconte (2012)
+!           Loops converted to F90 matrix format: J. Leconte (2012)
+!           No more ngridmx/nqmx, F90 commons and adaptation to parallel: A. Spiga (2012)
+!==================================================================
+
+
+!    0.  Declarations :
+!    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+!#include "control.h"
+#include "netcdf.inc"
+
+! Arguments :
+! -----------
+
+!   inputs:
+!   -------
+      integer,intent(in) :: ngrid ! number of atmospheric columns
+      integer,intent(in) :: nlayer ! number of atmospheric layers
+      integer,intent(in) :: nq ! number of tracers
+      character*20,intent(in) :: nametrac(nq) ! name of the tracer from dynamics
+      logical,intent(in) :: firstcall ! signals first call to physics
+      logical,intent(in) :: lastcall ! signals last call to physics
+      real,intent(in) :: pday ! number of elapsed sols since reference Ls=0
+      real,intent(in) :: ptime ! "universal time", given as fraction of sol (e.g.: 0.5 for noon)
+      real,intent(in) :: ptimestep ! physics timestep (s)
+      real,intent(in) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa)
+      real,intent(in) :: pplay(ngrid,nlayer) ! mid-layer pressure (Pa)
+      real,intent(in) :: pphi(ngrid,nlayer) ! geopotential at mid-layer (m2s-2)
+      real,intent(in) :: pu(ngrid,nlayer) ! zonal wind component (m/s)
+      real,intent(in) :: pv(ngrid,nlayer) ! meridional wind component (m/s)
+      real,intent(in) :: pt(ngrid,nlayer) ! temperature (K)
+      real,intent(in) :: pq(ngrid,nlayer,nq) ! tracers (.../kg_of_air)
+      real,intent(in) :: pw(ngrid,nlayer)    ! vertical velocity (m/s)
+
+
+
+!   outputs:
+!   --------
+!     physical tendencies
+      real,intent(out) :: pdu(ngrid,nlayer) ! zonal wind tendency (m/s/s)
+      real,intent(out) :: pdv(ngrid,nlayer) ! meridional wind tendency (m/s/s)
+      real,intent(out) :: pdt(ngrid,nlayer) ! temperature tendency (K/s)
+      real,intent(out) :: pdq(ngrid,nlayer,nq) ! tracer tendencies (../kg/s)
+      real,intent(out) :: pdpsrf(ngrid) ! surface pressure tendency (Pa/s)
+      logical,intent(out) :: tracerdyn ! signal to the dynamics to advect tracers or not
+
+! Local saved variables:
+! ----------------------
+!     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+!     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+!      aerosol optical properties:
+!      real aerosol(ngrid,nlayermx,naerkind) 
+!     this is now internal to callcorrk and hence no longer needed here
+
+      integer day_ini                ! Initial date of the run (sol since Ls=0) 
+      integer icount                 ! counter of calls to physiq during the run.
+      real, dimension(:),allocatable,save ::  tsurf  ! Surface temperature (K)
+      real, dimension(:,:),allocatable,save ::  tsoil  ! sub-surface temperatures (K)
+      real, dimension(:),allocatable,save :: albedo ! Surface albedo
+
+      real,dimension(:),allocatable,save :: albedo0 ! Surface albedo
+      real,dimension(:),allocatable,save :: rnat ! added by BC
+
+      real,dimension(:),allocatable,save :: emis ! Thermal IR surface emissivity
+      real,dimension(:,:),allocatable,save :: dtrad ! Net atm. radiative heating rate (K.s-1)
+      real,dimension(:),allocatable,save :: fluxrad_sky ! rad. flux from sky absorbed by surface (W.m-2)
+      real,dimension(:),allocatable,save :: fluxrad ! Net radiative surface flux (W.m-2)
+      real,dimension(:),allocatable,save :: capcal ! surface heat capacity (J m-2 K-1)
+      real,dimension(:),allocatable,save :: fluxgrd ! surface conduction flux (W.m-2)
+      real,dimension(:,:),allocatable,save :: qsurf ! tracer on surface (e.g. kg.m-2)
+      real,dimension(:,:),allocatable,save :: q2 ! Turbulent Kinetic Energy 
+
+      save day_ini, icount
+
+! Local variables :
+! -----------------
+
+!     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+!     for the "naerkind" optically active aerosols:
+      real aerosol(ngrid,nlayermx,naerkind) 
+      real zh(ngrid,nlayermx)      ! potential temperature (K)
+
+      character*80 fichier 
+      integer l,ig,ierr,iq,iaer
+      
+      !!! this is saved for diagnostic
+      real,dimension(:),allocatable,save :: fluxsurf_lw ! incident LW (IR) surface flux (W.m-2)
+      real,dimension(:),allocatable,save :: fluxsurf_sw ! incident SW (stellar) surface flux (W.m-2)
+      real,dimension(:),allocatable,save :: fluxtop_lw ! Outgoing LW (IR) flux to space (W.m-2)
+      real,dimension(:),allocatable,save :: fluxabs_sw ! Absorbed SW (stellar) flux (W.m-2)
+      real,dimension(:),allocatable,save :: fluxtop_dn
+      real,dimension(:),allocatable,save :: fluxdyn ! horizontal heat transport by dynamics  
+      real,dimension(:,:),allocatable,save :: OLR_nu ! Outgoing LW radition in each band (Normalized to the band width (W/m2/cm-1)
+      real,dimension(:,:),allocatable,save :: OSR_nu ! Outgoing SW radition in each band (Normalized to the band width (W/m2/cm-1)
+      real,dimension(:,:),allocatable,save :: zdtlw ! (K/s)
+      real,dimension(:,:),allocatable,save :: zdtsw ! (K/s)
+      real,dimension(:),allocatable,save :: sensibFlux ! turbulent flux given by the atm to the surface
+
+      real zls                       ! solar longitude (rad)
+      real zday                      ! date (time since Ls=0, in martian days)
+      real zzlay(ngrid,nlayermx)   ! altitude at the middle of the layers
+      real zzlev(ngrid,nlayermx+1) ! altitude at layer boundaries
+      real latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+!     Tendencies due to various processes:
+      real dqsurf(ngrid,nq)
+      real cldtlw(ngrid,nlayermx)                           ! (K/s) LW heating rate for clear areas
+      real cldtsw(ngrid,nlayermx)                           ! (K/s) SW heating rate for clear areas
+      real zdtsurf(ngrid)                                   ! (K/s)
+      real dtlscale(ngrid,nlayermx)
+      real zdvdif(ngrid,nlayermx),zdudif(ngrid,nlayermx)  ! (m.s-2)
+      real zdhdif(ngrid,nlayermx), zdtsdif(ngrid)         ! (K/s)
+      real zdtdif(ngrid,nlayermx)			      ! (K/s)
+      real zdvadj(ngrid,nlayermx),zduadj(ngrid,nlayermx)  ! (m.s-2)
+      real zdhadj(ngrid,nlayermx)                           ! (K/s)
+      real zdtgw(ngrid,nlayermx)                            ! (K/s)
+      real zdtmr(ngrid,nlayermx)
+      real zdugw(ngrid,nlayermx),zdvgw(ngrid,nlayermx)    ! (m.s-2)
+      real zdtc(ngrid,nlayermx),zdtsurfc(ngrid)
+      real zdvc(ngrid,nlayermx),zduc(ngrid,nlayermx)
+      real zdumr(ngrid,nlayermx),zdvmr(ngrid,nlayermx)
+      real zdtsurfmr(ngrid)
+      
+      real zdmassmr(ngrid,nlayermx),zdpsrfmr(ngrid)
+      real zdmassmr_col(ngrid)
+
+      real zdqdif(ngrid,nlayermx,nq), zdqsdif(ngrid,nq)
+      real zdqevap(ngrid,nlayermx)
+      real zdqsed(ngrid,nlayermx,nq), zdqssed(ngrid,nq)
+      real zdqdev(ngrid,nlayermx,nq), zdqsdev(ngrid,nq)
+      real zdqadj(ngrid,nlayermx,nq)
+      real zdqc(ngrid,nlayermx,nq)
+      real zdqmr(ngrid,nlayermx,nq),zdqsurfmr(ngrid,nq)
+      real zdqlscale(ngrid,nlayermx,nq)
+      real zdqslscale(ngrid,nq)
+      real zdqchim(ngrid,nlayermx,nq)
+      real zdqschim(ngrid,nq)
+
+      real zdteuv(ngrid,nlayermx)    ! (K/s)
+      real zdtconduc(ngrid,nlayermx) ! (K/s)
+      real zdumolvis(ngrid,nlayermx)
+      real zdvmolvis(ngrid,nlayermx)
+      real zdqmoldiff(ngrid,nlayermx,nq)
+
+!     Local variables for local calculations:
+      real zflubid(ngrid)
+      real zplanck(ngrid),zpopsk(ngrid,nlayermx)
+      real zdum1(ngrid,nlayermx)
+      real zdum2(ngrid,nlayermx)
+      real ztim1,ztim2,ztim3, z1,z2
+      real ztime_fin
+      real zdh(ngrid,nlayermx)
+      real gmplanet
+      real taux(ngrid),tauy(ngrid)
+
+      integer length
+      parameter (length=100)
+
+! local variables only used for diagnostics (output in file "diagfi" or "stats")
+! ------------------------------------------------------------------------------
+      real ps(ngrid), zt(ngrid,nlayermx)
+      real zu(ngrid,nlayermx),zv(ngrid,nlayermx)
+      real zq(ngrid,nlayermx,nq)
+      character*2 str2
+      character*5 str5
+      real zdtadj(ngrid,nlayermx)
+      real zdtdyn(ngrid,nlayermx)
+      real,allocatable,dimension(:,:),save :: ztprevious
+      real reff(ngrid,nlayermx) ! effective dust radius (used if doubleq=T)
+      real qtot1,qtot2            ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+      real zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      real zstress(ngrid), cd
+      real hco2(nq), tmean, zlocal(nlayermx)
+      real vmr(ngrid,nlayermx) ! volume mixing ratio
+
+      real time_phys
+
+!     reinstated by RW for diagnostic
+      real,allocatable,dimension(:),save :: tau_col
+      
+!     included by RW to reduce insanity of code
+      real ISR,ASR,OLR,GND,DYN,GSR,Ts1,Ts2,Ts3,TsS
+
+!     included by RW to compute tracer column densities
+      real qcol(ngrid,nq)
+
+!     included by RW for H2O precipitation
+      real zdtrain(ngrid,nlayermx)
+      real zdqrain(ngrid,nlayermx,nq)
+      real zdqsrain(ngrid)
+      real zdqssnow(ngrid)
+      real rainout(ngrid)
+
+!     included by RW for H2O Manabe scheme
+      real dtmoist(ngrid,nlayermx)
+      real dqmoist(ngrid,nlayermx,nq)
+
+      real qvap(ngrid,nlayermx)
+      real dqvaplscale(ngrid,nlayermx)
+      real dqcldlscale(ngrid,nlayermx)
+      real rneb_man(ngrid,nlayermx)
+      real rneb_lsc(ngrid,nlayermx)
+
+!     included by RW to account for surface cooling by evaporation
+      real dtsurfh2olat(ngrid)
+
+
+!     to test energy conservation (RW+JL)
+      real mass(ngrid,nlayermx),massarea(ngrid,nlayermx)
+      real dEtot, dEtots, AtmToSurf_TurbFlux
+      real,save :: dEtotSW, dEtotsSW, dEtotLW, dEtotsLW
+      real dEzRadsw(ngrid,nlayermx),dEzRadlw(ngrid,nlayermx),dEzdiff(ngrid,nlayermx)
+      real dEdiffs(ngrid),dEdiff(ngrid)
+      real madjdE(ngrid), lscaledE(ngrid),madjdEz(ngrid,nlayermx), lscaledEz(ngrid,nlayermx)
+!JL12 conservation test for mean flow kinetic energy has been disabled temporarily
+      real dtmoist_max,dtmoist_min
+      
+      real dItot, dItot_tmp, dVtot, dVtot_tmp
+
+!     included by BC for evaporation     
+      real qevap(ngrid,nlayermx,nq)
+      real tevap(ngrid,nlayermx)
+      real dqevap1(ngrid,nlayermx)
+      real dtevap1(ngrid,nlayermx)
+
+!     included by BC for hydrology
+      real,allocatable,save :: hice(:)
+
+!     included by RW to test water conservation (by routine)
+      real h2otot
+      real dWtot, dWtot_tmp, dWtots, dWtots_tmp
+      real h2o_surf_all
+      logical watertest
+      save watertest
+
+!     included by RW for RH diagnostic
+      real qsat(ngrid,nlayermx), RH(ngrid,nlayermx), H2Omaxcol(ngrid),psat_tmp
+
+!     included by RW for hydrology
+      real dqs_hyd(ngrid,nq)
+      real zdtsurf_hyd(ngrid)
+
+!     included by RW for water cycle conservation tests
+      real icesrf,liqsrf,icecol,vapcol
+
+!     included by BC for double radiative transfer call
+      logical clearsky
+      real zdtsw1(ngrid,nlayermx)
+      real zdtlw1(ngrid,nlayermx)
+      real fluxsurf_lw1(ngrid)     
+      real fluxsurf_sw1(ngrid)  
+      real fluxtop_lw1(ngrid)    
+      real fluxabs_sw1(ngrid)  
+      real tau_col1(ngrid)
+      real OLR_nu1(ngrid,L_NSPECTI)
+      real OSR_nu1(ngrid,L_NSPECTV)
+      real tf, ntf
+
+!     included by BC for cloud fraction computations
+      real,allocatable,dimension(:,:),save :: cloudfrac
+      real,allocatable,dimension(:),save :: totcloudfrac
+
+!     included by RW for vdifc water conservation test
+      real nconsMAX
+      real vdifcncons(ngrid)
+      real cadjncons(ngrid)
+
+!      double precision qsurf_hist(ngrid,nq)
+      real,allocatable,dimension(:,:),save :: qsurf_hist
+
+!     included by RW for temp convadj conservation test
+      real playtest(nlayermx)
+      real plevtest(nlayermx)
+      real ttest(nlayermx)
+      real qtest(nlayermx)
+      integer igtest
+
+!     included by RW for runway greenhouse 1D study
+      real muvar(ngrid,nlayermx+1)
+
+!     included by RW for variable H2O particle sizes
+      real,allocatable,dimension(:,:,:),save :: reffrad ! aerosol effective radius (m)
+      real,allocatable,dimension(:,:,:),save :: nueffrad ! aerosol effective radius variance
+!      real :: nueffrad_dummy(ngrid,nlayermx,naerkind) !! AS. This is temporary. Check below why.
+      real :: reffh2oliq(ngrid,nlayermx) ! liquid water particles effective radius (m)
+      real :: reffh2oice(ngrid,nlayermx) ! water ice particles effective radius (m)
+   !   real reffH2O(ngrid,nlayermx)
+      real reffcol(ngrid,naerkind)
+
+!     included by RW for sourceevol
+      real,allocatable,dimension(:),save :: ice_initial
+      real delta_ice,ice_tot
+      real,allocatable,dimension(:),save :: ice_min
+      
+      integer num_run
+      logical,save :: ice_update
+
+!     included by MS to compute the daily average of rings shadowing
+      integer, parameter :: nb_hours = 1536 ! set how many times per day are used
+      real :: pas
+      integer :: m
+      ! temporary variables computed at each step of this average 
+      real :: ptime_day ! Universal time in sol fraction 
+      real :: tmp_zls   ! solar longitude
+      real, dimension(:), allocatable :: tmp_fract ! day fraction of the time interval 
+      real, dimension(:), allocatable :: tmp_mu0 ! equivalent solar angle
+
+!     included by BC for slab ocean
+      real, dimension(:),allocatable,save ::  pctsrf_sic
+      real, dimension(:,:),allocatable,save :: tslab
+      real, dimension(:),allocatable,save ::  tsea_ice
+      real, dimension(:),allocatable,save :: sea_ice
+      real, dimension(:),allocatable,save :: zmasq
+      integer, dimension(:),allocatable,save ::knindex 
+
+      real :: tsurf2(ngrid)
+      real :: flux_o(ngrid),flux_g(ngrid),fluxgrdocean(ngrid)
+      real :: dt_ekman(ngrid,noceanmx),dt_hdiff(ngrid,noceanmx)
+      real :: flux_sens_lat(ngrid)
+      real :: qsurfint(ngrid,nq)
+
+
+!=======================================================================
+
+! 1. Initialisation
+! -----------------
+
+!  1.1   Initialisation only at first call
+!  ---------------------------------------
+      if (firstcall) then
+
+        !!! ALLOCATE SAVED ARRAYS
+        ALLOCATE(tsurf(ngrid))
+        ALLOCATE(tsoil(ngrid,nsoilmx))    
+        ALLOCATE(albedo(ngrid))          
+        ALLOCATE(albedo0(ngrid))          
+        ALLOCATE(rnat(ngrid))         
+        ALLOCATE(emis(ngrid))   
+        ALLOCATE(dtrad(ngrid,nlayermx))
+        ALLOCATE(fluxrad_sky(ngrid))
+        ALLOCATE(fluxrad(ngrid))    
+        ALLOCATE(capcal(ngrid))    
+        ALLOCATE(fluxgrd(ngrid))  
+        ALLOCATE(qsurf(ngrid,nq))  
+        ALLOCATE(q2(ngrid,nlayermx+1)) 
+        ALLOCATE(ztprevious(ngrid,nlayermx))
+        ALLOCATE(cloudfrac(ngrid,nlayermx))
+        ALLOCATE(totcloudfrac(ngrid))
+        ALLOCATE(hice(ngrid))
+        ALLOCATE(qsurf_hist(ngrid,nq))
+        ALLOCATE(reffrad(ngrid,nlayermx,naerkind))
+        ALLOCATE(nueffrad(ngrid,nlayermx,naerkind))
+        ALLOCATE(ice_initial(ngrid))
+        ALLOCATE(ice_min(ngrid)) 
+        ALLOCATE(fluxsurf_lw(ngrid))
+        ALLOCATE(fluxsurf_sw(ngrid))
+        ALLOCATE(fluxtop_lw(ngrid))
+        ALLOCATE(fluxabs_sw(ngrid))
+        ALLOCATE(fluxtop_dn(ngrid))
+        ALLOCATE(fluxdyn(ngrid))
+        ALLOCATE(OLR_nu(ngrid,L_NSPECTI))
+        ALLOCATE(OSR_nu(ngrid,L_NSPECTV))
+        ALLOCATE(sensibFlux(ngrid))
+        ALLOCATE(zdtlw(ngrid,nlayermx))
+        ALLOCATE(zdtsw(ngrid,nlayermx))
+        ALLOCATE(tau_col(ngrid))
+        ALLOCATE(pctsrf_sic(ngrid))
+        ALLOCATE(tslab(ngrid,noceanmx))
+        ALLOCATE(tsea_ice(ngrid))
+        ALLOCATE(sea_ice(ngrid))
+        ALLOCATE(zmasq(ngrid))
+        ALLOCATE(knindex(ngrid))
+!        ALLOCATE(qsurfint(ngrid,nqmx))
+
+
+        !! this is defined in comsaison_h
+        ALLOCATE(mu0(ngrid))
+        ALLOCATE(fract(ngrid))
+
+            
+         !! this is defined in radcommon_h
+         ALLOCATE(eclipse(ngrid))
+         ALLOCATE(glat(ngrid))
+
+!        variables set to 0
+!        ~~~~~~~~~~~~~~~~~~
+         dtrad(:,:) = 0.0
+         fluxrad(:) = 0.0
+         tau_col(:) = 0.0
+         zdtsw(:,:) = 0.0
+         zdtlw(:,:) = 0.0
+
+!        initialize aerosol indexes 
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            call iniaerosol()
+
+      
+!        initialize tracer names, indexes and properties
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (.NOT.ALLOCATED(noms)) ALLOCATE(noms(nq)) !! because noms is an argument of physdem1
+                                                      !! whether or not tracer is on
+         if (tracer) then
+            call initracer(ngrid,nq,nametrac)
+         endif ! end tracer
+
+! 
+
+!        read startfi (initial parameters)
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         call phyetat0(ngrid,"startfi.nc",0,0,nsoilmx,nq,   &
+               day_ini,time_phys,tsurf,tsoil,emis,q2,qsurf,   &
+               cloudfrac,totcloudfrac,hice,  &
+               rnat,pctsrf_sic,tslab, tsea_ice,sea_ice)
+
+         if (pday.ne.day_ini) then
+           write(*,*) "ERROR in physiq.F90:"
+           write(*,*) "bad synchronization between physics and dynamics"
+           write(*,*) "dynamics day: ",pday
+           write(*,*) "physics day:  ",day_ini
+           stop
+         endif
+
+         write (*,*) 'In physiq day_ini =', day_ini
+
+!        Initialize albedo and orbital calculation
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         call surfini(ngrid,nq,qsurf,albedo0)
+         call iniorbit(apoastr,periastr,year_day,peri_day,obliquit)
+
+         albedo(:)=albedo0(:)
+
+         if(tlocked)then
+            print*,'Planet is tidally locked at resonance n=',nres
+            print*,'Make sure you have the right rotation rate!!!'
+         endif
+
+!        Initialize oceanic variables
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+         if (ok_slab_ocean)then
+
+           call ocean_slab_init(ngrid,ptimestep, tslab, &
+                sea_ice, pctsrf_sic)
+
+            knindex(:) = 0
+
+            do ig=1,ngrid
+              zmasq(ig)=1
+              knindex(ig) = ig
+              if (nint(rnat(ig)).eq.0) then
+                 zmasq(ig)=0
+              endif
+            enddo
+
+
+           CALL init_masquv(zmasq)
+
+
+         endif
+
+
+!        initialize soil 
+!        ~~~~~~~~~~~~~~~
+         if (callsoil) then
+            call soil(ngrid,nsoilmx,firstcall,lastcall,inertiedat, &
+                ptimestep,tsurf,tsoil,capcal,fluxgrd)
+
+            if (ok_slab_ocean) then
+               do ig=1,ngrid
+                  if (nint(rnat(ig)).eq.2) then
+                    capcal(ig)=capcalocean
+                    if (pctsrf_sic(ig).gt.0.5) then
+                      capcal(ig)=capcalseaice
+                      if (qsurf(ig,igcm_h2o_ice).gt.0.) then
+                        capcal(ig)=capcalsno
+                      endif
+                    endif
+                  endif
+               enddo
+            endif
+
+
+
+
+         else
+            print*,'WARNING! Thermal conduction in the soil turned off'
+            capcal(:)=1.e6
+            fluxgrd(:)=intheat
+            print*,'Flux from ground = ',intheat,' W m^-2'
+         endif
+         icount=1
+
+!        decide whether to update ice at end of run
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         ice_update=.false.
+         if(sourceevol)then
+            open(128,file='num_run',form='formatted', &
+                     status="old",iostat=ierr)
+            if (ierr.ne.0) then
+              write(*,*) "physiq: Error! No num_run file!"
+              write(*,*) " (which is needed for sourceevol option)"
+              stop
+            endif
+            read(128,*) num_run 
+            close(128)
+        
+            if(num_run.ne.0.and.mod(num_run,2).eq.0)then
+            !if(num_run.ne.0.and.mod(num_run,3).eq.0)then
+               print*,'Updating ice at end of this year!'
+               ice_update=.true.
+               ice_min(:)=1.e4
+            endif  
+         endif
+
+!  In newstart now, will have to be remove (BC 2014)
+!        define surface as continent or ocean
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         if (.not.ok_slab_ocean) then
+           rnat(:)=1.
+           do ig=1,ngrid
+!             if(iceball.or.oceanball.or.(inertiedat(ig,1).gt.1.E4))then
+             if(inertiedat(ig,1).gt.1.E4)then
+               rnat(ig)=0
+             endif
+           enddo
+
+           print*,'WARNING! Surface type currently decided by surface inertia'
+           print*,'This should be improved e.g. in newstart.F'
+         endif!(.not.ok_slab_ocean)
+
+!        initialise surface history variable 
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         qsurf_hist(:,:)=qsurf(:,:)
+
+!        initialise variable for dynamical heating diagnostic
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         ztprevious(:,:)=pt(:,:)
+
+!        Set temperature just above condensation temperature (for Early Mars)
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         if(nearco2cond) then
+            write(*,*)' WARNING! Starting at Tcond+1K'
+            do l=1, nlayer
+               do ig=1,ngrid
+                  pdt(ig,l)= ((-3167.8)/(log(.01*pplay(ig,l))-23.23)+4     &
+                      -pt(ig,l)) / ptimestep
+               enddo
+            enddo
+         endif
+
+         if(meanOLR)then
+            ! to record global radiative balance
+            call system('rm -f rad_bal.out')
+            ! to record global mean/max/min temperatures
+            call system('rm -f tem_bal.out')
+            ! to record global hydrological balance
+            call system('rm -f h2o_bal.out')
+         endif
+
+         watertest=.false.
+         if(water)then
+            ! initialise variables for water cycle
+
+            if(enertest)then
+               watertest = .true.
+            endif
+
+            if(ice_update)then
+               ice_initial(:)=qsurf(:,igcm_h2o_ice)
+            endif
+
+         endif
+         call su_watercycle ! even if we don't have a water cycle, we might
+                            ! need epsi for the wvp definitions in callcorrk.F
+
+         if (ngrid.ne.1) then ! no need to create a restart file in 1d
+           call physdem0("restartfi.nc",long,lati,nsoilmx,ngrid,nlayer,nq, &
+                         ptimestep,pday+nday,time_phys,area, &
+                         albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+         endif
+         
+      endif        !  (end of "if firstcall")
+
+! ---------------------------------------------------
+! 1.2   Initializations done at every physical timestep:
+! ---------------------------------------------------
+!     Initialize various variables
+!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      
+      pdu(1:ngrid,1:nlayermx) = 0.0
+      pdv(1:ngrid,1:nlayermx) = 0.0
+      if ( .not.nearco2cond ) then
+         pdt(1:ngrid,1:nlayermx) = 0.0
+      endif
+      pdq(1:ngrid,1:nlayermx,1:nq) = 0.0
+      pdpsrf(1:ngrid)       = 0.0
+      zflubid(1:ngrid)      = 0.0
+      zdtsurf(1:ngrid)      = 0.0
+      dqsurf(1:ngrid,1:nq)= 0.0
+      flux_sens_lat(1:ngrid) = 0.0
+      taux(1:ngrid) = 0.0
+      tauy(1:ngrid) = 0.0
+
+
+
+
+      zday=pday+ptime ! compute time, in sols (and fraction thereof)
+
+!     Compute Stellar Longitude (Ls)
+!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (season) then
+         call stellarlong(zday,zls)
+      else
+         call stellarlong(float(day_ini),zls)
+      end if
+
+
+
+!    Compute variations of g with latitude (oblate case)
+!
+        if (oblate .eqv. .false.) then
+           glat(:) = g
+        else if (flatten .eq. 0.0 .or. J2 .eq. 0.0 .or. Rmean .eq. 0.0 .or. MassPlanet .eq. 0.0) then
+        print*,'I need values for flatten, J2, Rmean and MassPlanet to compute glat (else set oblate=.false.)'
+
+        call abort
+        else
+
+        gmplanet = MassPlanet*grav*1e24
+        do ig=1,ngrid
+           glat(ig)= gmplanet/(Rmean**2) * (1.D0 + 0.75 *J2 - 2.0*flatten/3. + (2.*flatten - 15./4.* J2) * cos(2. * (pi/2. - lati(ig)))) 
+        end do
+        endif
+
+!!      write(*,*) 'lati, glat =',lati(1)*180./pi,glat(1), lati(ngrid/2)*180./pi, glat(ngrid/2)
+
+
+
+!     Compute geopotential between layers
+!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      zzlay(1:ngrid,1:nlayermx)=pphi(1:ngrid,1:nlayermx)
+      do l=1,nlayermx         
+      zzlay(1:ngrid,l)= zzlay(1:ngrid,l)/glat(1:ngrid)
+      enddo
+
+      zzlev(1:ngrid,1)=0.
+      zzlev(1:ngrid,nlayer+1)=1.e7    ! dummy top of last layer above 10000 km...
+
+      do l=2,nlayer
+         do ig=1,ngrid
+            z1=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         enddo
+      enddo
+!     Potential temperature calculation may not be the same in physiq and dynamic...
+
+!     Compute potential temperature
+!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      do l=1,nlayer         
+         do ig=1,ngrid
+            zpopsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**rcp
+            zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
+            mass(ig,l)  = (pplev(ig,l) - pplev(ig,l+1))/glat(ig)
+	    massarea(ig,l)=mass(ig,l)*area(ig)
+         enddo
+      enddo
+
+
+!-----------------------------------------------------------------------
+!    2. Compute radiative tendencies
+!-----------------------------------------------------------------------
+
+      if (callrad) then
+         if( mod(icount-1,iradia).eq.0.or.lastcall) then
+
+!          Compute local stellar zenith angles
+!          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           call orbite(zls,dist_star,declin)
+
+           if (tlocked) then
+              ztim1=SIN(declin)
+!              ztim2=COS(declin)*COS(2.*pi*(zday/year_day) - zls*nres)
+!              ztim3=-COS(declin)*SIN(2.*pi*(zday/year_day) - zls*nres)
+! JL12 corrects tidally resonant cases. nres=omega_rot/omega_orb
+              ztim2=COS(declin)*COS(2.*pi*(zday/year_day)*nres - zls)
+              ztim3=-COS(declin)*SIN(2.*pi*(zday/year_day)*nres - zls)
+
+              call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
+               ztim1,ztim2,ztim3,mu0,fract, flatten)
+
+           elseif (diurnal) then
+               ztim1=SIN(declin)
+               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
+               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
+
+               call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
+               ztim1,ztim2,ztim3,mu0,fract, flatten)
+           else if(diurnal .eqv. .false.) then
+
+               call mucorr(ngrid,declin,lati,mu0,fract,10000.,rad,flatten)
+               ! WARNING: this function appears not to work in 1D
+
+           endif 
+           
+           !! Eclipse incoming sunlight (e.g. Saturn ring shadowing)
+
+           if(rings_shadow) then 
+                write(*,*) 'Rings shadow activated'
+                if(diurnal .eqv. .false.) then ! we need to compute the daily average insolation 
+                    pas = 1./nb_hours
+                    ptime_day = 0.
+                    fract(:) = 0.
+                    ALLOCATE(tmp_fract(ngrid))
+                    ALLOCATE(tmp_mu0(ngrid))
+                    tmp_fract(:) = 0.
+                    eclipse(:) = 0.
+                    tmp_mu0(:) = 0.
+                    
+                    do m=1, nb_hours
+                        ptime_day = m*pas
+                        call stellarlong(pday+ptime_day,tmp_zls)
+                        call orbite(tmp_zls,dist_star,declin)
+                        ztim1=SIN(declin)
+                        ztim2=COS(declin)*COS(2.*pi*(pday+ptime_day-.5))
+                        ztim3=-COS(declin)*SIN(2.*pi*(pday+ptime_day-.5))
+                  
+                        call stelang(ngrid,sinlon,coslon,sinlat,coslat,    &
+                                 ztim1,ztim2,ztim3,tmp_mu0,tmp_fract, flatten)
+                  
+                        call rings(ngrid, declin, ptime_day, rad, flatten, eclipse)
+                  
+                        fract(:) = fract(:) + (1.-eclipse(:))*tmp_fract(:) !! fract prend en compte l'ombre des anneaux et l'alternance jour/nuit
+                    enddo
+                
+                    DEALLOCATE(tmp_fract)
+                    DEALLOCATE(tmp_mu0)
+            
+                    fract(:) = fract(:)/nb_hours
+                 
+                 else   
+                    call rings(ngrid, declin, ptime, rad, 0., eclipse)
+                    fract(:) = fract(:) * (1.-eclipse)
+                 endif
+            else
+                 eclipse(:) = 0.0
+            endif
+
+           if (corrk) then
+
+!          a) Call correlated-k radiative transfer scheme
+!          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+              if(kastprof)then
+                 print*,'kastprof should not = true here'
+                 call abort
+              endif
+	      if(water) then
+                  muvar(1:ngrid,1:nlayermx)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,1:nlayermx,igcm_h2o_vap)) 
+		  muvar(1:ngrid,nlayermx+1)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,nlayermx,igcm_h2o_vap)) 
+		  ! take into account water effect on mean molecular weight
+	      else
+                  muvar(1:ngrid,1:nlayermx+1)=mugaz
+	      endif 
+      
+!             standard callcorrk
+
+
+
+
+              if(ok_slab_ocean) then
+                tsurf2(:)=tsurf(:) 
+                do ig=1,ngrid
+                  if (nint(rnat(ig))==0) then
+                    tsurf(ig)=((1.-pctsrf_sic(ig))*tslab(ig,1)**4+pctsrf_sic(ig)*tsea_ice(ig)**4)**0.25
+                  endif
+                enddo
+              endif!(ok_slab_ocean)
+                
+
+                clearsky=.false.
+                call callcorrk(ngrid,nlayer,pq,nq,qsurf,                   &
+                      albedo,emis,mu0,pplev,pplay,pt,                    &
+                      tsurf,fract,dist_star,aerosol,muvar,               &
+                      zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,    &
+                      fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,               &
+                      tau_col,cloudfrac,totcloudfrac,                    &
+                      clearsky,firstcall,lastcall)      
+
+!             Option to call scheme once more for clear regions
+                if(CLFvarying)then
+
+                 ! ---> PROBLEMS WITH ALLOCATED ARRAYS 
+                 ! (temporary solution in callcorrk: do not deallocate if CLFvarying ...)
+                   clearsky=.true.
+                   call callcorrk(ngrid,nlayer,pq,nq,qsurf,                  &
+                      albedo,emis,mu0,pplev,pplay,pt,                      &
+                      tsurf,fract,dist_star,aerosol,muvar,                 &
+                      zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,fluxtop_lw1, &
+                      fluxabs_sw1,fluxtop_dn,OLR_nu1,OSR_nu1,              &
+                      tau_col1,cloudfrac,totcloudfrac,                     &
+                      clearsky,firstcall,lastcall)
+                   clearsky = .false.  ! just in case.     
+
+
+                 ! Sum the fluxes and heating rates from cloudy/clear cases
+                   do ig=1,ngrid
+                      tf=totcloudfrac(ig)
+                      ntf=1.-tf
+                    
+                    fluxsurf_lw(ig) = ntf*fluxsurf_lw1(ig) + tf*fluxsurf_lw(ig)
+                    fluxsurf_sw(ig) = ntf*fluxsurf_sw1(ig) + tf*fluxsurf_sw(ig)
+                    fluxtop_lw(ig)  = ntf*fluxtop_lw1(ig)  + tf*fluxtop_lw(ig)
+                    fluxabs_sw(ig)  = ntf*fluxabs_sw1(ig)  + tf*fluxabs_sw(ig)
+                    tau_col(ig)     = ntf*tau_col1(ig)     + tf*tau_col(ig)
+                    
+                    zdtlw(ig,1:nlayermx) = ntf*zdtlw1(ig,1:nlayermx) + tf*zdtlw(ig,1:nlayermx)
+                    zdtsw(ig,1:nlayermx) = ntf*zdtsw1(ig,1:nlayermx) + tf*zdtsw(ig,1:nlayermx)
+
+                    OSR_nu(ig,1:L_NSPECTV) = ntf*OSR_nu1(ig,1:L_NSPECTV) + tf*OSR_nu(ig,1:L_NSPECTV)		       
+                    OLR_nu(ig,1:L_NSPECTI) = ntf*OLR_nu1(ig,1:L_NSPECTI) + tf*OLR_nu(ig,1:L_NSPECTI)		       
+
+                 enddo
+
+              endif !CLFvarying
+
+              if(ok_slab_ocean) then
+                tsurf(:)=tsurf2(:)
+              endif!(ok_slab_ocean)
+
+
+!             Radiative flux from the sky absorbed by the surface (W.m-2)
+              GSR=0.0
+              fluxrad_sky(1:ngrid)=emis(1:ngrid)*fluxsurf_lw(1:ngrid)+fluxsurf_sw(1:ngrid)*(1.-albedo(1:ngrid))
+
+              !if(noradsurf)then ! no lower surface; SW flux just disappears
+              !   GSR = SUM(fluxsurf_sw(1:ngrid)*area(1:ngrid))/totarea
+              !   fluxrad_sky(1:ngrid)=emis(1:ngrid)*fluxsurf_lw(1:ngrid)
+              !   print*,'SW lost in deep atmosphere = ',GSR,' W m^-2'
+              !endif
+
+!             Net atmospheric radiative heating rate (K.s-1)
+              dtrad(1:ngrid,1:nlayermx)=zdtsw(1:ngrid,1:nlayermx)+zdtlw(1:ngrid,1:nlayermx)
+
+           elseif(newtonian)then
+
+!          b) Call Newtonian cooling scheme
+!          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+              call newtrelax(ngrid,mu0,sinlat,zpopsk,pt,pplay,pplev,dtrad,firstcall)
+
+              zdtsurf(1:ngrid) = +(pt(1:ngrid,1)-tsurf(1:ngrid))/ptimestep
+              ! e.g. surface becomes proxy for 1st atmospheric layer ?
+
+           else
+
+!          c) Atmosphere has no radiative effect
+!          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+              fluxtop_dn(1:ngrid)  = fract(1:ngrid)*mu0(1:ngrid)*Fat1AU/dist_star**2
+              if(ngrid.eq.1)then ! / by 4 globally in 1D case...
+                 fluxtop_dn(1)  = fract(1)*Fat1AU/dist_star**2/2.0
+              endif
+              fluxsurf_sw(1:ngrid) = fluxtop_dn(1:ngrid)
+              fluxrad_sky(1:ngrid) = fluxtop_dn(1:ngrid)*(1.-albedo(1:ngrid))
+              fluxtop_lw(1:ngrid)  = emis(1:ngrid)*sigma*tsurf(1:ngrid)**4
+              ! radiation skips the atmosphere entirely
+
+
+              dtrad(1:ngrid,1:nlayermx)=0.0
+              ! hence no atmospheric radiative heating
+
+           endif                ! if corrk
+
+        endif ! of if(mod(icount-1,iradia).eq.0)
+       
+
+!    Transformation of the radiative tendencies
+!    ------------------------------------------
+
+        zplanck(1:ngrid)=tsurf(1:ngrid)*tsurf(1:ngrid)
+        zplanck(1:ngrid)=emis(1:ngrid)*sigma*zplanck(1:ngrid)*zplanck(1:ngrid)
+        fluxrad(1:ngrid)=fluxrad_sky(1:ngrid)-zplanck(1:ngrid)
+        pdt(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)+dtrad(1:ngrid,1:nlayermx)
+
+!-------------------------
+! test energy conservation
+         if(enertest)then
+	    call planetwide_sumval(cpp*massarea(:,:)*zdtsw(:,:)/totarea_planet,dEtotSW)
+	    call planetwide_sumval(cpp*massarea(:,:)*zdtlw(:,:)/totarea_planet,dEtotLW)
+	    call planetwide_sumval(fluxsurf_sw(:)*(1.-albedo(:))*area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk
+	    call planetwide_sumval((fluxsurf_lw(:)*emis(:)-zplanck(:))*area(:)/totarea_planet,dEtotsLW)
+	    dEzRadsw(:,:)=cpp*mass(:,:)*zdtsw(:,:)
+	    dEzRadlw(:,:)=cpp*mass(:,:)*zdtlw(:,:)
+	    if (is_master) then
+            	print*,'---------------------------------------------------------------'
+            	print*,'In corrk SW atmospheric heating       =',dEtotSW,' W m-2'
+            	print*,'In corrk LW atmospheric heating       =',dEtotLW,' W m-2'
+            	print*,'atmospheric net rad heating (SW+LW)   =',dEtotLW+dEtotSW,' W m-2'
+            	print*,'In corrk SW surface heating           =',dEtotsSW,' W m-2'
+            	print*,'In corrk LW surface heating           =',dEtotsLW,' W m-2'
+            	print*,'surface net rad heating (SW+LW)       =',dEtotsLW+dEtotsSW,' W m-2'
+	    endif
+         endif
+!-------------------------
+
+      endif ! of if (callrad)
+
+!-----------------------------------------------------------------------
+!    4. Vertical diffusion (turbulent mixing):
+!    -----------------------------------------
+
+      if (calldifv) then
+      
+         zflubid(1:ngrid)=fluxrad(1:ngrid)+fluxgrd(1:ngrid)
+
+         zdum1(1:ngrid,1:nlayermx)=0.0
+         zdum2(1:ngrid,1:nlayermx)=0.0
+
+
+!JL12 the following if test is temporarily there to allow us to compare the old vdifc with turbdiff	 
+	 if (UseTurbDiff) then
+	 
+           call turbdiff(ngrid,nlayer,nq,rnat,       &
+              ptimestep,capcal,lwrite,               &
+              pplay,pplev,zzlay,zzlev,z0,            &
+              pu,pv,pt,zpopsk,pq,tsurf,emis,qsurf,   &
+              zdum1,zdum2,pdt,pdq,zflubid,           &
+              zdudif,zdvdif,zdtdif,zdtsdif,          &
+	      sensibFlux,q2,zdqdif,zdqevap,zdqsdif,  &
+              taux,tauy,lastcall)
+
+	 else
+	 
+           zdh(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)/zpopsk(1:ngrid,1:nlayermx)
+ 
+           call vdifc(ngrid,nlayer,nq,rnat,zpopsk,   &
+              ptimestep,capcal,lwrite,               &
+              pplay,pplev,zzlay,zzlev,z0,            &
+              pu,pv,zh,pq,tsurf,emis,qsurf,          &
+              zdum1,zdum2,zdh,pdq,zflubid,           &
+              zdudif,zdvdif,zdhdif,zdtsdif,          &
+	      sensibFlux,q2,zdqdif,zdqsdif,          &
+              taux,tauy,lastcall)
+
+           zdtdif(1:ngrid,1:nlayermx)=zdhdif(1:ngrid,1:nlayermx)*zpopsk(1:ngrid,1:nlayermx) ! for diagnostic only
+	   zdqevap(1:ngrid,1:nlayermx)=0.
+
+         end if !turbdiff
+
+         pdv(1:ngrid,1:nlayermx)=pdv(1:ngrid,1:nlayermx)+zdvdif(1:ngrid,1:nlayermx)
+         pdu(1:ngrid,1:nlayermx)=pdu(1:ngrid,1:nlayermx)+zdudif(1:ngrid,1:nlayermx)
+         pdt(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)+zdtdif(1:ngrid,1:nlayermx)
+         zdtsurf(1:ngrid)=zdtsurf(1:ngrid)+zdtsdif(1:ngrid)
+
+         if(ok_slab_ocean)then
+            flux_sens_lat(1:ngrid)=(zdtsdif(1:ngrid)*capcal(1:ngrid)-fluxrad(1:ngrid))
+         endif
+
+
+
+         if (tracer) then 
+           pdq(1:ngrid,1:nlayermx,1:nq)=pdq(1:ngrid,1:nlayermx,1:nq)+ zdqdif(1:ngrid,1:nlayermx,1:nq)
+           dqsurf(1:ngrid,1:nq)=dqsurf(1:ngrid,1:nq) + zdqsdif(1:ngrid,1:nq)
+         end if ! of if (tracer)
+
+         !-------------------------
+         ! test energy conservation
+         if(enertest)then
+	    dEzdiff(:,:)=cpp*mass(:,:)*zdtdif(:,:)
+            do ig = 1, ngrid
+	       dEdiff(ig)=SUM(dEzdiff (ig,:))+ sensibFlux(ig)! subtract flux to the ground
+	       dEzdiff(ig,1)= dEzdiff(ig,1)+ sensibFlux(ig)! subtract flux to the ground
+            enddo
+	    call planetwide_sumval(dEdiff(:)*area(:)/totarea_planet,dEtot)
+	    dEdiffs(:)=capcal(:)*zdtsdif(:)-zflubid(:)-sensibFlux(:)
+	    call planetwide_sumval(dEdiffs(:)*area(:)/totarea_planet,dEtots)
+	    call planetwide_sumval(sensibFlux(:)*area(:)/totarea_planet,AtmToSurf_TurbFlux)
+	    if (is_master) then
+             if (UseTurbDiff) then
+	       	print*,'In TurbDiff sensible flux (atm=>surf) =',AtmToSurf_TurbFlux,' W m-2'
+               	print*,'In TurbDiff non-cons atm nrj change   =',dEtot,' W m-2'
+               	print*,'In TurbDiff (correc rad+latent heat) surf nrj change =',dEtots,' W m-2'
+	     else
+	       	print*,'In vdifc sensible flux (atm=>surf)    =',AtmToSurf_TurbFlux,' W m-2'
+               	print*,'In vdifc non-cons atm nrj change      =',dEtot,' W m-2'
+               	print*,'In vdifc (correc rad+latent heat) surf nrj change =',dEtots,' W m-2'
+	     end if
+	    endif ! of if (is_master)
+! JL12 note that the black body radiative flux emitted by the surface has been updated by the implicit scheme
+!    but not given back elsewhere
+         endif
+         !-------------------------
+
+         !-------------------------
+         ! test water conservation
+         if(watertest.and.water)then
+	    call planetwide_sumval(massarea(:,:)*zdqdif(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dWtot_tmp)
+	    call planetwide_sumval(zdqsdif(:,igcm_h2o_vap)*area(:)*ptimestep/totarea_planet,dWtots_tmp)
+            do ig = 1, ngrid
+	       vdifcncons(ig)=SUM(mass(ig,:)*zdqdif(ig,:,igcm_h2o_vap))
+	    Enddo
+	    call planetwide_sumval(massarea(:,:)*zdqdif(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
+	    call planetwide_sumval(zdqsdif(:,igcm_h2o_ice)*area(:)*ptimestep/totarea_planet,dWtots)
+	    dWtot = dWtot + dWtot_tmp
+	    dWtots = dWtots + dWtots_tmp
+            do ig = 1, ngrid
+	       vdifcncons(ig)=vdifcncons(ig) + SUM(mass(ig,:)*zdqdif(ig,:,igcm_h2o_ice))
+	    Enddo	    
+	    call planetwide_maxval(vdifcncons(:),nconsMAX)
+
+	    if (is_master) then
+            	print*,'---------------------------------------------------------------'
+            	print*,'In difv atmospheric water change        =',dWtot,' kg m-2'
+            	print*,'In difv surface water change            =',dWtots,' kg m-2'
+            	print*,'In difv non-cons factor                 =',dWtot+dWtots,' kg m-2'
+            	print*,'In difv MAX non-cons factor             =',nconsMAX,' kg m-2 s-1'
+	    endif
+
+         endif
+         !-------------------------
+
+      else    
+
+         if(.not.newtonian)then
+
+            zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + (fluxrad(1:ngrid) + fluxgrd(1:ngrid))/capcal(1:ngrid)
+
+         endif
+
+      endif ! of if (calldifv)
+
+
+!-----------------------------------------------------------------------
+!   5. Dry convective adjustment:
+!   -----------------------------
+
+      if(calladj) then
+
+         zdh(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)/zpopsk(1:ngrid,1:nlayermx)
+         zduadj(1:ngrid,1:nlayermx)=0.0
+         zdvadj(1:ngrid,1:nlayermx)=0.0
+         zdhadj(1:ngrid,1:nlayermx)=0.0
+
+
+         call convadj(ngrid,nlayer,nq,ptimestep,    &
+              pplay,pplev,zpopsk,                   &
+              pu,pv,zh,pq,                          &
+              pdu,pdv,zdh,pdq,                      &
+              zduadj,zdvadj,zdhadj,                 &
+              zdqadj)
+
+         pdu(1:ngrid,1:nlayermx) = pdu(1:ngrid,1:nlayermx) + zduadj(1:ngrid,1:nlayermx)
+         pdv(1:ngrid,1:nlayermx) = pdv(1:ngrid,1:nlayermx) + zdvadj(1:ngrid,1:nlayermx)
+         pdt(1:ngrid,1:nlayermx)    = pdt(1:ngrid,1:nlayermx) + zdhadj(1:ngrid,1:nlayermx)*zpopsk(1:ngrid,1:nlayermx)
+         zdtadj(1:ngrid,1:nlayermx) = zdhadj(1:ngrid,1:nlayermx)*zpopsk(1:ngrid,1:nlayermx) ! for diagnostic only
+
+         if(tracer) then 
+            pdq(1:ngrid,1:nlayermx,1:nq) = pdq(1:ngrid,1:nlayermx,1:nq) + zdqadj(1:ngrid,1:nlayermx,1:nq) 
+         end if
+
+         !-------------------------
+         ! test energy conservation
+         if(enertest)then
+	    call planetwide_sumval(cpp*massarea(:,:)*zdtadj(:,:)/totarea_planet,dEtot)
+            if (is_master) print*,'In convadj atmospheric energy change  =',dEtot,' W m-2'
+         endif
+         !-------------------------
+
+         !-------------------------
+         ! test water conservation
+         if(watertest)then
+	    call planetwide_sumval(massarea(:,:)*zdqadj(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dWtot_tmp)
+            do ig = 1, ngrid
+	       cadjncons(ig)=SUM(mass(ig,:)*zdqadj(ig,:,igcm_h2o_vap))
+	    Enddo
+	    call planetwide_sumval(massarea(:,:)*zdqadj(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
+	    dWtot = dWtot + dWtot_tmp
+            do ig = 1, ngrid
+	       cadjncons(ig)=cadjncons(ig) + SUM(mass(ig,:)*zdqadj(ig,:,igcm_h2o_ice))
+	    Enddo	    
+	    call planetwide_maxval(cadjncons(:),nconsMAX)
+
+            if (is_master) then
+	    	print*,'In convadj atmospheric water change     =',dWtot,' kg m-2'
+            	print*,'In convadj MAX non-cons factor          =',nconsMAX,' kg m-2 s-1'
+	    endif
+         endif
+         !-------------------------
+         
+      endif ! of if(calladj)
+
+!-----------------------------------------------------------------------
+!   6. Carbon dioxide condensation-sublimation:
+!   -------------------------------------------
+
+      if (co2cond) then
+         if (.not.tracer) then
+            print*,'We need a CO2 ice tracer to condense CO2'
+            call abort
+         endif
+         call condense_cloud(ngrid,nlayer,nq,ptimestep,   &
+              capcal,pplay,pplev,tsurf,pt,                  &
+              pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq,        &
+              qsurf(1,igcm_co2_ice),albedo,emis,            &
+              zdtc,zdtsurfc,pdpsrf,zduc,zdvc,               &
+              zdqc)
+
+         pdt(1:ngrid,1:nlayermx)=pdt(1:ngrid,1:nlayermx)+zdtc(1:ngrid,1:nlayermx)
+         pdv(1:ngrid,1:nlayermx)=pdv(1:ngrid,1:nlayermx)+zdvc(1:ngrid,1:nlayermx)
+         pdu(1:ngrid,1:nlayermx)=pdu(1:ngrid,1:nlayermx)+zduc(1:ngrid,1:nlayermx)
+         zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + zdtsurfc(1:ngrid)
+
+         pdq(1:ngrid,1:nlayermx,1:nq)=pdq(1:ngrid,1:nlayermx,1:nq)+ zdqc(1:ngrid,1:nlayermx,1:nq) 
+         ! Note: we do not add surface co2ice tendency
+         ! because qsurf(:,igcm_co2_ice) is updated in condens_co2cloud
+
+         !-------------------------
+         ! test energy conservation
+         if(enertest)then
+	    call planetwide_sumval(cpp*massarea(:,:)*zdtc(:,:)/totarea_planet,dEtot)
+	    call planetwide_sumval(capcal(:)*zdtsurfc(:)*area(:)/totarea_planet,dEtots)
+	    if (is_master) then
+	    	print*,'In co2cloud atmospheric energy change   =',dEtot,' W m-2'
+            	print*,'In co2cloud surface energy change       =',dEtots,' W m-2'
+	    endif
+         endif
+         !-------------------------
+
+      endif  ! of if (co2cond)
+
+
+!-----------------------------------------------------------------------
+!   7. Specific parameterizations for tracers 
+!   -----------------------------------------
+
+      if (tracer) then 
+
+!   7a. Water and ice
+!     ---------------
+         if (water) then
+
+!        ----------------------------------------
+!        Water ice condensation in the atmosphere
+!        ----------------------------------------
+            if(watercond.and.(RLVTT.gt.1.e-8))then
+
+!             ----------------
+!             Moist convection
+!             ----------------
+
+	       dqmoist(1:ngrid,1:nlayermx,1:nq)=0.
+	       dtmoist(1:ngrid,1:nlayermx)=0.
+
+	       call moistadj(ngrid,nq,pt,pq,pdq,pplev,pplay,dtmoist,dqmoist,ptimestep,rneb_man)
+
+               pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) = pdq(1:ngrid,1:nlayermx,igcm_h2o_vap)   &
+	                  +dqmoist(1:ngrid,1:nlayermx,igcm_h2o_vap)
+               pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) =pdq(1:ngrid,1:nlayermx,igcm_h2o_ice)     &
+                          +dqmoist(1:ngrid,1:nlayermx,igcm_h2o_ice)
+               pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)+dtmoist(1:ngrid,1:nlayermx)
+
+               !-------------------------
+               ! test energy conservation
+               if(enertest)then
+		  call planetwide_sumval(cpp*massarea(:,:)*dtmoist(:,:)/totarea_planet,dEtot)
+		  call planetwide_maxval(dtmoist(:,:),dtmoist_max)
+		  call planetwide_minval(dtmoist(:,:),dtmoist_min)
+		  madjdEz(:,:)=cpp*mass(:,:)*dtmoist(:,:)
+                  do ig=1,ngrid
+                     madjdE(ig) = cpp*SUM(mass(:,:)*dtmoist(:,:))
+                  enddo
+		  if (is_master) then
+                  	print*,'In moistadj atmospheric energy change   =',dEtot,' W m-2'
+                  	print*,'In moistadj MAX atmospheric energy change   =',dtmoist_max*ptimestep,'K/step'
+                  	print*,'In moistadj MIN atmospheric energy change   =',dtmoist_min*ptimestep,'K/step'
+		  endif
+		  
+		! test energy conservation
+		  call planetwide_sumval(massarea(:,:)*dqmoist(:,:,igcm_h2o_vap)*ptimestep/totarea_planet+	&
+		  	massarea(:,:)*dqmoist(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
+		  if (is_master) print*,'In moistadj atmospheric water change    =',dWtot,' kg m-2'
+               endif
+               !-------------------------
+	       
+
+!        --------------------------------
+!        Large scale condensation/evaporation
+!        --------------------------------
+               call largescale(ngrid,nq,ptimestep,pplev,pplay,pt,pq,pdt,pdq,dtlscale,dqvaplscale,dqcldlscale,rneb_lsc)
+
+               pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)+dtlscale(1:ngrid,1:nlayermx)
+               pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) = pdq(1:ngrid,1:nlayermx,igcm_h2o_vap)+dqvaplscale(1:ngrid,1:nlayermx)
+               pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) = pdq(1:ngrid,1:nlayermx,igcm_h2o_ice)+dqcldlscale(1:ngrid,1:nlayermx)
+
+               !-------------------------
+               ! test energy conservation
+               if(enertest)then
+                  lscaledEz(:,:) = cpp*mass(:,:)*dtlscale(:,:)
+                  do ig=1,ngrid
+                     lscaledE(ig) = cpp*SUM(mass(:,:)*dtlscale(:,:))
+                  enddo
+		  call planetwide_sumval(cpp*massarea(:,:)*dtlscale(:,:)/totarea_planet,dEtot)
+!		  if(isnan(dEtot)) then ! NB: isnan() is not a standard function...
+!		     print*,'Nan in largescale, abort'
+!                     STOP
+!		  endif
+		  if (is_master) print*,'In largescale atmospheric energy change =',dEtot,' W m-2'
+
+               ! test water conservation
+		  call planetwide_sumval(massarea(:,:)*dqvaplscale(:,:)*ptimestep/totarea_planet+	&
+		  	SUM(massarea(:,:)*dqcldlscale(:,:))*ptimestep/totarea_planet,dWtot)
+		  if (is_master) print*,'In largescale atmospheric water change  =',dWtot,' kg m-2'
+               endif
+               !-------------------------
+
+               ! compute cloud fraction
+               do l = 1, nlayer
+                  do ig=1,ngrid
+                     cloudfrac(ig,l)=MAX(rneb_lsc(ig,l),rneb_man(ig,l)) 
+                  enddo
+               enddo
+
+            endif                ! of if (watercondense)
+           
+
+!        --------------------------------
+!        Water ice / liquid precipitation
+!        --------------------------------
+            if(waterrain)then
+
+               zdqrain(1:ngrid,1:nlayermx,1:nq) = 0.0
+               zdqsrain(1:ngrid)    = 0.0
+               zdqssnow(1:ngrid)    = 0.0
+
+               call rain(ngrid,nq,ptimestep,pplev,pplay,pt,pdt,pq,pdq,            &
+                   zdtrain,zdqrain,zdqsrain,zdqssnow,cloudfrac)
+
+               pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) = pdq(1:ngrid,1:nlayermx,igcm_h2o_vap) &
+	             +zdqrain(1:ngrid,1:nlayermx,igcm_h2o_vap)
+               pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) = pdq(1:ngrid,1:nlayermx,igcm_h2o_ice) &
+	             +zdqrain(1:ngrid,1:nlayermx,igcm_h2o_ice)
+               pdt(1:ngrid,1:nlayermx) = pdt(1:ngrid,1:nlayermx)+zdtrain(1:ngrid,1:nlayermx)
+               dqsurf(1:ngrid,igcm_h2o_vap) = dqsurf(1:ngrid,igcm_h2o_vap)+zdqsrain(1:ngrid) ! a bug was here
+               dqsurf(1:ngrid,igcm_h2o_ice) = dqsurf(1:ngrid,igcm_h2o_ice)+zdqssnow(1:ngrid)
+               rainout(1:ngrid)             = zdqsrain(1:ngrid)+zdqssnow(1:ngrid) ! diagnostic   
+
+               !-------------------------
+               ! test energy conservation
+               if(enertest)then
+		  call planetwide_sumval(cpp*massarea(:,:)*zdtrain(:,:)/totarea_planet,dEtot)
+		  if (is_master) print*,'In rain atmospheric T energy change       =',dEtot,' W m-2'
+		  call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_ice)/totarea_planet*RLVTT/cpp,dItot_tmp)
+		  call planetwide_sumval(area(:)*zdqssnow(:)/totarea_planet*RLVTT/cpp,dItot)
+		  dItot = dItot + dItot_tmp
+		  call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_vap)*ptimestep/totarea_planet,dVtot_tmp)
+		  call planetwide_sumval(area(:)*zdqsrain(:)/totarea_planet*RLVTT/cpp,dVtot)
+		  dVtot = dVtot + dVtot_tmp
+		  dEtot = dItot + dVtot
+		  if (is_master) then
+                  	print*,'In rain dItot =',dItot,' W m-2'
+                  	print*,'In rain dVtot =',dVtot,' W m-2'
+                  	print*,'In rain atmospheric L energy change       =',dEtot,' W m-2'
+		  endif
+
+               ! test water conservation
+		  call planetwide_sumval(massarea(:,:)*zdqrain(:,:,igcm_h2o_vap)*ptimestep/totarea_planet+	&
+		  	massarea(:,:)*zdqrain(:,:,igcm_h2o_ice)*ptimestep/totarea_planet,dWtot)
+		  call planetwide_sumval((zdqsrain(:)+zdqssnow(:))*area(:)*ptimestep/totarea_planet,dWtots)
+		  if (is_master) then
+                  	print*,'In rain atmospheric water change        =',dWtot,' kg m-2'
+                  	print*,'In rain surface water change            =',dWtots,' kg m-2'
+                  	print*,'In rain non-cons factor                 =',dWtot+dWtots,' kg m-2'
+		  endif
+              endif
+              !-------------------------
+
+            end if                 ! of if (waterrain)
+         end if                    ! of if (water)
+
+
+!   7c. Aerosol particles
+!     -------------------
+!        ------------- 
+!        Sedimentation
+!        ------------- 
+        if (sedimentation) then 
+           zdqsed(1:ngrid,1:nlayermx,1:nq) = 0.0
+           zdqssed(1:ngrid,1:nq)  = 0.0
+
+
+           !-------------------------
+           ! find qtot
+           if(watertest)then
+              iq=igcm_h2o_ice
+	      call planetwide_sumval(massarea(:,:)*pq(:,:,iq)*ptimestep/totarea_planet,dWtot)
+	      call planetwide_sumval(massarea(:,:)*pdq(:,:,iq)*ptimestep/totarea_planet,dWtots)
+	      if (is_master) then
+	      	print*,'Before sedim pq  =',dWtot,' kg m-2'
+              	print*,'Before sedim pdq =',dWtots,' kg m-2'
+	      endif
+           endif
+           !-------------------------
+
+           call callsedim(ngrid,nlayer,ptimestep,           &
+                pplev,zzlev,pt,pdt,pq,pdq,zdqsed,zdqssed,nq)
+
+           !-------------------------
+           ! find qtot
+           if(watertest)then
+              iq=igcm_h2o_ice
+	      call planetwide_sumval(massarea(:,:)*pq(:,:,iq)*ptimestep/totarea_planet,dWtot)
+	      call planetwide_sumval(massarea(:,:)*pdq(:,:,iq)*ptimestep/totarea_planet,dWtots)
+	      if (is_master) then
+              	print*,'After sedim pq  =',dWtot,' kg m-2'
+              	print*,'After sedim pdq =',dWtots,' kg m-2'
+  	      endif
+           endif
+           !-------------------------
+
+           ! for now, we only allow H2O ice to sediment
+              ! and as in rain.F90, whether it falls as rain or snow depends
+              ! only on the surface temperature
+           pdq(1:ngrid,1:nlayermx,1:nq) = pdq(1:ngrid,1:nlayermx,1:nq) + zdqsed(1:ngrid,1:nlayermx,1:nq)
+           dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + zdqssed(1:ngrid,1:nq)
+
+           !-------------------------
+           ! test water conservation
+           if(watertest)then
+	      call planetwide_sumval(massarea(:,:)*(zdqsed(:,:,igcm_h2o_vap)+zdqsed(:,:,igcm_h2o_ice))*ptimestep/totarea_planet,dWtot)
+	      call planetwide_sumval((zdqssed(:,igcm_h2o_vap)+zdqssed(:,igcm_h2o_ice))*area(:)*ptimestep/totarea_planet,dWtots)
+	      if (is_master) then
+              	print*,'In sedim atmospheric ice change         =',dWtot,' kg m-2'
+              	print*,'In sedim surface ice change             =',dWtots,' kg m-2'
+              	print*,'In sedim non-cons factor                =',dWtot+dWtots,' kg m-2'
+	      endif
+           endif
+           !-------------------------
+
+        end if   ! of if (sedimentation)
+
+
+!   7d. Updates
+!     ---------
+
+!       -----------------------------------
+!       Updating atm mass and tracer budget
+!       -----------------------------------
+
+         if(mass_redistrib) then
+
+            zdmassmr(1:ngrid,1:nlayermx) = mass(1:ngrid,1:nlayermx) * &
+	       (   zdqevap(1:ngrid,1:nlayermx)                          &
+	         + zdqrain(1:ngrid,1:nlayermx,igcm_h2o_vap)             &
+		 + dqmoist(1:ngrid,1:nlayermx,igcm_h2o_vap)             &
+		 + dqvaplscale(1:ngrid,1:nlayermx) )
+
+            do ig = 1, ngrid
+	       zdmassmr_col(ig)=SUM(zdmassmr(ig,1:nlayermx))
+            enddo
+            
+	    call writediagfi(ngrid,"mass_evap","mass gain"," ",3,zdmassmr)
+	    call writediagfi(ngrid,"mass_evap_col","mass gain col"," ",2,zdmassmr_col)
+	    call writediagfi(ngrid,"mass","mass"," ",3,mass)
+
+	    call mass_redistribution(ngrid,nlayer,nq,ptimestep,   &
+                       rnat,capcal,pplay,pplev,pt,tsurf,pq,qsurf,     &
+		       pu,pv,pdt,zdtsurf,pdq,pdu,pdv,zdmassmr,  &
+		       zdtmr,zdtsurfmr,zdpsrfmr,zdumr,zdvmr,zdqmr,zdqsurfmr)
+	 
+
+            pdq(1:ngrid,1:nlayermx,1:nq) = pdq(1:ngrid,1:nlayermx,1:nq) + zdqmr(1:ngrid,1:nlayermx,1:nq)
+            dqsurf(1:ngrid,1:nq)         = dqsurf(1:ngrid,1:nq) + zdqsurfmr(1:ngrid,1:nq)
+            pdt(1:ngrid,1:nlayermx)        = pdt(1:ngrid,1:nlayermx) + zdtmr(1:ngrid,1:nlayermx)
+            pdu(1:ngrid,1:nlayermx)        = pdu(1:ngrid,1:nlayermx) + zdumr(1:ngrid,1:nlayermx)
+            pdv(1:ngrid,1:nlayermx)        = pdv(1:ngrid,1:nlayermx) + zdvmr(1:ngrid,1:nlayermx)
+	    pdpsrf(1:ngrid)                = pdpsrf(1:ngrid) + zdpsrfmr(1:ngrid)
+            zdtsurf(1:ngrid)               = zdtsurf(1:ngrid) + zdtsurfmr(1:ngrid)
+	    
+!	    print*,'after mass redistrib, q=',pq(211,1:nlayermx,igcm_h2o_vap)+ptimestep*pdq(211,1:nlayermx,igcm_h2o_vap) 
+	 endif
+
+
+!   7e. Ocean
+!     ---------
+
+!       ---------------------------------
+!       Slab_ocean
+!       ---------------------------------
+      if (ok_slab_ocean)then
+
+         do ig=1,ngrid
+            qsurfint(:,igcm_h2o_ice)=qsurf(:,igcm_h2o_ice)
+         enddo
+
+         call ocean_slab_ice(ptimestep, &
+               ngrid, knindex, tsea_ice, fluxrad, &
+               zdqssnow, qsurf(:,igcm_h2o_ice), &
+               -zdqsdif(:,igcm_h2o_vap), &
+               flux_sens_lat,tsea_ice, pctsrf_sic, &
+               taux,tauy,icount)
+
+
+         call ocean_slab_get_vars(ngrid,tslab, &
+               sea_ice, flux_o, &
+               flux_g, dt_hdiff, &
+               dt_ekman)
+
+            do ig=1,ngrid
+               if (nint(rnat(ig)).eq.1)then
+               tslab(ig,1) = 0.
+               tslab(ig,2) = 0.
+               tsea_ice(ig) = 0.
+               sea_ice(ig) = 0.
+               pctsrf_sic(ig) = 0.
+               qsurf(ig,igcm_h2o_ice)=qsurfint(ig,igcm_h2o_ice)
+               endif
+            enddo
+
+
+      endif! (ok_slab_ocean)
+
+!       ---------------------------------
+!       Updating tracer budget on surface
+!       ---------------------------------
+
+         if(hydrology)then
+            
+            call hydrol(ngrid,nq,ptimestep,rnat,tsurf,qsurf,dqsurf,dqs_hyd,    &
+               capcal,albedo0,albedo,mu0,zdtsurf,zdtsurf_hyd,hice,pctsrf_sic,  &
+               sea_ice)
+            ! note: for now, also changes albedo in the subroutine
+
+            zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + zdtsurf_hyd(1:ngrid)
+            qsurf(1:ngrid,1:nq) = qsurf(1:ngrid,1:nq) + ptimestep*dqs_hyd(1:ngrid,1:nq)
+            ! when hydrology is used, other dqsurf tendencies are all added to dqs_hyd inside
+
+            !-------------------------
+            ! test energy conservation
+            if(enertest)then
+	       call planetwide_sumval(area(:)*capcal(:)*zdtsurf_hyd(:)/totarea_planet,dEtots)
+	       if (is_master) print*,'In hydrol surface energy change     =',dEtots,' W m-2'
+            endif
+            !-------------------------
+
+            !-------------------------
+            ! test water conservation
+            if(watertest)then
+	       call planetwide_sumval(dqs_hyd(:,igcm_h2o_ice)*area(:)*ptimestep/totarea_planet,dWtots)
+	       if (is_master) print*,'In hydrol surface ice change            =',dWtots,' kg m-2'
+	       call planetwide_sumval(dqs_hyd(:,igcm_h2o_vap)*area(:)*ptimestep/totarea_planet,dWtots)
+	       if (is_master) then
+               	print*,'In hydrol surface water change          =',dWtots,' kg m-2'
+               	print*,'---------------------------------------------------------------'
+	       endif
+            endif
+            !-------------------------
+
+         ELSE     ! of if (hydrology)
+
+            qsurf(1:ngrid,1:nq)=qsurf(1:ngrid,1:nq)+ptimestep*dqsurf(1:ngrid,1:nq)
+
+         END IF   ! of if (hydrology)
+
+         ! Add qsurf to qsurf_hist, which is what we save in
+         ! diagfi.nc etc. At the same time, we set the water 
+         ! content of ocean gridpoints back to zero, in order
+         ! to avoid rounding errors in vdifc, rain
+         qsurf_hist(:,:) = qsurf(:,:)
+
+         if(ice_update)then
+            ice_min(1:ngrid)=min(ice_min(1:ngrid),qsurf(1:ngrid,igcm_h2o_ice))
+         endif
+
+      endif   !  of if (tracer) 
+
+!-----------------------------------------------------------------------
+!   9. Surface and sub-surface soil temperature
+!-----------------------------------------------------------------------
+
+!     Increment surface temperature
+
+      if(ok_slab_ocean)then
+         do ig=1,ngrid
+           if (nint(rnat(ig)).eq.0)then
+             zdtsurf(ig)= (tslab(ig,1)              &
+             + pctsrf_sic(ig)*(tsea_ice(ig)-tslab(ig,1))-tsurf(ig))/ptimestep
+           endif
+           tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig)
+         enddo
+   
+      else
+        tsurf(1:ngrid)=tsurf(1:ngrid)+ptimestep*zdtsurf(1:ngrid) 
+      endif!(ok_slab_ocean)
+
+!     Compute soil temperatures and subsurface heat flux
+      if (callsoil) then
+         call soil(ngrid,nsoilmx,.false.,lastcall,inertiedat,   &
+                ptimestep,tsurf,tsoil,capcal,fluxgrd)     
+      endif
+
+
+      if (ok_slab_ocean) then
+            do ig=1,ngrid
+               fluxgrdocean(ig)=fluxgrd(ig)
+               if (nint(rnat(ig)).eq.0) then
+               capcal(ig)=capcalocean
+               fluxgrd(ig)=0.
+               fluxgrdocean(ig)=pctsrf_sic(ig)*flux_g(ig)+(1-pctsrf_sic(ig))*(dt_hdiff(ig,1)+dt_ekman(ig,1))
+                 do iq=1,nsoilmx
+                    tsoil(ig,iq)=tsurf(ig)
+                 enddo
+                 if (pctsrf_sic(ig).gt.0.5) then
+                   capcal(ig)=capcalseaice
+                   if (qsurf(ig,igcm_h2o_ice).gt.0.) then
+                   capcal(ig)=capcalsno
+                   endif
+                 endif
+               endif
+            enddo
+      endif !(ok_slab_ocean)
+
+!-------------------------
+! test energy conservation
+      if(enertest)then
+	 call planetwide_sumval(area(:)*capcal(:)*zdtsurf(:)/totarea_planet,dEtots)	 
+	 if (is_master) print*,'Surface energy change                 =',dEtots,' W m-2'
+      endif
+!-------------------------
+
+!-----------------------------------------------------------------------
+!  10. Perform diagnostics and write output files
+!-----------------------------------------------------------------------
+
+!    -------------------------------
+!    Dynamical fields incrementation
+!    -------------------------------
+!    For output only: the actual model integration is performed in the dynamics
+ 
+      ! temperature, zonal and meridional wind
+      zt(1:ngrid,1:nlayermx) = pt(1:ngrid,1:nlayermx) + pdt(1:ngrid,1:nlayermx)*ptimestep
+      zu(1:ngrid,1:nlayermx) = pu(1:ngrid,1:nlayermx) + pdu(1:ngrid,1:nlayermx)*ptimestep
+      zv(1:ngrid,1:nlayermx) = pv(1:ngrid,1:nlayermx) + pdv(1:ngrid,1:nlayermx)*ptimestep
+
+      ! diagnostic
+      zdtdyn(1:ngrid,1:nlayermx)     = pt(1:ngrid,1:nlayermx)-ztprevious(1:ngrid,1:nlayermx)
+      ztprevious(1:ngrid,1:nlayermx) = zt(1:ngrid,1:nlayermx)
+
+      if(firstcall)then
+         zdtdyn(1:ngrid,1:nlayermx)=0.0
+      endif
+
+      ! dynamical heating diagnostic
+      do ig=1,ngrid
+         fluxdyn(ig)= SUM(zdtdyn(ig,:) *mass(ig,:))*cpp/ptimestep
+      enddo
+
+      ! tracers
+      zq(1:ngrid,1:nlayermx,1:nq) = pq(1:ngrid,1:nlayermx,1:nq) + pdq(1:ngrid,1:nlayermx,1:nq)*ptimestep
+
+      ! surface pressure
+      ps(1:ngrid) = pplev(1:ngrid,1) + pdpsrf(1:ngrid)*ptimestep
+
+      ! pressure
+      do l=1,nlayer
+          zplev(1:ngrid,l) = pplev(1:ngrid,l)/pplev(1:ngrid,1)*ps(:)
+          zplay(1:ngrid,l) = pplay(1:ngrid,l)/pplev(1:ngrid,1)*ps(1:ngrid)
+      enddo
+
+!     ---------------------------------------------------------
+!     Surface and soil temperature information
+!     ---------------------------------------------------------
+
+      call planetwide_sumval(area(:)*tsurf(:)/totarea_planet,Ts1)
+      call planetwide_minval(tsurf(:),Ts2)
+      call planetwide_maxval(tsurf(:),Ts3)
+      if(callsoil)then
+         TsS = SUM(area(:)*tsoil(:,nsoilmx))/totarea        ! mean temperature at bottom soil layer
+           print*,'  ave[Tsurf]     min[Tsurf]     max[Tsurf]     ave[Tdeep]'
+           print*,Ts1,Ts2,Ts3,TsS
+      else
+      	if (is_master) then
+           print*,'  ave[Tsurf]     min[Tsurf]     max[Tsurf]'
+           print*,Ts1,Ts2,Ts3
+	endif
+      end if
+
+!     ---------------------------------------------------------
+!     Check the energy balance of the simulation during the run
+!     ---------------------------------------------------------
+
+      if(corrk)then
+
+	 call planetwide_sumval(area(:)*fluxtop_dn(:)/totarea_planet,ISR)
+	 call planetwide_sumval(area(:)*fluxabs_sw(:)/totarea_planet,ASR)
+	 call planetwide_sumval(area(:)*fluxtop_lw(:)/totarea_planet,OLR)
+	 call planetwide_sumval(area(:)*fluxgrd(:)/totarea_planet,GND)
+	 call planetwide_sumval(area(:)*fluxdyn(:)/totarea_planet,DYN)
+         do ig=1,ngrid
+            if(fluxtop_dn(ig).lt.0.0)then
+               print*,'fluxtop_dn has gone crazy'
+               print*,'fluxtop_dn=',fluxtop_dn(ig)
+               print*,'tau_col=',tau_col(ig)
+               print*,'aerosol=',aerosol(ig,:,:)
+               print*,'temp=   ',pt(ig,:)
+               print*,'pplay=  ',pplay(ig,:)
+               call abort
+            endif
+         end do
+                     
+         if(ngrid.eq.1)then
+            DYN=0.0
+         endif
+	 
+	 if (is_master) then
+         	print*,'  ISR            ASR            OLR            GND            DYN [W m^-2]'
+         	print*, ISR,ASR,OLR,GND,DYN
+	 endif
+
+         if(enertest .and. is_master)then
+            print*,'SW flux/heating difference SW++ - ASR = ',dEtotSW+dEtotsSW-ASR,' W m-2'
+            print*,'LW flux/heating difference LW++ - OLR = ',dEtotLW+dEtotsLW+OLR,' W m-2'
+            print*,'LW energy balance LW++ + ASR = ',dEtotLW+dEtotsLW+ASR,' W m-2'
+         endif
+
+         if(meanOLR .and. is_master)then
+            if((ngrid.gt.1) .or. (mod(icount-1,ecritphy).eq.0))then
+               ! to record global radiative balance
+               open(92,file="rad_bal.out",form='formatted',position='append')
+               write(92,*) zday,ISR,ASR,OLR
+               close(92)
+               open(93,file="tem_bal.out",form='formatted',position='append')
+               if(callsoil)then
+               	write(93,*) zday,Ts1,Ts2,Ts3,TsS
+	       else
+	        write(93,*) zday,Ts1,Ts2,Ts3
+	       endif
+               close(93)
+            endif
+         endif
+
+      endif
+
+
+!     ------------------------------------------------------------------
+!     Diagnostic to test radiative-convective timescales in code
+!     ------------------------------------------------------------------
+      if(testradtimes)then
+         open(38,file="tau_phys.out",form='formatted',position='append')
+         ig=1
+         do l=1,nlayer
+            write(38,*) -1./pdt(ig,l),pt(ig,l),pplay(ig,l)
+         enddo
+         close(38)
+         print*,'As testradtimes enabled,'
+         print*,'exiting physics on first call'
+         call abort
+      endif
+
+!     ---------------------------------------------------------
+!     Compute column amounts (kg m-2) if tracers are enabled
+!     ---------------------------------------------------------
+      if(tracer)then
+         qcol(1:ngrid,1:nq)=0.0
+         do iq=1,nq
+           do ig=1,ngrid
+              qcol(ig,iq) = SUM( zq(ig,1:nlayermx,iq) * mass(ig,1:nlayermx))
+           enddo
+         enddo
+
+         ! Generalised for arbitrary aerosols now. (LK)
+         reffcol(1:ngrid,1:naerkind)=0.0
+         if(co2cond.and.(iaero_co2.ne.0))then
+            call co2_reffrad(ngrid,nq,zq,reffrad(1,1,iaero_co2))
+            do ig=1,ngrid
+               reffcol(ig,iaero_co2) = SUM(zq(ig,1:nlayermx,igcm_co2_ice)*reffrad(ig,1:nlayermx,iaero_co2)*mass(ig,1:nlayermx))
+            enddo
+         endif
+         if(water.and.(iaero_h2o.ne.0))then
+            call h2o_reffrad(ngrid,zq(1,1,igcm_h2o_ice),zt, &
+                             reffrad(1,1,iaero_h2o),nueffrad(1,1,iaero_h2o))
+            do ig=1,ngrid
+               reffcol(ig,iaero_h2o) = SUM(zq(ig,1:nlayermx,igcm_h2o_ice)*reffrad(ig,1:nlayermx,iaero_h2o)*mass(ig,1:nlayermx))
+            enddo
+         endif
+
+      endif
+
+!     ---------------------------------------------------------
+!     Test for water conservation if water is enabled
+!     ---------------------------------------------------------
+
+      if(water)then
+
+	 call planetwide_sumval(area(:)*qsurf_hist(:,igcm_h2o_ice)/totarea_planet,icesrf)
+	 call planetwide_sumval(area(:)*qsurf_hist(:,igcm_h2o_vap)/totarea_planet,liqsrf)
+	 call planetwide_sumval(area(:)*qcol(:,igcm_h2o_ice)/totarea_planet,icecol)
+	 call planetwide_sumval(area(:)*qcol(:,igcm_h2o_vap)/totarea_planet,vapcol)
+
+         h2otot = icesrf + liqsrf + icecol + vapcol
+	 
+	 if (is_master) then
+         	print*,' Total water amount [kg m^-2]: ',h2otot
+         	print*,' Surface ice    Surface liq.   Atmos. con.     Atmos. vap. [kg m^-2] '
+         	print*, icesrf,liqsrf,icecol,vapcol
+	 endif
+
+         if(meanOLR .and. is_master)then
+            if((ngrid.gt.1) .or. (mod(icount-1,ecritphy).eq.0))then
+               ! to record global water balance
+               open(98,file="h2o_bal.out",form='formatted',position='append')
+               write(98,*) zday,icesrf,liqsrf,icecol,vapcol
+               close(98)
+            endif
+         endif
+
+      endif
+
+!     ---------------------------------------------------------
+!     Calculate RH for diagnostic if water is enabled
+!     ---------------------------------------------------------
+
+      if(water)then
+         do l = 1, nlayer
+            do ig=1,ngrid
+               call Psat_water(zt(ig,l),pplay(ig,l),psat_tmp,qsat(ig,l))
+               RH(ig,l) = zq(ig,l,igcm_h2o_vap) / qsat(ig,l)
+            enddo
+         enddo
+
+         ! compute maximum possible H2O column amount (100% saturation)
+         do ig=1,ngrid
+               H2Omaxcol(ig) = SUM( qsat(ig,:) * mass(ig,:))
+         enddo
+
+      endif
+
+
+           print*,'--> Ls =',zls*180./pi
+!        -------------------------------------------------------------------
+!        Writing NetCDF file  "RESTARTFI" at the end of the run
+!        -------------------------------------------------------------------
+!        Note: 'restartfi' is stored just before dynamics are stored
+!              in 'restart'. Between now and the writting of 'restart',
+!              there will have been the itau=itau+1 instruction and
+!              a reset of 'time' (lastacll = .true. when itau+1= itaufin)
+!              thus we store for time=time+dtvr
+
+         if(lastcall) then
+            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec)
+
+
+!           Update surface ice distribution to iterate to steady state if requested
+            if(ice_update)then
+
+               do ig=1,ngrid
+
+                  delta_ice = (qsurf(ig,igcm_h2o_ice)-ice_initial(ig))
+
+                  ! add multiple years of evolution
+                  qsurf_hist(ig,igcm_h2o_ice) = qsurf_hist(ig,igcm_h2o_ice) + delta_ice*icetstep 
+
+                  ! if ice has gone -ve, set to zero
+                  if(qsurf_hist(ig,igcm_h2o_ice).lt.0.0)then
+                     qsurf_hist(ig,igcm_h2o_ice) = 0.0 
+                  endif
+
+                  ! if ice is seasonal, set to zero (NEW)
+                  if(ice_min(ig).lt.0.01)then
+                     qsurf_hist(ig,igcm_h2o_ice) = 0.0 
+                  endif
+
+               enddo
+
+               ! enforce ice conservation
+               ice_tot= SUM(qsurf_hist(:,igcm_h2o_ice)*area(:) )
+               qsurf_hist(:,igcm_h2o_ice) = qsurf_hist(:,igcm_h2o_ice)*(icesrf/ice_tot)
+
+            endif
+
+            if (ngrid.ne.1) then
+              write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+!#ifdef CPP_PARA
+!! for now in parallel we use a different routine to write restartfi.nc
+!            call phyredem(ngrid,"restartfi.nc",           &
+!                    ptimestep,pday,ztime_fin,tsurf,tsoil,emis,q2,qsurf_hist, &
+!                    cloudfrac,totcloudfrac,hice)
+!#else
+!            call physdem1(ngrid,"restartfi.nc",long,lati,nsoilmx,nq,            &
+!                    ptimestep,pday,ztime_fin,tsurf,tsoil,emis,q2,qsurf_hist, &
+!                    area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe,      &
+!                    cloudfrac,totcloudfrac,hice,noms)
+!#endif
+              call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq, &
+                      ptimestep,ztime_fin, &
+                      tsurf,tsoil,emis,q2,qsurf_hist, &
+                      cloudfrac,totcloudfrac,hice, &
+                      rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+            endif
+
+            if(ok_slab_ocean) then
+              call ocean_slab_final!(tslab, seaice)
+            end if
+
+         
+         endif ! of if (lastcall)
+
+
+!        -----------------------------------------------------------------
+!        Saving statistics :
+!        -----------------------------------------------------------------
+!        ("stats" stores and accumulates 8 key variables in file "stats.nc"
+!        which can later be used to make the statistic files of the run:
+!        "stats")          only possible in 3D runs !
+
+         
+         if (callstats) then
+
+            call wstats(ngrid,"ps","Surface pressure","Pa",2,ps)
+            call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf)
+            call wstats(ngrid,"fluxsurf_lw",                               &
+                        "Thermal IR radiative flux to surface","W.m-2",2,  &
+                         fluxsurf_lw)
+!            call wstats(ngrid,"fluxsurf_sw",                               &
+!                        "Solar radiative flux to surface","W.m-2",2,       &
+!                         fluxsurf_sw_tot)
+            call wstats(ngrid,"fluxtop_lw",                                &
+                        "Thermal IR radiative flux to space","W.m-2",2,    &
+                        fluxtop_lw)
+!            call wstats(ngrid,"fluxtop_sw",                                &
+!                        "Solar radiative flux to space","W.m-2",2,         &
+!                        fluxtop_sw_tot)
+
+            call wstats(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn)
+            call wstats(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw)
+            call wstats(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw)
+            call wstats(ngrid,"ALB","Surface albedo"," ",2,albedo)
+            call wstats(ngrid,"p","Pressure","Pa",3,pplay)
+            call wstats(ngrid,"temp","Atmospheric temperature","K",3,zt)
+            call wstats(ngrid,"u","Zonal (East-West) wind","m.s-1",3,zu)
+            call wstats(ngrid,"v","Meridional (North-South) wind","m.s-1",3,zv)
+            call wstats(ngrid,"w","Vertical (down-up) wind","m.s-1",3,pw)
+            call wstats(ngrid,"q2","Boundary layer eddy kinetic energy","m2.s-2",3,q2)
+
+           if (tracer) then
+             do iq=1,nq
+                call wstats(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq))
+                call wstats(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  & 
+                          'kg m^-2',2,qsurf(1,iq) )
+
+                call wstats(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col',    & 
+                          'kg m^-2',2,qcol(1,iq) )
+!                call wstats(ngrid,trim(noms(iq))//'_reff',                          & 
+!                          trim(noms(iq))//'_reff',                                   & 
+!                          'm',3,reffrad(1,1,iq))
+              end do
+            if (water) then
+               vmr=zq(1:ngrid,1:nlayermx,igcm_h2o_vap)*mugaz/mmol(igcm_h2o_vap)
+               call wstats(ngrid,"vmr_h2ovapor",                           &
+                          "H2O vapour volume mixing ratio","mol/mol",       & 
+                          3,vmr)
+            endif ! of if (water)
+
+           endif !tracer 
+
+          if(watercond.and.CLFvarying)then
+             call wstats(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man)
+             call wstats(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc)
+             call wstats(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac)
+             call wstats(ngrid,"CLFt","H2O column cloud fraction"," ",2,totcloudfrac)
+             call wstats(ngrid,"RH","relative humidity"," ",3,RH)
+          endif
+
+
+
+           if (ok_slab_ocean) then
+            call wstats(ngrid,"dt_hdiff1","dt_hdiff1","K/s",2,dt_hdiff(:,1))
+            call wstats(ngrid,"dt_hdiff2","dt_hdiff2","K/s",2,dt_hdiff(:,2))
+            call wstats(ngrid,"dt_ekman1","dt_ekman1","K/s",2,dt_ekman(:,1))
+            call wstats(ngrid,"dt_ekman2","dt_ekman2","K/s",2,dt_ekman(:,2))
+            call wstats(ngrid,"tslab1","tslab1","K",2,tslab(:,1))
+            call wstats(ngrid,"tslab2","tslab2","K",2,tslab(:,2))
+            call wstats(ngrid,"pctsrf_sic","pct ice/sea","",2,pctsrf_sic)
+            call wstats(ngrid,"tsea_ice","tsea_ice","K",2,tsea_ice)
+            call wstats(ngrid,"sea_ice","sea ice","kg/m2",2,sea_ice)
+            call wstats(ngrid,"rnat","nature of the surface","",2,rnat)
+           endif! (ok_slab_ocean)
+
+            if(lastcall) then
+              write (*,*) "Writing stats..."
+              call mkstats(ierr)
+            endif
+          endif !if callstats
+
+
+!        ----------------------------------------------------------------------
+!        output in netcdf file "DIAGFI", containing any variable for diagnostic
+!        (output with  period "ecritphy", set in "run.def")
+!        ----------------------------------------------------------------------
+!        writediagfi can also be called from any other subroutine for any variable.
+!        but its preferable to keep all the calls in one place...
+
+        call writediagfi(ngrid,"Ls","solar longitude","deg",0,zls*180./pi)
+        call writediagfi(ngrid,"tsurf","Surface temperature","K",2,tsurf)
+        call writediagfi(ngrid,"ps","Surface pressure","Pa",2,ps)
+        call writediagfi(ngrid,"temp","temperature","K",3,zt)
+        call writediagfi(ngrid,"teta","potential temperature","K",3,zh)
+        call writediagfi(ngrid,"u","Zonal wind","m.s-1",3,zu)
+        call writediagfi(ngrid,"v","Meridional wind","m.s-1",3,zv)
+        call writediagfi(ngrid,"w","Vertical wind","m.s-1",3,pw)
+        call writediagfi(ngrid,"p","Pressure","Pa",3,pplay)
+
+!     Subsurface temperatures
+!        call writediagsoil(ngrid,"tsurf","Surface temperature","K",2,tsurf)
+!        call writediagsoil(ngrid,"temp","temperature","K",3,tsoil)
+
+!     Oceanic layers
+        if(ok_slab_ocean) then
+          call writediagfi(ngrid,"pctsrf_sic","pct ice/sea","",2,pctsrf_sic)
+          call writediagfi(ngrid,"tsea_ice","tsea_ice","K",2,tsea_ice)
+          call writediagfi(ngrid,"sea_ice","sea ice","kg/m2",2,sea_ice)
+          call writediagfi(ngrid,"tslab1","tslab1","K",2,tslab(:,1))
+          call writediagfi(ngrid,"tslab2","tslab2","K",2,tslab(:,2))
+          call writediagfi(ngrid,"dt_hdiff1","dt_hdiff1","K/s",2,dt_hdiff(:,1))
+          call writediagfi(ngrid,"dt_hdiff2","dt_hdiff2","K/s",2,dt_hdiff(:,2))
+          call writediagfi(ngrid,"dt_ekman1","dt_ekman1","K/s",2,dt_ekman(:,1))
+          call writediagfi(ngrid,"dt_ekman2","dt_ekman2","K/s",2,dt_ekman(:,2))
+          call writediagfi(ngrid,"rnat","nature of the surface","",2,rnat)
+          call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux)
+          call writediagfi(ngrid,"latentFlux","latent heat flux","w.m^-2",2,zdqsdif(:,igcm_h2o_vap)*RLVTT)
+       endif! (ok_slab_ocean)
+
+!     Total energy balance diagnostics
+        if(callrad.and.(.not.newtonian))then
+           call writediagfi(ngrid,"ALB","Surface albedo"," ",2,albedo)
+           call writediagfi(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn)
+           call writediagfi(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw)
+           call writediagfi(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw)
+           call writediagfi(ngrid,"shad","rings"," ", 2, fract)
+!           call writediagfi(ngrid,"ASRcs","absorbed stellar rad (cs).","W m-2",2,fluxabs_sw1)
+!           call writediagfi(ngrid,"OLRcs","outgoing longwave rad (cs).","W m-2",2,fluxtop_lw1)
+!           call writediagfi(ngrid,"fluxsurfsw","sw surface flux.","W m-2",2,fluxsurf_sw)
+!           call writediagfi(ngrid,"fluxsurflw","lw back radiation.","W m-2",2,fluxsurf_lw)
+!           call writediagfi(ngrid,"fluxsurfswcs","sw surface flux (cs).","W m-2",2,fluxsurf_sw1)
+!           call writediagfi(ngrid,"fluxsurflwcs","lw back radiation (cs).","W m-2",2,fluxsurf_lw1)
+           if(ok_slab_ocean) then
+             call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrdocean)
+           else
+             call writediagfi(ngrid,"GND","heat flux from ground","W m-2",2,fluxgrd)
+           endif!(ok_slab_ocean)
+           call writediagfi(ngrid,"DYN","dynamical heat input","W m-2",2,fluxdyn)
+	 endif
+	
+	if(enertest) then
+	  if (calldifv) then
+	     call writediagfi(ngrid,"q2","turbulent kinetic energy","J.kg^-1",3,q2)
+!	     call writediagfi(ngrid,"dEzdiff","turbulent diffusion heating (-sensible flux)","w.m^-2",3,dEzdiff)
+!	     call writediagfi(ngrid,"dEdiff","integrated turbulent diffusion heating (-sensible flux)","w.m^-2",2,dEdiff)
+!	     call writediagfi(ngrid,"dEdiffs","In TurbDiff (correc rad+latent heat) surf nrj change","w.m^-2",2,dEdiffs)
+	     call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux)
+	  endif
+	  if (corrk) then
+	     call writediagfi(ngrid,"dEzradsw","radiative heating","w.m^-2",3,dEzradsw)
+	     call writediagfi(ngrid,"dEzradlw","radiative heating","w.m^-2",3,dEzradlw)
+	  endif 
+          if(watercond) then
+!	     call writediagfi(ngrid,"lscaledEz","heat from largescale","W m-2",3,lscaledEz) 
+!	     call writediagfi(ngrid,"madjdEz","heat from moistadj","W m-2",3,madjdEz)
+	     call writediagfi(ngrid,"lscaledE","heat from largescale","W m-2",2,lscaledE) 
+	     call writediagfi(ngrid,"madjdE","heat from moistadj","W m-2",2,madjdE)
+	     call writediagfi(ngrid,"qsatatm","atm qsat"," ",3,qsat)
+!	     call writediagfi(ngrid,"h2o_max_col","maximum H2O column amount","kg.m^-2",2,H2Omaxcol)
+          endif 
+        endif
+
+!     Temporary inclusions for heating diagnostics
+!        call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn)
+        call writediagfi(ngrid,"zdtsw","SW heating","T s-1",3,zdtsw)
+        call writediagfi(ngrid,"zdtlw","LW heating","T s-1",3,zdtlw)
+        call writediagfi(ngrid,"dtrad","radiative heating","K s-1",3,dtrad)
+
+        ! debugging
+        !call writediagfi(ngrid,'rnat','Terrain type',' ',2,real(rnat))
+        !call writediagfi(ngrid,'pphi','Geopotential',' ',3,pphi)
+
+!     Output aerosols
+        if (igcm_co2_ice.ne.0.and.iaero_co2.ne.0) &
+	  call writediagfi(ngrid,'CO2ice_reff','CO2ice_reff','m',3,reffrad(1,1,iaero_co2))
+        if (igcm_h2o_ice.ne.0.and.iaero_h2o.ne.0) &
+	  call writediagfi(ngrid,'H2Oice_reff','H2Oice_reff','m',3,reffrad(:,:,iaero_h2o))
+        if (igcm_co2_ice.ne.0.and.iaero_co2.ne.0) &
+	  call writediagfi(ngrid,'CO2ice_reffcol','CO2ice_reffcol','um kg m^-2',2,reffcol(1,iaero_co2))
+        if (igcm_h2o_ice.ne.0.and.iaero_h2o.ne.0) &
+	  call writediagfi(ngrid,'H2Oice_reffcol','H2Oice_reffcol','um kg m^-2',2,reffcol(1,iaero_h2o))
+
+!     Output tracers
+       if (tracer) then
+        do iq=1,nq
+          call writediagfi(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq))
+!          call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  & 
+!                          'kg m^-2',2,qsurf(1,iq) )
+          call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  & 
+                          'kg m^-2',2,qsurf_hist(1,iq) )
+          call writediagfi(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col',    & 
+                          'kg m^-2',2,qcol(1,iq) )
+
+          if(watercond.or.CLFvarying)then
+             call writediagfi(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man)
+             call writediagfi(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc)
+             call writediagfi(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac)
+             call writediagfi(ngrid,"CLFt","H2O column cloud fraction"," ",2,totcloudfrac)
+	     call writediagfi(ngrid,"RH","relative humidity"," ",3,RH)
+          endif
+
+          if(waterrain)then
+             call writediagfi(ngrid,"rain","rainfall","kg m-2 s-1",2,zdqsrain)
+             call writediagfi(ngrid,"snow","snowfall","kg m-2 s-1",2,zdqssnow)
+          endif
+
+          if((hydrology).and.(.not.ok_slab_ocean))then
+             call writediagfi(ngrid,"hice","oceanic ice height","m",2,hice)
+          endif
+
+          if(ice_update)then
+             call writediagfi(ngrid,"ice_min","min annual ice","m",2,ice_min)
+             call writediagfi(ngrid,"ice_ini","initial annual ice","m",2,ice_initial)
+          endif
+
+          do ig=1,ngrid
+             if(tau_col(ig).gt.1.e3)then
+!                print*,'WARNING: tau_col=',tau_col(ig)
+!                print*,'at ig=',ig,'in PHYSIQ'
+             endif
+          end do
+
+          call writediagfi(ngrid,"tau_col","Total aerosol optical depth","[]",2,tau_col)
+
+        enddo
+       endif
+
+!      output spectrum 
+      if(specOLR.and.corrk)then      
+         call writediagspecIR(ngrid,"OLR3D","OLR(lon,lat,band)","W/m^2/cm^-1",3,OLR_nu)
+         call writediagspecVI(ngrid,"OSR3D","OSR(lon,lat,band)","W/m^2/cm^-1",3,OSR_nu)
+      endif
+
+      icount=icount+1
+
+      if (lastcall) then
+
+        ! deallocate gas variables
+        IF ( ALLOCATED( gnom ) ) DEALLOCATE( gnom )
+        IF ( ALLOCATED( gfrac ) ) DEALLOCATE( gfrac )  ! both allocated in su_gases.F90
+
+        ! deallocate saved arrays
+        ! this is probably not that necessary
+        ! ... but probably a good idea to clean the place before we leave
+        IF ( ALLOCATED(tsurf)) DEALLOCATE(tsurf)
+        IF ( ALLOCATED(tsoil)) DEALLOCATE(tsoil)
+        IF ( ALLOCATED(albedo)) DEALLOCATE(albedo)
+        IF ( ALLOCATED(albedo0)) DEALLOCATE(albedo0)
+        IF ( ALLOCATED(rnat)) DEALLOCATE(rnat)
+        IF ( ALLOCATED(emis)) DEALLOCATE(emis)
+        IF ( ALLOCATED(dtrad)) DEALLOCATE(dtrad)
+        IF ( ALLOCATED(fluxrad_sky)) DEALLOCATE(fluxrad_sky)
+        IF ( ALLOCATED(fluxrad)) DEALLOCATE(fluxrad)
+        IF ( ALLOCATED(capcal)) DEALLOCATE(capcal)
+        IF ( ALLOCATED(fluxgrd)) DEALLOCATE(fluxgrd)
+        IF ( ALLOCATED(qsurf)) DEALLOCATE(qsurf)
+        IF ( ALLOCATED(q2)) DEALLOCATE(q2)
+        IF ( ALLOCATED(ztprevious)) DEALLOCATE(ztprevious)
+        IF ( ALLOCATED(cloudfrac)) DEALLOCATE(cloudfrac)
+        IF ( ALLOCATED(totcloudfrac)) DEALLOCATE(totcloudfrac)
+        IF ( ALLOCATED(qsurf_hist)) DEALLOCATE(qsurf_hist)
+        IF ( ALLOCATED(reffrad)) DEALLOCATE(reffrad)
+        IF ( ALLOCATED(nueffrad)) DEALLOCATE(nueffrad)
+        IF ( ALLOCATED(ice_initial)) DEALLOCATE(ice_initial)
+        IF ( ALLOCATED(ice_min)) DEALLOCATE(ice_min)
+
+        IF ( ALLOCATED(fluxsurf_lw)) DEALLOCATE(fluxsurf_lw)
+        IF ( ALLOCATED(fluxsurf_sw)) DEALLOCATE(fluxsurf_sw)
+        IF ( ALLOCATED(fluxtop_lw)) DEALLOCATE(fluxtop_lw)
+        IF ( ALLOCATED(fluxabs_sw)) DEALLOCATE(fluxabs_sw)
+        IF ( ALLOCATED(fluxtop_dn)) DEALLOCATE(fluxtop_dn)
+        IF ( ALLOCATED(fluxdyn)) DEALLOCATE(fluxdyn)
+        IF ( ALLOCATED(OLR_nu)) DEALLOCATE(OLR_nu)
+        IF ( ALLOCATED(OSR_nu)) DEALLOCATE(OSR_nu)
+        IF ( ALLOCATED(sensibFlux)) DEALLOCATE(sensibFlux)
+        IF ( ALLOCATED(zdtlw)) DEALLOCATE(zdtlw)
+        IF ( ALLOCATED(zdtsw)) DEALLOCATE(zdtsw)
+        IF ( ALLOCATED(tau_col)) DEALLOCATE(tau_col)
+
+        !! this is defined in comsaison_h
+        IF ( ALLOCATED(mu0)) DEALLOCATE(mu0)
+
+        IF ( ALLOCATED(fract)) DEALLOCATE(fract)
+
+
+        !! this is defined in radcommon_h
+        IF ( ALLOCATED(eclipse)) DEALLOCATE(eclipse)
+
+        !! this is defined in comsoil_h
+        IF ( ALLOCATED(layer)) DEALLOCATE(layer)
+        IF ( ALLOCATED(mlayer)) DEALLOCATE(mlayer)
+        IF ( ALLOCATED(inertiedat)) DEALLOCATE(inertiedat)
+
+        !! this is defined in surfdat_h
+        IF ( ALLOCATED(albedodat)) DEALLOCATE(albedodat)
+        IF ( ALLOCATED(phisfi)) DEALLOCATE(phisfi)
+        IF ( ALLOCATED(zmea)) DEALLOCATE(zmea)
+        IF ( ALLOCATED(zstd)) DEALLOCATE(zstd)
+        IF ( ALLOCATED(zsig)) DEALLOCATE(zsig)
+        IF ( ALLOCATED(zgam)) DEALLOCATE(zgam)
+        IF ( ALLOCATED(zthe)) DEALLOCATE(zthe)
+        IF ( ALLOCATED(dryness)) DEALLOCATE(dryness)
+        IF ( ALLOCATED(watercaptag)) DEALLOCATE(watercaptag)
+ 
+        !! this is defined in tracer_h
+        IF ( ALLOCATED(noms)) DEALLOCATE(noms)
+        IF ( ALLOCATED(mmol)) DEALLOCATE(mmol)
+        IF ( ALLOCATED(radius)) DEALLOCATE(radius)
+        IF ( ALLOCATED(rho_q)) DEALLOCATE(rho_q)
+        IF ( ALLOCATED(qext)) DEALLOCATE(qext)
+        IF ( ALLOCATED(alpha_lift)) DEALLOCATE(alpha_lift)
+        IF ( ALLOCATED(alpha_devil)) DEALLOCATE(alpha_devil)
+        IF ( ALLOCATED(qextrhor)) DEALLOCATE(qextrhor)
+        IF ( ALLOCATED(igcm_dustbin)) DEALLOCATE(igcm_dustbin)
+
+        !! this is defined in comgeomfi_h
+        IF ( ALLOCATED(lati)) DEALLOCATE(lati)
+        IF ( ALLOCATED(long)) DEALLOCATE(long)
+        IF ( ALLOCATED(area)) DEALLOCATE(area)
+        IF ( ALLOCATED(sinlat)) DEALLOCATE(sinlat)
+        IF ( ALLOCATED(coslat)) DEALLOCATE(coslat)
+        IF ( ALLOCATED(sinlon)) DEALLOCATE(sinlon)
+        IF ( ALLOCATED(coslon)) DEALLOCATE(coslon)
+      endif
+
+      return
+    end subroutine physiq
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/planete.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/planete.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/planete.h	(revision 222)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+! INCLUDE planet.h
+
+      COMMON/planet/apoastr,periastr,year_day,peri_day,                 &
+     &       obliquit,nres,                                             &
+     &       z0,lmixmin,emin_turb,coefvis,coefir,                       &
+     &       timeperi,e_elips,p_elips
+
+      real apoastr,periastr,year_day,peri_day,                          &
+     &     obliquit,nres,                                               &
+     &     z0,lmixmin,emin_turb,coefvis,coefir,                         &
+     &       timeperi,e_elips,p_elips
+      
+
+!-----------------------------------------------------------------------
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/planetwide_mod.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/planetwide_mod.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/planetwide_mod.F90	(revision 222)
@@ -0,0 +1,298 @@
+!
+! $Id: $
+!
+module planetwide_mod
+! module which contains functions to obtain max/min/... values over the
+! entire globe (trivial in serial mode, but not in parallel)
+
+use mod_phys_lmdz_para, only : is_master, gather, bcast
+                               
+implicit none
+
+interface planetwide_maxval ! maxval() , over the entire planet
+  module procedure planetwide_maxval_i1, planetwide_maxval_i2, &
+                   planetwide_maxval_r1, planetwide_maxval_r2
+end interface
+
+interface planetwide_minval ! minval() , over the entire planet
+  module procedure planetwide_minval_i1, planetwide_minval_i2, &
+                   planetwide_minval_r1, planetwide_minval_r2
+end interface
+
+interface planetwide_sumval ! sum() , over the entire planet
+  module procedure planetwide_sumval_i1, planetwide_sumval_i2, &
+                   planetwide_sumval_r1, planetwide_sumval_r2
+end interface
+
+contains
+
+  subroutine planetwide_maxval_i1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:) ! local grid (klon)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_i1
+
+  subroutine planetwide_maxval_i2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:,:) ! local grid (klon,klev)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_i2
+
+  subroutine planetwide_maxval_r1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:) ! local grid (klon)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_r1
+
+  subroutine planetwide_maxval_r2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:,:) ! local grid (klon,klev)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_r2
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  subroutine planetwide_minval_i1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:) ! local grid (klon)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_i1
+
+  subroutine planetwide_minval_i2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:,:) ! local grid (klon,klev)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_i2
+
+  subroutine planetwide_minval_r1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:) ! local grid (klon)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_r1
+
+  subroutine planetwide_minval_r2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:,:) ! local grid (klon,klev)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_r2
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  subroutine planetwide_sumval_i1(values,values_sum)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:) ! local grid (klon)
+  integer,intent(out) :: values_sum
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! calculate sum value
+  if (is_master) then
+    values_sum=SUM(values_glo(:))
+  endif
+  ! broadcast information to all cores
+  call bcast(values_sum)
+#else
+  values_sum=SUM(values(:))
+#endif
+  end subroutine planetwide_sumval_i1
+
+  subroutine planetwide_sumval_i2(values,values_sum)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:,:) ! local grid (klon,klev)
+  integer,intent(out) :: values_sum
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! calculate sum value
+  if (is_master) then
+    values_sum=SUM(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_sum)
+#else
+  values_sum=SUM(values)
+#endif
+  end subroutine planetwide_sumval_i2
+
+  subroutine planetwide_sumval_r1(values,values_sum)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:) ! local grid (klon)
+  real,intent(out) :: values_sum
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! calculate sum value
+  if (is_master) then
+    values_sum=SUM(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_sum)
+#else
+  values_sum=SUM(values)
+#endif
+  end subroutine planetwide_sumval_r1
+
+  subroutine planetwide_sumval_r2(values,values_sum)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:,:) ! local grid (klon,klev)
+  real,intent(out) :: values_sum
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! calculate sum value
+  if (is_master) then
+    values_sum=SUM(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_sum)
+#else
+  values_sum=SUM(values)
+#endif
+  end subroutine planetwide_sumval_r2
+  
+  
+end module planetwide_mod
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/profile.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/profile.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/profile.F	(revision 222)
@@ -0,0 +1,226 @@
+      SUBROUTINE profile(nlev,zkm,temp)
+! to use  'getin'
+      USE ioipsl_getincom 
+      IMPLICIT NONE
+c=======================================================================
+c     Subroutine utilisee dans "rcm1d"
+c     pour l'initialisation du profil atmospherique
+c=======================================================================
+c
+c   differents profils d'atmospheres. T=f(z)
+c   entree:
+c     nlev    nombre de niveaux
+c     zkm     alititudes en km
+c     ichoice choix de l'atmosphere:
+c             1 Temperature constante
+c             2 profil Savidjari
+c             3 Lindner (profil polaire)
+c             4 Inversion pour Francois
+c             5 Seiff (moyen)
+c             6 T constante + perturbation gauss (level) (christophe 10/98)
+c             7 T constante + perturbation gauss   (km)  (christophe 10/98)
+c             8 Lecture du profile dans un fichier ASCII (profile)
+c     tref    temperature de reference
+c     isin    ajout d'une perturbation (isin=1)
+c     pic     pic perturbation gauss pour ichoice = 6 ou 7
+c     largeur largeur de la perturbation gauss pour ichoice = 6 ou 7
+c     hauteur hauteur de la perturbation gauss pour ichoice = 6 ou 7
+c
+c   sortie:
+c     temp    temperatures en K
+c     
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+       INTEGER nlev, unit
+       REAL zkm(nlev),temp(nlev)
+
+c   local:
+c   ------
+
+      INTEGER il,ichoice,nseiff,iseiff,isin,iter
+      REAL pi
+      PARAMETER(nseiff=37)
+      REAL tref,t1,t2,t3,ww
+      REAL tseiff(nseiff)
+      DATA tseiff/214.,213.8,213.4,212.4,209.3,205.,201.4,197.8,
+     $           194.6,191.4,188.2,185.2,182.5,180.,177.5,175,
+     $           172.5,170.,167.5,164.8,162.4,160.,158.,156.,
+     $           154.1,152.2,150.3,148.7,147.2,145.7,144.2,143.,
+     $           142.,141.,140,139.5,139./
+      REAL pic,largeur
+      REAL hauteur,tmp
+
+c-----------------------------------------------------------------------
+c   read input profile type:
+c--------------------------
+
+      ichoice=1 ! default value for ichoice
+      call getin("ichoice",ichoice)
+      tref=200 ! default value for tref
+      call getin("tref",tref)
+      isin=0 ! default value for isin (=0 means no perturbation)
+      call getin("isin",isin)
+      pic=26.522 ! default value for pic
+      call getin("pic",pic)
+      largeur=10 ! default value for largeur
+      call getin("largeur",largeur)
+      hauteur=30 ! default value for hauteur
+      call getin("hauteur",hauteur)
+
+c-----------------------------------------------------------------------
+c   ichoice=1 temperature constante:
+c   --------------------------------
+
+      IF(ichoice.EQ.1) THEN
+         DO il=1,nlev
+            temp(il)=tref
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=2 savidjari:
+c   --------------------
+
+      ELSE IF(ichoice.EQ.2) THEN
+         DO il=1,nlev
+            temp(il)=AMAX1(219.-2.5*zkm(il),140.)
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=3 Lindner:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.3) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.2.5) THEN
+               temp(il)=150.+30.*zkm(il)/2.5
+            ELSE IF(zkm(il).LT.5.) THEN
+               temp(il)=180.
+            ELSE
+               temp(il)=AMAX1(180.-2.*(zkm(il)-5.),130.)
+            ENDIF
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=4 Inversion pour Francois:
+c   ------------------
+
+      ELSE IF(ichoice.EQ.4) THEN
+         DO il=1,nlev
+            IF(zkm(il).LT.20.) THEN
+               temp(il)=135.
+            ELSE
+               temp(il)=AMIN1(135.+5.*(zkm(il)-20.),200.)
+            ENDIF
+         ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=5 Seiff:
+c   ----------------
+
+      ELSE IF(ichoice.EQ.5) THEN
+	 DO il=1,nlev
+	    iseiff=INT(zkm(il)/2.)+1
+	    IF(iseiff.LT.nseiff-1) THEN
+	       temp(il)=tseiff(iseiff)+(zkm(il)-2.*(iseiff-1))*
+     $         (tseiff(iseiff+1)-tseiff(iseiff))/2.
+	    ELSE
+	       temp(il)=tseiff(nseiff)
+	    ENDIF
+	 ENDDO
+c IF(ichoice.EQ.6) THEN
+c	    DO iter=1,6
+c	    t2=temp(1)
+c	    t3=temp(2)
+c	    DO il=2,nlev-1
+c	       t1=t2
+c	       t2=t3
+c	       t3=temp(il+1)
+c	       ww=tanh(zkm(il)/20.)
+c	       ww=ww*ww*ww
+c	       temp(il)=t2+ww*.5*(t1-2.*t2+t3)
+c	    ENDDO
+c	    ENDDO
+c	 ENDIF
+
+c-----------------------------------------------------------------------
+c   ichoice=6 
+c   ---------
+
+      ELSE IF(ichoice.EQ.6) THEN
+      DO il=1,nlev
+        tmp=il-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp/largeur/largeur)
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   ichoice=7
+c   ---------
+
+      ELSE IF(ichoice.EQ.7) THEN
+      DO il=1,nlev
+        tmp=zkm(il)-pic
+        temp(il)=tref + hauteur*exp(-tmp*tmp*4/largeur/largeur)
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   ichoice=8
+c   ---------
+
+      ! first value is surface temperature
+      ! then profile of atmospheric temperature
+      ELSE IF(ichoice.GE.8) THEN
+      OPEN(11,file='profile',status='old',form='formatted',err=101)
+      DO il=1,nlev
+        READ (11,*) temp(il)
+      ENDDO
+
+      GOTO 201
+101   STOP'fichier profile inexistant'
+201   CONTINUE
+      CLOSE(10)
+
+c-----------------------------------------------------------------------
+
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   rajout eventuel d'une perturbation:
+c   -----------------------------------
+
+      IF(isin.EQ.1) THEN
+	 pi=2.*ASIN(1.)
+	 DO il=1,nlev
+c       if (nlev.EQ.501) then
+c         if (zkm(il).LE.70.5) then
+c       temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+c    s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c         endif
+c       else
+        temp(il)=temp(il)+(1.-1000./(1000+zkm(il)*zkm(il)))*(
+     s      6.*SIN(zkm(il)*pi/6.)+9.*SIN(zkm(il)*pi/10.3) )
+c       endif
+	 ENDDO
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   Ecriture du profil de temperature dans un fichier profile.out
+c   -------------------------------------------------------------
+
+
+      OPEN(12,file='profile.out',form='formatted')
+	  DO il=1,nlev
+	    write(12,*) temp(il)
+	  ENDDO
+      CLOSE(12)
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radcommon_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radcommon_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radcommon_h.F90	(revision 222)
@@ -0,0 +1,146 @@
+      module radcommon_h
+
+      use radinc_h
+      implicit none
+
+!----------------------------------------------------------------------C
+!
+!                             radcommon.h
+!
+!----------------------------------------------------------------------C
+!
+!  "Include" grid.h and radinc.h before this file in code that uses
+!  some or all of this common data set
+!
+!     WNOI       - Array of wavenumbers at the spectral interval
+!                  centers for the infrared.  Array is NSPECTI
+!                  elements long.
+!     DWNI       - Array of "delta wavenumber", i.e., the width,
+!                  in wavenumbers (cm^-1) of each IR spectral
+!                  interval.  NSPECTI elements long.
+!     WAVEI      - Array (NSPECTI elements long) of the wavelenght
+!                  (in microns) at the center of each IR spectral
+!                  interval.
+!     WNOV       - Array of wavenumbers at the spectral interval
+!                  center for the VISUAL.  Array is NSPECTV
+!                  elements long.
+!     DWNV       - Array of "delta wavenumber", i.e., the width,
+!                  in wavenumbers (cm^-1) of each VISUAL spectral
+!                  interval.  NSPECTV elements long.
+!     WAVEV      - Array (NSPECTV elements long) of the wavelenght
+!                  (in microns) at the center of each VISUAL spectral
+!                  interval.
+!     STELLARF   - Array (NSPECTV elements) of stellar flux (W/M^2) in
+!                  each spectral interval.  Values are for 1 AU,
+!                  scaled to the planetary distance elsewhere.
+!     TAURAY     - Array (NSPECTV elements) of the pressure-independent
+!                  part of Rayleigh scattering optical depth.
+!     TAURAYVAR  - Array (NSPECTV elements) of the pressure-independent
+!                  part of Rayleigh scattering optical depth for the variable gas.
+!     FZEROI     - Fraction of zeros in the IR CO2 k-coefficients, for
+!                  each temperature, pressure, and spectral interval
+!     FZEROV     - Fraction of zeros in the VISUAL CO2 k-coefficients, for
+!                  each temperature, pressure, and spectral interval
+!
+!     AEROSOL RADIATIVE OPTICAL CONSTANTS
+! 
+!   Shortwave
+!   ~~~~~~~~~
+! 
+! For the "naerkind" kind of aerosol radiative properties : 
+! QVISsQREF  :  Qext / Qext("longrefvis")
+! omegavis   :  single scattering albedo
+! gvis       :  assymetry factor
+! 
+!   Longwave
+!   ~~~~~~~~
+! 
+! For the "naerkind" kind of aerosol radiative properties : 
+! QIRsQREF :  Qext / Qext("longrefvis")
+! omegaIR  :  mean single scattering albedo
+! gIR      :  mean assymetry factor
+
+      REAL*8 BWNI(L_NSPECTI+1), WNOI(L_NSPECTI), DWNI(L_NSPECTI), WAVEI(L_NSPECTI)
+      REAL*8 BWNV(L_NSPECTV+1), WNOV(L_NSPECTV), DWNV(L_NSPECTV), WAVEV(L_NSPECTV)
+      REAL*8 STELLARF(L_NSPECTV), TAURAY(L_NSPECTV), TAURAYVAR(L_NSPECTV)
+
+      REAL*8 blami(L_NSPECTI+1)
+      REAL*8 blamv(L_NSPECTV+1) ! these are needed by suaer.F90
+
+      !! AS: introduced to avoid doing same computations again for continuum
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: indi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: indv
+
+      !!! ALLOCATABLE STUFF SO THAT DIMENSIONS ARE READ in *.dat FILES -- AS 12/2011  
+      REAL*8, DIMENSION(:,:,:,:,:), ALLOCATABLE :: gasi, gasv
+      REAL*8, DIMENSION(:), ALLOCATABLE :: PGASREF, TGASREF, WREFVAR, PFGASREF
+      real*8 FZEROI(L_NSPECTI)
+      real*8 FZEROV(L_NSPECTV)
+      real*8 pgasmin, pgasmax
+      real*8 tgasmin, tgasmax
+
+      real QVISsQREF(L_NSPECTV,naerkind,nsizemax)
+      real omegavis(L_NSPECTV,naerkind,nsizemax)
+      real gvis(L_NSPECTV,naerkind,nsizemax)
+      real QIRsQREF(L_NSPECTI,naerkind,nsizemax)
+      real omegair(L_NSPECTI,naerkind,nsizemax)
+      real gir(L_NSPECTI,naerkind,nsizemax)
+
+
+! Reference wavelengths used to compute reference optical depth (m)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      REAL lamrefir(naerkind),lamrefvis(naerkind)
+
+! Actual number of grain size classes in each domain for a
+!   given aerosol:
+
+      INTEGER          :: nsize(naerkind,2)
+
+! Particle size axis (depend on the kind of aerosol and the
+!   radiation domain)
+
+      DOUBLE PRECISION :: radiustab(naerkind,2,nsizemax)
+
+! Extinction coefficient at reference wavelengths;
+!   These wavelengths are defined in aeroptproperties, and called
+!   longrefvis and longrefir.
+
+      REAL :: QREFvis(naerkind,nsizemax)
+      REAL :: QREFir(naerkind,nsizemax)
+      REAL :: omegaREFvis(naerkind,nsizemax)
+      REAL :: omegaREFir(naerkind,nsizemax)
+
+      REAL tstellar ! Stellar brightness temperature (SW)
+
+      real*8 planckir(L_NSPECTI,NTstop-NTstar+1)
+
+      real*8 PTOP, TAUREF(L_LEVELS+1)
+
+      real*8, parameter :: UBARI = 0.5D0
+
+      real*8 gweight(L_NGAUSS)
+
+!     If the gas optical depth (top to the surface) is less than
+!     this value, we place that Gauss-point into the "zeros"
+!     channel.
+      real*8, parameter :: TLIMIT =  1.0D-30
+
+!     Factor to convert pressures from millibars to Pascals
+      real*8, parameter :: SCALEP = 1.00D+2
+
+      real*8, parameter :: sigma = 5.67032D-8
+      real*8, parameter :: grav = 6.672E-11
+
+      real*8 Cmk
+      save Cmk
+      real*8 glat_ig
+      save glat_ig
+
+      ! extinction of incoming sunlight (Saturn's rings, eclipses, etc...)
+      REAL, DIMENSION(:), ALLOCATABLE :: eclipse
+
+      !Latitude-dependent gravity
+      REAL, DIMENSION(:), ALLOCATABLE :: glat
+
+      end module radcommon_h
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radii_mod.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radii_mod.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radii_mod.F90	(revision 222)
@@ -0,0 +1,385 @@
+!==================================================================
+module radii_mod
+!==================================================================
+!  module to centralize the radii calculations for aerosols
+! OK for water but should be extended to other aerosols (CO2,...)
+!==================================================================
+      
+!     water cloud optical properties
+      
+      real, save ::  rad_h2o
+      real, save ::  rad_h2o_ice
+      real, save ::  Nmix_h2o
+      real, save ::  Nmix_h2o_ice
+      real, parameter ::  coef_chaud=0.13
+      real, parameter ::  coef_froid=0.09
+
+
+      contains
+
+
+!==================================================================
+   subroutine su_aer_radii(ngrid,reffrad,nueffrad)
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the effective radii of liquid and icy water particles
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+ ! to use  'getin'
+      use ioipsl_getincom 
+      use radinc_h, only: naerkind
+      use aerosol_mod
+!      USE tracer_h
+      Implicit none
+
+      include "callkeys.h"
+      include "dimensions.h"
+      include "dimphys.h"
+
+      integer,intent(in) :: ngrid
+
+      real, intent(out) :: reffrad(ngrid,nlayermx,naerkind)      !aerosols radii (K)
+      real, intent(out) :: nueffrad(ngrid,nlayermx,naerkind)     !variance     
+
+      logical, save :: firstcall=.true.
+      integer :: iaer   
+      
+      print*,'enter su_aer_radii'
+          do iaer=1,naerkind
+!     these values will change once the microphysics gets to work
+!     UNLESS tracer=.false., in which case we should be working with
+!     a fixed aerosol layer, and be able to define reffrad in a 
+!     .def file. To be improved!
+
+            if(iaer.eq.iaero_co2)then ! CO2 ice
+               reffrad(1:ngrid,1:nlayermx,iaer) = 1.e-4
+               nueffrad(1:ngrid,1:nlayermx,iaer) = 0.1 
+            endif
+
+            if(iaer.eq.iaero_h2o)then ! H2O ice
+               reffrad(1:ngrid,1:nlayermx,iaer) = 1.e-5
+               nueffrad(1:ngrid,1:nlayermx,iaer) = 0.1 
+            endif
+
+            if(iaer.eq.iaero_dust)then ! dust
+               reffrad(1:ngrid,1:nlayermx,iaer) = 1.e-5
+               nueffrad(1:ngrid,1:nlayermx,iaer) = 0.1 
+            endif
+ 
+            if(iaer.eq.iaero_h2so4)then ! H2O ice
+               reffrad(1:ngrid,1:nlayermx,iaer) = 1.e-6
+               nueffrad(1:ngrid,1:nlayermx,iaer) = 0.1 
+            endif
+	    
+	    if(iaer.eq.iaero_back2lay)then ! Two-layer aerosols
+               reffrad(1:ngrid,1:nlayermx,iaer) = 2.e-6
+               nueffrad(1:ngrid,1:nlayermx,iaer) = 0.1 
+            endif
+
+
+
+            if(iaer.gt.5)then
+               print*,'Error in callcorrk, naerkind is too high (>5).'
+               print*,'The code still needs generalisation to arbitrary'
+               print*,'aerosol kinds and number.'
+               call abort
+            endif
+
+         enddo
+
+
+         if (radfixed) then
+
+	    write(*,*)"radius of H2O water particles:"
+            rad_h2o=13. ! default value
+            call getin("rad_h2o",rad_h2o)
+            write(*,*)" rad_h2o = ",rad_h2o
+
+	    write(*,*)"radius of H2O ice particles:"
+            rad_h2o_ice=35. ! default value
+            call getin("rad_h2o_ice",rad_h2o_ice)
+            write(*,*)" rad_h2o_ice = ",rad_h2o_ice
+
+	 else
+
+            write(*,*)"Number mixing ratio of H2O water particles:"
+            Nmix_h2o=1.e6 ! default value
+            call getin("Nmix_h2o",Nmix_h2o)
+            write(*,*)" Nmix_h2o = ",Nmix_h2o
+
+            write(*,*)"Number mixing ratio of H2O ice particles:"
+            Nmix_h2o_ice=Nmix_h2o ! default value
+            call getin("Nmix_h2o_ice",Nmix_h2o_ice)
+            write(*,*)" Nmix_h2o_ice = ",Nmix_h2o_ice
+	 endif
+
+      print*,'exit su_aer_radii'
+
+   end subroutine su_aer_radii
+!==================================================================
+
+
+!==================================================================
+   subroutine h2o_reffrad(ngrid,pq,pt,reffrad,nueffrad)
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the effective radii of liquid and icy water particles
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+      use watercommon_h, Only: T_h2O_ice_liq,T_h2O_ice_clouds,rhowater,rhowaterice
+      Implicit none
+
+      include "callkeys.h"
+      include "dimensions.h"
+      include "dimphys.h"
+      include "comcstfi.h"
+
+      integer,intent(in) :: ngrid
+
+      real, intent(in) :: pq(ngrid,nlayermx) !water ice mixing ratios (kg/kg)
+      real, intent(in) :: pt(ngrid,nlayermx) !temperature (K)
+      real, intent(out) :: reffrad(ngrid,nlayermx)      !aerosol radii
+      real, intent(out) :: nueffrad(ngrid,nlayermx) ! dispersion      
+
+      integer :: ig,l
+      real zfice ,zrad,zrad_liq,zrad_ice
+      real,external :: CBRT            
+      
+
+      if (radfixed) then
+         do l=1,nlayermx
+            do ig=1,ngrid
+               zfice = 1.0 - (pt(ig,l)-T_h2O_ice_clouds) / (T_h2O_ice_liq-T_h2O_ice_clouds)
+               zfice = MIN(MAX(zfice,0.0),1.0)
+               reffrad(ig,l)= rad_h2o * (1.-zfice) + rad_h2o_ice * zfice
+               nueffrad(ig,l) = coef_chaud * (1.-zfice) + coef_froid * zfice
+            enddo
+         enddo
+      else
+         do l=1,nlayermx
+            do ig=1,ngrid
+               zfice = 1.0 - (pt(ig,l)-T_h2O_ice_clouds) / (T_h2O_ice_liq-T_h2O_ice_clouds)
+               zfice = MIN(MAX(zfice,0.0),1.0)
+	       zrad_liq  = CBRT( 3*pq(ig,l)/(4*Nmix_h2o*pi*rhowater) )
+	       zrad_ice  = CBRT( 3*pq(ig,l)/(4*Nmix_h2o_ice*pi*rhowaterice) )
+               nueffrad(ig,l) = coef_chaud * (1.-zfice) + coef_froid * zfice
+               zrad = zrad_liq * (1.-zfice) + zrad_ice * zfice
+
+	       reffrad(ig,l) = min(max(zrad,1.e-6),1000.e-6)
+               enddo
+            enddo      
+      end if
+
+   end subroutine h2o_reffrad
+!==================================================================
+
+
+!==================================================================
+   subroutine h2o_cloudrad(ngrid,pql,reffliq,reffice)
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the effective radii of liquid and icy water particles
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+      use watercommon_h, Only: rhowater,rhowaterice
+      Implicit none
+
+      include "callkeys.h"
+      include "dimensions.h"
+      include "dimphys.h"
+      include "comcstfi.h"
+
+      integer,intent(in) :: ngrid
+
+      real, intent(in) :: pql(ngrid,nlayermx) !condensed water mixing ratios (kg/kg)
+      real, intent(out) :: reffliq(ngrid,nlayermx),reffice(ngrid,nlayermx)     !liquid and ice water particle radii (m)
+
+      real,external :: CBRT            
+      integer :: i,k
+
+      if (radfixed) then
+	 reffliq(1:ngrid,1:nlayermx)= rad_h2o
+	 reffice(1:ngrid,1:nlayermx)= rad_h2o_ice
+      else
+	 do k=1,nlayermx
+	   do i=1,ngrid
+	     reffliq(i,k) = CBRT(3*pql(i,k)/(4*Nmix_h2o*pi*rhowater))
+	     reffliq(i,k) = min(max(reffliq(i,k),1.e-6),1000.e-6)
+	   
+	     reffice(i,k) = CBRT(3*pql(i,k)/(4*Nmix_h2o_ice*pi*rhowaterice))
+	     reffice(i,k) = min(max(reffice(i,k),1.e-6),1000.e-6)
+	   enddo
+	 enddo
+      endif
+
+   end subroutine h2o_cloudrad
+!==================================================================
+
+
+
+!==================================================================
+   subroutine co2_reffrad(ngrid,nq,pq,reffrad)
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the effective radii of co2 ice particles
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+      USE tracer_h, only:igcm_co2_ice,rho_co2
+      Implicit none
+
+      include "callkeys.h"
+      include "dimensions.h"
+      include "dimphys.h"
+      include "comcstfi.h"
+
+      integer,intent(in) :: ngrid,nq
+
+      real, intent(in) :: pq(ngrid,nlayermx,nq) !tracer mixing ratios (kg/kg)
+      real, intent(out) :: reffrad(ngrid,nlayermx)      !co2 ice particles radii (K)
+
+      integer :: ig,l
+      real :: zrad   
+      real,external :: CBRT            
+            
+      
+
+      if (radfixed) then
+         reffrad(1:ngrid,1:nlayermx) = 5.e-5 ! CO2 ice
+      else
+         do l=1,nlayermx
+            do ig=1,ngrid
+               zrad = CBRT( 3*pq(ig,l,igcm_co2_ice)/(4*Nmix_co2*pi*rho_co2) )
+               reffrad(ig,l) = min(max(zrad,1.e-6),100.e-6)
+            enddo
+         enddo      
+      end if
+
+   end subroutine co2_reffrad
+!==================================================================
+
+
+
+!==================================================================
+   subroutine dust_reffrad(ngrid,reffrad)
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the effective radii of dust particles
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+      Implicit none
+
+      include "callkeys.h"
+      include "dimensions.h"
+      include "dimphys.h"
+
+      integer,intent(in) :: ngrid
+
+      real, intent(out) :: reffrad(ngrid,nlayermx)      !dust particles radii (K)
+            
+      reffrad(1:ngrid,1:nlayermx) = 2.e-6 ! dust
+
+   end subroutine dust_reffrad
+!==================================================================
+
+
+!==================================================================
+   subroutine h2so4_reffrad(ngrid,reffrad)
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the effective radii of h2so4 particles
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+      Implicit none
+
+      include "callkeys.h"
+      include "dimensions.h"
+      include "dimphys.h"
+
+      integer,intent(in) :: ngrid
+
+      real, intent(out) :: reffrad(ngrid,nlayermx)      !h2so4 particle radii (K)
+                
+      reffrad(1:ngrid,1:nlayermx) = 1.e-6 ! h2so4
+
+   end subroutine h2so4_reffrad
+!==================================================================
+
+!==================================================================
+   subroutine back2lay_reffrad(ngrid,reffrad,nlayer,pplev)
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the effective radii of particles in a 2-layer model
+!
+!     Authors
+!     -------
+!     Sandrine Guerlet (2013)
+!
+!==================================================================
+ 
+      use aerosol_mod   !! Particle sizes and boundaries of aerosol layers defined there
+     Implicit none
+
+     include "callkeys.h"
+     include "dimensions.h"
+     include "dimphys.h"
+
+      integer,intent(in) :: ngrid
+
+      real, intent(out) :: reffrad(ngrid,nlayermx)      ! particle radii 
+      REAL,INTENT(IN) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa)
+      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
+      REAL :: expfactor
+      INTEGER l,ig
+            
+      reffrad(:,:)=1e-6  !!initialization, not important
+          DO ig=1,ngrid
+            DO l=1,nlayer-1
+              IF (pplev(ig,l) .le. pres_bottom_tropo .and. pplev(ig,l) .ge. pres_top_tropo) THEN
+                reffrad(ig,l) = size_tropo
+              ELSEIF (pplev(ig,l) .lt. pres_top_tropo .and. pplev(ig,l) .gt. pres_bottom_strato) THEN
+                expfactor=log(size_strato/size_tropo) / log(pres_bottom_strato/pres_top_tropo)
+                reffrad(ig,l)= size_tropo*((pplev(ig,l)/pres_top_tropo)**expfactor)
+              ELSEIF (pplev(ig,l) .le. pres_bottom_strato) then
+                reffrad(ig,l) = size_strato
+              ENDIF
+            ENDDO
+          ENDDO
+
+   end subroutine back2lay_reffrad
+!==================================================================
+
+
+
+end module radii_mod
+!==================================================================
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radinc_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radinc_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/radinc_h.F90	(revision 222)
@@ -0,0 +1,98 @@
+      module radinc_h
+
+      implicit none
+
+#include "dimensions.h"
+#include "bands.h"
+#include "scatterers.h"
+
+!======================================================================
+!
+!     RADINC.H 
+!
+!     Includes for the radiation code; RADIATION LAYERS, LEVELS,
+!     number of spectral intervals. . .
+! 
+!======================================================================
+
+!     RADIATION parameters
+
+!     In radiation code, layer 1 corresponds to the stratosphere.  Level
+!     1 is the top of the stratosphere.  The dummy layer is at the same
+!     temperature as the (vertically isothermal) stratosphere, and
+!     any time it is explicitly needed, the appropriate quantities will
+!     be dealt with (aka "top". . .)
+
+!     L_NLEVRAD corresponds to the surface - i.e., the GCM Level that
+!     is at the surface.  PLEV(L_NLEVRAD) = P(J,I)+PTROP, 
+!     PLEV(2) = PTROP, PLEV(1) = ptop
+
+!     L_NLAYRAD is the number of radiation code layers
+!     L_NLEVRAD is the number of radiation code levels.  Level N is the
+!               top of layer N. 
+!
+!     L_NSPECTI is the number of IR spectral intervals
+!     L_NSPECTV is the number of Visual(or Solar) spectral intervals
+!     L_NGAUSS  is the number of Gauss points for K-coefficients
+!               GAUSS POINT 17 (aka the last one) is the special case
+!
+!     L_NPREF   is the number of reference pressures that the 
+!               k-coefficients are calculated on
+!     L_PINT    is the number of Lagrange interpolated reference
+!               pressures for the gas k-coefficients - now for a
+!		smaller p-grid than before
+!     L_NTREF   is the number of reference temperatures for the
+!               k-coefficients
+!     L_TAUMAX  is the largest optical depth - larger ones are set
+!               to this value
+!
+!     L_REFVAR  The number of different mixing ratio values for
+!               the k-coefficients. Variable component of the mixture
+!		can in princple be anything: currently it's H2O.
+!
+!     NAERKIND  The number of radiatively active aerosol types
+!
+!     NSIZEMAX  The maximum number of aerosol particle sizes
+!
+!----------------------------------------------------------------------
+
+      integer, parameter :: L_NLAYRAD  = llm
+      integer, parameter :: L_LEVELS   = 2*(llm-1)+3
+      integer, parameter :: L_NLEVRAD  = llm+1
+
+      ! These are set in sugas_corrk
+      ! [uses allocatable arrays] -- AS 12/2011
+      integer :: L_NPREF, L_NTREF, L_REFVAR, L_PINT
+
+      integer, parameter :: L_NGAUSS  = 17
+
+      integer, parameter :: L_NSPECTI = NBinfrared
+      integer, parameter :: L_NSPECTV = NBvisible
+
+!      integer, parameter :: NAERKIND  = 2 ! set in scatterers.h
+      real,    parameter :: L_TAUMAX  = 35
+
+      ! For Planck function integration: 
+      ! equivalent temperatures are 1/NTfac of these values
+      integer, parameter :: NTstar = 500
+      integer, parameter :: NTstop = 15000 ! new default for all non hot Jupiter runs
+      real*8, parameter :: NTfac = 1.0D+1  
+      !integer, parameter :: NTstar = 1000
+      !integer, parameter :: NTstop = 25000
+      !real*8,parameter :: NTfac = 5.0D+1    
+      !integer, parameter :: NTstar = 2000
+      !integer, parameter :: NTstop = 50000
+      !real*8,parameter :: NTfac = 1.0D+2    
+
+      ! Maximum number of grain size classes for aerosol convolution:
+      ! This must correspond to size of largest dataset used for aerosol 
+      ! optical properties in datagcm folder.
+      integer, parameter :: nsizemax = 60
+
+      character (len=100) :: corrkdir
+      save corrkdir
+
+      character (len=100) :: banddir
+      save banddir
+
+      end module radinc_h
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rain.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rain.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rain.F90	(revision 222)
@@ -0,0 +1,386 @@
+subroutine rain(ngrid,nq,ptimestep,pplev,pplay,t,pdt,pq,pdq,d_t,dqrain,dqsrain,dqssnow,rneb)
+
+
+  use ioipsl_getincom, only: getin
+  use watercommon_h, only: T_h2O_ice_liq,T_h2O_ice_clouds, RLVTT, RCPD, RCPV, RV, RVTMP2,Psat_water,Tsat_water,rhowater
+  use radii_mod, only: h2o_cloudrad
+  USE tracer_h, only: igcm_h2o_vap, igcm_h2o_ice
+  implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates H2O precipitation using simplified microphysics.
+!     
+!     Authors
+!     -------
+!     Adapted from the LMDTERRE code by R. Wordsworth (2009)
+!     Added rain vaporization in case of T>Tsat
+!     Original author Z. X. Li (1993)
+!     
+!==================================================================
+
+  include "dimensions.h"
+  include "dimphys.h"
+  include "comcstfi.h"
+  include "callkeys.h"
+
+!     Arguments
+      integer,intent(in) :: ngrid ! number of atmospherci columns
+      integer,intent(in) :: nq ! number of tracers
+      real,intent(in) :: ptimestep    ! time interval
+      real,intent(in) :: pplev(ngrid,nlayermx+1) ! inter-layer pressure (Pa)
+      real,intent(in) :: pplay(ngrid,nlayermx)   ! mid-layer pressure (Pa)
+      real,intent(in) :: t(ngrid,nlayermx) ! input temperature (K)
+      real,intent(in) :: pdt(ngrid,nlayermx) ! input tendency on temperature (K/s)      
+      real,intent(in) :: pq(ngrid,nlayermx,nq)  ! tracers (kg/kg)
+      real,intent(in) :: pdq(ngrid,nlayermx,nq) ! input tendency on tracers
+      real,intent(out) :: d_t(ngrid,nlayermx) ! temperature tendency (K/s)
+      real,intent(out) :: dqrain(ngrid,nlayermx,nq) ! tendency of H2O precipitation (kg/kg.s-1)
+      real,intent(out) :: dqsrain(ngrid)  ! rain flux at the surface (kg.m-2.s-1)
+      real,intent(out) :: dqssnow(ngrid)  ! snow flux at the surface (kg.m-2.s-1)
+      real,intent(in) :: rneb(ngrid,nlayermx) ! cloud fraction
+
+      REAL zt(ngrid,nlayermx)         ! working temperature (K)
+      REAL ql(ngrid,nlayermx)         ! liquid water (Kg/Kg)
+      REAL q(ngrid,nlayermx)          ! specific humidity (Kg/Kg)
+      REAL d_q(ngrid,nlayermx)        ! water vapor increment
+      REAL d_ql(ngrid,nlayermx)       ! liquid water / ice increment
+
+!     Subroutine options
+      REAL,PARAMETER :: seuil_neb=0.001  ! Nebulosity threshold
+
+      INTEGER,save :: precip_scheme      ! id number for precipitaion scheme
+!     for simple scheme  (precip_scheme=1)
+      REAL,SAVE :: rainthreshold                ! Precipitation threshold in simple scheme
+!     for sundquist scheme  (precip_scheme=2-3)
+      REAL,SAVE :: cloud_sat                    ! Precipitation threshold in non simple scheme
+      REAL,SAVE :: precip_timescale             ! Precipitation timescale
+!     for Boucher scheme  (precip_scheme=4)
+      REAL,SAVE :: Cboucher ! Precipitation constant in Boucher 95 scheme
+      REAL,PARAMETER :: Kboucher=1.19E8
+      REAL,SAVE :: c1
+
+      INTEGER,PARAMETER :: ninter=5
+
+      logical,save :: evap_prec ! Does the rain evaporate?
+
+!     for simple scheme
+      real,parameter :: t_crit=218.0
+      real lconvert
+
+!     Local variables
+      INTEGER i, k, n
+      REAL zqs(ngrid,nlayermx),Tsat(ngrid,nlayermx), zdelta, zcor
+      REAL zrfl(ngrid), zrfln(ngrid), zqev, zqevt
+
+      REAL zoliq(ngrid)
+      REAL zdz(ngrid),zrho(ngrid),ztot(ngrid), zrhol(ngrid)
+      REAL zchau(ngrid),zfroi(ngrid),zfrac(ngrid),zneb(ngrid)
+
+      real reffh2oliq(ngrid,nlayermx),reffh2oice(ngrid,nlayermx)
+  
+      real ttemp, ptemp, psat_tmp
+      real tnext(ngrid,nlayermx)
+
+      real l2c(ngrid,nlayermx)
+      real dWtot
+
+
+!     Indices of water vapour and water ice tracers
+      INTEGER, SAVE :: i_vap=0  ! water vapour
+      INTEGER, SAVE :: i_ice=0  ! water ice
+
+      LOGICAL,SAVE :: firstcall=.true.
+
+!     Online functions
+      REAL fallv, fall2v, zzz ! falling speed of ice crystals
+      fallv (zzz) = 3.29 * ((zzz)**0.16)
+      fall2v (zzz) =10.6 * ((zzz)**0.31)  !for use with radii
+
+
+      IF (firstcall) THEN
+
+         i_vap=igcm_h2o_vap
+         i_ice=igcm_h2o_ice
+        
+         write(*,*) "rain: i_ice=",i_ice
+         write(*,*) "      i_vap=",i_vap
+
+         PRINT*, 'in rain.F, ninter=', ninter
+         PRINT*, 'in rain.F, evap_prec=', evap_prec
+
+         write(*,*) "Precipitation scheme to use?"
+         precip_scheme=1 ! default value
+         call getin("precip_scheme",precip_scheme)
+         write(*,*) " precip_scheme = ",precip_scheme
+
+         if (precip_scheme.eq.1) then
+	    write(*,*) "rainthreshold in simple scheme?"
+            rainthreshold=0. ! default value
+            call getin("rainthreshold",rainthreshold)
+            write(*,*) " rainthreshold = ",rainthreshold
+
+         else if (precip_scheme.eq.2.or.precip_scheme.eq.3) then
+	    write(*,*) "cloud water saturation level in non simple scheme?"
+            cloud_sat=2.6e-4   ! default value
+            call getin("cloud_sat",cloud_sat)
+            write(*,*) " cloud_sat = ",cloud_sat
+	    write(*,*) "precipitation timescale in non simple scheme?"
+            precip_timescale=3600.  ! default value
+            call getin("precip_timescale",precip_timescale)
+            write(*,*) " precip_timescale = ",precip_timescale
+
+         else if (precip_scheme.eq.4) then
+	    write(*,*) "multiplicative constant in Boucher 95 precip scheme"
+            Cboucher=1.   ! default value
+            call getin("Cboucher",Cboucher)
+            write(*,*) " Cboucher = ",Cboucher	
+	    c1=1.00*1.097/rhowater*Cboucher*Kboucher  
+
+	 endif
+
+         write(*,*) "re-evaporate precipitations?"
+         evap_prec=.true. ! default value
+         call getin("evap_prec",evap_prec)
+         write(*,*) " evap_prec = ",evap_prec
+
+         firstcall = .false.
+      ENDIF ! of IF (firstcall)
+
+!     GCM -----> subroutine variables
+      DO k = 1, nlayermx
+      DO i = 1, ngrid
+
+	 zt(i,k)   = t(i,k)+pdt(i,k)*ptimestep ! a big fat bug was here
+         q(i,k)    = pq(i,k,i_vap)+pdq(i,k,i_vap)*ptimestep
+         ql(i,k)   = pq(i,k,i_ice)+pdq(i,k,i_ice)*ptimestep
+
+         !q(i,k)    = pq(i,k,i_vap)!+pdq(i,k,i_vap)
+         !ql(i,k)   = pq(i,k,i_ice)!+pdq(i,k,i_ice)
+
+         if(q(i,k).lt.0.)then ! if this is not done, we don't conserve water
+            q(i,k)=0.
+         endif
+         if(ql(i,k).lt.0.)then
+            ql(i,k)=0.
+         endif
+
+      ENDDO
+      ENDDO
+
+!     Initialise the outputs
+      d_t(1:ngrid,1:nlayermx) = 0.0
+      d_q(1:ngrid,1:nlayermx) = 0.0
+      d_ql(1:ngrid,1:nlayermx) = 0.0
+      zrfl(1:ngrid) = 0.0
+      zrfln(1:ngrid) = 0.0
+
+      ! calculate saturation mixing ratio
+      DO k = 1, nlayermx
+         DO i = 1, ngrid
+            ttemp = zt(i,k) 
+            ptemp = pplay(i,k)
+!            call watersat(ttemp,ptemp,zqs(i,k))
+	    call Psat_water(ttemp,ptemp,psat_tmp,zqs(i,k))
+	    call Tsat_water(ptemp,Tsat(i,k))
+         ENDDO
+      ENDDO
+
+      ! get column / layer conversion factor
+      DO k = 1, nlayermx
+         DO i = 1, ngrid
+            l2c(i,k)=(pplev(i,k)-pplev(i,k+1))/g
+         ENDDO
+      ENDDO
+
+      ! Vertical loop (from top to bottom)
+      ! We carry the rain with us and calculate that added by warm/cold precipitation
+      ! processes and that subtracted by evaporation at each level.
+      DO k = nlayermx, 1, -1
+
+         IF (evap_prec) THEN ! note no rneb dependence!
+            DO i = 1, ngrid
+               IF (zrfl(i) .GT.0.) THEN
+
+                  if(zt(i,k).gt.Tsat(i,k))then
+!!		     treat the case where all liquid water should boil
+		     zqev=MIN((zt(i,k)-Tsat(i,k))*RCPD*l2c(i,k)/RLVTT/ptimestep,zrfl(i))
+		     zrfl(i)=MAX(zrfl(i)-zqev,0.)
+		     d_q(i,k)=zqev/l2c(i,k)*ptimestep
+		     d_t(i,k) = - d_q(i,k) * RLVTT/RCPD
+		  else
+                     zqev = MAX (0.0, (zqs(i,k)-q(i,k)))*l2c(i,k)/ptimestep !there was a bug here
+                     zqevt= 2.0e-5*(1.0-q(i,k)/zqs(i,k))    & !default was 2.e-5
+                        *sqrt(zrfl(i))*l2c(i,k)/pplay(i,k)*zt(i,k)*R ! BC modif here
+                     zqevt = MAX (zqevt, 0.0)
+                     zqev  = MIN (zqev, zqevt)
+                     zqev  = MAX (zqev, 0.0)
+                     zrfln(i)= zrfl(i) - zqev
+		     zrfln(i)= max(zrfln(i),0.0)
+
+                     d_q(i,k) = - (zrfln(i)-zrfl(i))/l2c(i,k)*ptimestep
+                     !d_t(i,k) = d_q(i,k) * RLVTT/RCPD!/(1.0+RVTMP2*q(i,k)) ! double BC modif here
+                     d_t(i,k) = - d_q(i,k) * RLVTT/RCPD ! was bugged!
+                     zrfl(i)  = zrfln(i)
+		  end if
+		     
+
+               ENDIF ! of IF (zrfl(i) .GT.0.)
+            ENDDO
+         ENDIF ! of IF (evap_prec)
+
+         zoliq(1:ngrid) = 0.0
+
+
+         if(precip_scheme.eq.1)then
+
+            DO i = 1, ngrid
+               ttemp = zt(i,k)
+               IF (ttemp .ge. T_h2O_ice_liq) THEN
+                  lconvert=rainthreshold
+               ELSEIF (ttemp .gt. t_crit) THEN
+                  lconvert=rainthreshold*(1.- t_crit/ttemp)
+                  lconvert=MAX(0.0,lconvert)              
+               ELSE
+                  lconvert=0.
+               ENDIF
+
+
+               IF (ql(i,k).gt.1.e-9) then
+                  zneb(i)  = MAX(rneb(i,k), seuil_neb)
+                  IF ((ql(i,k)/zneb(i)).gt.lconvert)THEN ! precipitate!
+                     d_ql(i,k) = -MAX((ql(i,k)-lconvert*zneb(i)),0.0)
+                     zrfl(i)   = zrfl(i) - d_ql(i,k)*l2c(i,k)/ptimestep
+                  ENDIF
+               ENDIF
+            ENDDO
+
+         elseif (precip_scheme.ge.2) then
+          
+           DO i = 1, ngrid
+               IF (rneb(i,k).GT.0.0) THEN
+                  zoliq(i) = ql(i,k)
+                  zrho(i)  = pplay(i,k) / ( zt(i,k) * R )
+                  zdz(i)   = (pplev(i,k)-pplev(i,k+1)) / (zrho(i)*g)
+                  zfrac(i) = (zt(i,k)-T_h2O_ice_clouds) / (T_h2O_ice_liq-T_h2O_ice_clouds)
+                  zfrac(i) = MAX(zfrac(i), 0.0)
+                  zfrac(i) = MIN(zfrac(i), 1.0)
+                  zneb(i)  = MAX(rneb(i,k), seuil_neb)
+               ENDIF
+           ENDDO
+
+ !recalculate liquid water particle radii
+	   call h2o_cloudrad(ngrid,ql,reffh2oliq,reffh2oice)
+
+           SELECT CASE(precip_scheme)
+ !precip scheme from Sundquist 78
+ 	   CASE(2)
+
+            DO n = 1, ninter
+               DO i = 1, ngrid
+                  IF (rneb(i,k).GT.0.0) THEN
+                     ! this is the ONLY place where zneb, precip_timescale and cloud_sat are used
+
+                     zchau(i) = (ptimestep/(FLOAT(ninter)*precip_timescale)) * zoliq(i)      &
+                          * (1.0-EXP(-(zoliq(i)/zneb(i)/cloud_sat)**2)) * zfrac(i)
+                     zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
+                     zfroi(i) = ptimestep/FLOAT(ninter)/zdz(i)*zoliq(i)    &
+                          *fall2v(reffh2oice(i,k)) * (1.0-zfrac(i)) ! zfroi behaves oddly...
+                     ztot(i)  = zchau(i) + zfroi(i)
+
+                     IF (zneb(i).EQ.seuil_neb) ztot(i) = 0.0
+                     ztot(i)  = MIN(MAX(ztot(i),0.0),zoliq(i))
+                     zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0)
+
+                  ENDIF
+               ENDDO
+            ENDDO            
+
+ !precip scheme modified from Sundquist 78 (in q**3)
+	   CASE(3)	    
+	    
+            DO n = 1, ninter
+               DO i = 1, ngrid
+                  IF (rneb(i,k).GT.0.0) THEN
+                     ! this is the ONLY place where zneb, precip_timescale and cloud_sat are used
+
+                     zchau(i) = (ptimestep/(FLOAT(ninter)*precip_timescale*cloud_sat**2)) * (zoliq(i)/zneb(i))**3  
+                     zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
+                     zfroi(i) = ptimestep/FLOAT(ninter)/zdz(i)*zoliq(i)    &
+                          *fall2v(reffh2oice(i,k)) * (1.0-zfrac(i)) ! zfroi behaves oddly...
+                     ztot(i)  = zchau(i) + zfroi(i)
+
+                     IF (zneb(i).EQ.seuil_neb) ztot(i) = 0.0
+                     ztot(i)  = MIN(MAX(ztot(i),0.0),zoliq(i))
+                     zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0)
+
+                  ENDIF
+               ENDDO
+            ENDDO            
+
+ !precip scheme modified from Boucher 95
+	   CASE(4)
+
+            DO n = 1, ninter
+               DO i = 1, ngrid
+                  IF (rneb(i,k).GT.0.0) THEN
+                     ! this is the ONLY place where zneb and c1 are used
+
+                     zchau(i) = ptimestep/FLOAT(ninter) *c1* zrho(i) &
+                                    *(zoliq(i)/zneb(i))**2*reffh2oliq(i,k)*zneb(i)* zfrac(i) 
+                     zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
+                     zfroi(i) = ptimestep/FLOAT(ninter)/zdz(i)*zoliq(i)    &
+                          *fall2v(reffh2oice(i,k)) * (1.0-zfrac(i)) ! zfroi behaves oddly...
+                     ztot(i)  = zchau(i) + zfroi(i)
+
+                     IF (zneb(i).EQ.seuil_neb) ztot(i) = 0.0
+                     ztot(i)  = MIN(MAX(ztot(i),0.0),zoliq(i))
+                     zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0)
+
+                  ENDIF
+               ENDDO
+            ENDDO            
+
+           END SELECT ! precip_scheme 
+
+            ! Change in cloud density and surface H2O values
+            DO i = 1, ngrid
+               IF (rneb(i,k).GT.0.0) THEN
+                  d_ql(i,k) = (zoliq(i) - ql(i,k))!/ptimestep
+                  zrfl(i)   = zrfl(i)+ MAX(ql(i,k)-zoliq(i),0.0)*l2c(i,k)/ptimestep
+               ENDIF
+            ENDDO
+
+
+         endif ! if precip_scheme=1
+
+      ENDDO ! of DO k = nlayermx, 1, -1
+
+!     Rain or snow on the ground
+      DO i = 1, ngrid
+         if(zrfl(i).lt.0.0)then
+            print*,'Droplets of negative rain are falling...'
+            call abort
+         endif
+         IF (t(i,1) .LT. T_h2O_ice_liq) THEN
+            dqssnow(i) = zrfl(i)
+            dqsrain(i) = 0.0
+         ELSE
+            dqssnow(i) = 0.0
+            dqsrain(i) = zrfl(i) ! liquid water = ice for now
+         ENDIF
+      ENDDO
+
+!     now subroutine -----> GCM variables
+      if (evap_prec) then
+        dqrain(1:ngrid,1:nlayermx,i_vap)=d_q(1:ngrid,1:nlayermx)/ptimestep
+        d_t(1:ngrid,1:nlayermx)=d_t(1:ngrid,1:nlayermx)/ptimestep
+      else
+        dqrain(1:ngrid,1:nlayermx,i_vap)=0.0
+        d_t(1:ngrid,1:nlayermx)=0.0
+      endif
+      dqrain(1:ngrid,1:nlayermx,i_ice) = d_ql(1:ngrid,1:nlayermx)/ptimestep
+
+    end subroutine rain
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rcm1d.F.delete
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rcm1d.F.delete	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rcm1d.F.delete	(revision 222)
@@ -0,0 +1,925 @@
+      program rcm1d
+
+! to use  'getin'
+      use ioipsl_getincom, only: getin
+      use infotrac, only: nqtot, tname
+      use surfdat_h, only: albedodat, phisfi, dryness, watercaptag,
+     &                     zmea, zstd, zsig, zgam, zthe,
+     &                     emissiv, emisice, albedice, iceradius,
+     &                     dtemisice
+      use comdiurn_h, only: sinlat, coslat, sinlon, coslon
+!      use comsaison_h
+      use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat, volcapa
+      USE comgeomfi_h, only: lati, long, area
+      use control_mod, only: day_step, ecritphy
+      use phyredem, only: physdem0,physdem1
+      use comgeomphy, only: initcomgeomphy
+      use slab_ice_h, only: noceanmx
+
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Run the physics package of the universal model in a 1D column.
+!     
+!     It can be compiled with a command like (e.g. for 25 layers):
+!                                  "makegcm -p std -d 25 rcm1d"
+!     It requires the files "callphys.def", "z2sig.def",
+!     "traceur.def", and "run.def" with a line "INCLUDEDEF=callphys.def"
+!
+!     Authors
+!     -------
+!     Frederic Hourdin
+!     R. Fournier
+!     F. Forget
+!     F. Montmessin (water ice added)
+!     R. Wordsworth
+!     B. Charnay
+!     A. Spiga
+!     J. Leconte (2012)
+!
+!==================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+!#include "control.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "logic.h"
+#include "comgeom.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unitstart      ! unite d'ecriture de "startfi"
+      INTEGER nlayer,nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day           ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(nlayermx)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(nlayermx+1) ! intermediate pressure levels (pa)
+      REAL psurf,tsurf(1)      
+      REAL u(nlayermx),v(nlayermx)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(nlayermx)   ! temperature at the middle of the layers
+      REAL,ALLOCATABLE :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
+      REAL,ALLOCATABLE :: qsurf(:)      ! tracer surface budget (e.g. kg.m-2)
+      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
+!      REAL co2ice           ! co2ice layer (kg.m-2) !not used anymore
+      integer :: i_co2_ice=0  ! tracer index of co2 ice
+      integer :: i_h2o_ice=0  ! tracer index of h2o ice
+      integer :: i_h2o_vap=0  ! tracer index of h2o vapor
+      REAL emis(1)             ! surface layer
+      REAL q2(nlayermx+1)   ! Turbulent Kinetic Energy
+      REAL zlay(nlayermx)   ! altitude estimee dans les couches (km)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(nlayermx),dv(nlayermx),dtemp(nlayermx)
+      REAL dudyn(nlayermx),dvdyn(nlayermx),dtempdyn(nlayermx)
+      REAL dpsurf    
+      REAL,ALLOCATABLE :: dq(:,:)
+      REAL,ALLOCATABLE :: dqdyn(:,:)
+
+c   Various intermediate variables
+!      INTEGER thermo
+      REAL zls
+      REAL phi(nlayermx),h(nlayermx),s(nlayermx)
+      REAL pks, ptif, w(nlayermx)
+      INTEGER ierr, aslun
+      REAL tmp1(0:nlayermx),tmp2(0:nlayermx)
+      Logical  tracerdyn
+      integer :: nq !=1 ! number of tracers
+ 
+      character*2 str2
+      character (len=7) :: str7
+
+      logical oldcompare, earthhack,saveprofile
+
+!     added by RW for zlay computation
+      real Hscale, Hmax, rho, dz
+
+!     added by RW for autozlevs computation
+      real nu, xx, pMIN, zlev, Htop
+      real logplevs(nlayermx)
+
+!     added by BC
+      REAL cloudfrac(1,nlayermx)
+      REAL hice(1),totcloudfrac(1)
+      REAL qzero1D   !initial water amount on the ground
+
+!     added by BC for ocean
+      real rnat(1)
+      REAL tslab(1,noceanmx),tsea_ice(1),sea_ice(1)
+      real pctsrf_sic(1)
+
+
+
+!     added by AS to avoid the use of adv trac common
+      character*20,allocatable :: nametrac(:)   ! name of the tracer (no need for adv trac common)
+
+      real :: latitude, longitude
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+      !! those are defined in surfdat_h.F90
+      IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(1))
+      IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(1))
+      IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(1))
+      IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(1))
+      IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(1))
+      IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(1))
+      IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(1))
+      IF (.not. ALLOCATED(dryness)) ALLOCATE(dryness(1))
+      IF (.not. ALLOCATED(watercaptag)) ALLOCATE(watercaptag(1))
+      !! those are defined in comdiurn_h.F90
+      IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(1))
+      IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(1))
+      IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(1))
+      IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(1))
+      !! those are defined in comsoil_h.F90
+      IF (.not.ALLOCATED(layer)) ALLOCATE(layer(nsoilmx))
+      IF (.not.ALLOCATED(mlayer)) ALLOCATE(mlayer(0:nsoilmx-1))
+      IF (.not.ALLOCATED(inertiedat)) ALLOCATE(inertiedat(1,nsoilmx))
+      !! those are defined in comgeomfi_h
+      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(1))
+      IF (.not. ALLOCATED(long)) ALLOCATE(long(1))
+      IF (.not. ALLOCATED(area)) ALLOCATE(area(1))
+
+
+      saveprofile=.false.
+      saveprofile=.true.
+
+c ----------------------------------------
+c  Default values  (corresponding to Mars)
+c ----------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Parametres Couche limite et Turbulence 
+c     --------------------------------------
+      z0 =  1.e-2                ! surface roughness (m) ~0.01 
+      emin_turb = 1.e-6          ! energie minimale ~1.e-8
+      lmixmin = 30               ! longueur de melange ~100
+ 
+c     propriete optiques des calottes et emissivite du sol
+c     ----------------------------------------------------
+      emissiv= 0.95              ! Emissivite du sol martien ~.95
+      emisice(1)=0.95            ! Emissivite calotte nord
+      emisice(2)=0.95            ! Emissivite calotte sud  
+
+      albedice(1)=0.5            ! Albedo calotte nord
+      albedice(2)=0.5            ! Albedo calotte sud
+      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
+      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
+      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
+      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
+      hybrid=.false.
+
+c ------------------------------------------------------
+c  Load parameters from "run.def" and "gases.def" 
+c ------------------------------------------------------
+
+! check if 'rcm1d.def' file is around 
+      open(90,file='rcm1d.def',status='old',form='formatted',
+     &     iostat=ierr)
+      if (ierr.ne.0) then
+        write(*,*) 'Cannot find required file "rcm1d.def"'
+        write(*,*) 'which should contain some input parameters'
+        write(*,*) ' ... might as well stop here ...'
+        stop
+      else
+        close(90)
+      endif
+
+! now, run.def is needed anyway. so we create a dummy temporary one
+! for ioipsl to work. if a run.def is already here, stop the
+! program and ask the user to do a bit of cleaning
+      open(90,file='run.def',status='old',form='formatted',
+     &     iostat=ierr)
+      if (ierr.eq.0) then
+        close(90)
+        write(*,*) 'There is already a run.def file.'
+        write(*,*) 'This is not compatible with 1D runs.'
+        write(*,*) 'Please remove the file and restart the run.'
+        write(*,*) 'Runtime parameters are supposed to be in rcm1d.def'
+        stop
+      else
+        call system('touch run.def')
+        call system("echo 'INCLUDEDEF=callphys.def' >> run.def")
+        call system("echo 'INCLUDEDEF=rcm1d.def' >> run.def")
+      endif
+
+! check if we are going to run with or without tracers
+      write(*,*) "Run with or without tracer transport ?"
+      tracer=.false. ! default value
+      call getin("tracer",tracer)
+      write(*,*) " tracer = ",tracer
+
+! OK. now that run.def has been read once -- any variable is in memory.
+! so we can dump the dummy run.def
+      call system("rm -rf run.def")
+
+! while we're at it, check if there is a 'traceur.def' file
+! and preocess it, if necessary. Otherwise initialize tracer names
+      if (tracer) then
+      ! load tracer names from file 'traceur.def'
+        open(90,file='traceur.def',status='old',form='formatted',
+     &       iostat=ierr)
+        if (ierr.eq.0) then
+          write(*,*) "rcm1d: Reading file traceur.def"
+          ! read number of tracers:
+          read(90,*,iostat=ierr) nq
+          nqtot=nq ! set value of nqtot (in infotrac module) as nq
+          if (ierr.ne.0) then
+            write(*,*) "rcm1d: error reading number of tracers"
+            write(*,*) "   (first line of traceur.def) "
+            stop
+          endif
+          if (nq>0) then
+            allocate(tname(nq))
+            allocate(q(nlayermx,nq))
+            allocate(qsurf(nq))
+            allocate(dq(nlayermx,nq))
+            allocate(dqdyn(nlayermx,nq))
+          else
+            write(*,*) "rcm1d: Error. You set tracer=.true."
+            write(*,*) "       but # of tracers in traceur.def is ",nq
+            stop
+          endif
+        
+          do iq=1,nq
+          ! minimal version, just read in the tracer names, 1 per line
+            read(90,*,iostat=ierr) tname(iq)
+            if (ierr.ne.0) then
+              write(*,*) 'rcm1d: error reading tracer names...'
+              stop
+            endif
+          enddo !of do iq=1,nq
+! check for co2_ice / h2o_ice tracers:
+         i_co2_ice=0
+         i_h2o_ice=0
+         i_h2o_vap=0
+         do iq=1,nq
+           if (tname(iq)=="co2_ice") then
+             i_co2_ice=iq
+           elseif (tname(iq)=="h2o_ice") then
+             i_h2o_ice=iq
+           elseif (tname(iq)=="h2o_vap") then
+             i_h2o_vap=iq
+           endif
+         enddo
+        else
+          write(*,*) 'Cannot find required file "traceur.def"'
+          write(*,*) ' If you want to run with tracers, I need it'
+          write(*,*) ' ... might as well stop here ...'
+          stop
+        endif
+        close(90)
+
+      else ! of if (tracer)
+        nqtot=0
+        nq=0
+        ! still, make allocations for 1 dummy tracer
+        allocate(tname(1)) 
+        allocate(qsurf(1))
+        allocate(q(nlayermx,1))
+        allocate(dq(nlayermx,1))
+      
+       ! Check that tracer boolean is compliant with number of tracers
+       ! -- otherwise there is an error (and more generally we have to be consistent)
+       if (nq .ge. 1) then
+          write(*,*) "------------------------------"
+          write(*,*) "rcm1d: You set tracer=.false."
+          write(*,*) " But set number of tracers to ",nq
+          write(*,*) " > If you want tracers, set tracer=.true."
+          write(*,*) "------------------------------"
+          stop
+       endif
+      endif ! of if (tracer)
+
+!!! We have to check that check_cpp_match is F for 1D computations
+!!! We think this check is better than make a particular case for 1D in inifis or calc_cpp_mugaz
+      check_cpp_match = .false.
+      call getin("check_cpp_match",check_cpp_match)
+      if (check_cpp_match) then
+          print*,"In 1D modeling, check_cpp_match is supposed to be F"
+          print*,"Please correct callphys.def"
+          stop
+      endif
+
+!!! GEOGRAPHICAL INITIALIZATIONS
+     !!! AREA. useless in 1D
+      area(1)=1.E+0
+      aire(1)=area(1) !JL+EM to have access to the area in the diagfi.nc files. area in comgeomfi.h and aire in comgeom.h
+     !!! GEOPOTENTIAL. useless in 1D because control by surface pressure
+      phisfi(1)=0.E+0
+     !!! LATITUDE. can be set. 
+      latitude=0 ! default value for latitude
+      PRINT *,'latitude (in degrees) ?'
+      call getin("latitude",latitude)
+      write(*,*) " latitude = ",latitude
+      latitude=latitude*pi/180.E+0
+     !!! LONGITUDE. useless in 1D.
+      longitude=0.E+0
+      longitude=longitude*pi/180.E+0
+
+!!! CALL INIFIS
+!!! - read callphys.def
+!!! - calculate sine and cosine of longitude and latitude
+!!! - calculate mugaz and cp 
+!!! NB: some operations are being done dummily in inifis in 1D
+!!! - physical constants: nevermind, things are done allright below
+!!! - physical frequency: nevermind, in inifis this is a simple print
+      cpp=1.d-7 !JL because we divide by cpp in inifis, there may be a more elegant solution
+      CALL inifis(1,llm,nq,day0,daysec,dtphys,
+     .            latitude,longitude,area,rad,g,r,cpp)
+!!! We check everything is OK.
+      PRINT *,"CHECK"
+      PRINT *,"--> mugaz = ",mugaz
+      PRINT *,"--> cpp = ",cpp
+      r = 8.314511E+0 * 1000.E+0 / mugaz
+      rcp = r / cpp
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!! PLANETARY CONSTANTS !!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      g = -99999.
+      PRINT *,'GRAVITY in m s-2 ?'
+      call getin("g",g)
+      IF (g.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED g IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> g = ",g
+      ENDIF
+
+      rad = -99999.
+      PRINT *,'PLANETARY RADIUS in m ?'
+      call getin("rad",rad)
+      ! Planetary  radius is needed to compute shadow of the rings
+      IF (rad.eq.-99999. .and. rings_shadow .eq. .true.) THEN
+          PRINT *,"STOP. I NEED rad IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> rad = ",rad
+      ENDIF
+
+      daysec = -99999.
+      PRINT *,'LENGTH OF A DAY in s ?'
+      call getin("daysec",daysec)
+      IF (daysec.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED daysec IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> daysec = ",daysec
+      ENDIF
+      omeg=4.*asin(1.)/(daysec)
+      PRINT *,"OK. FROM THIS I WORKED OUT:"
+      PRINT *,"--> omeg = ",omeg
+
+      year_day = -99999.
+      PRINT *,'LENGTH OF A YEAR in days ?'
+      call getin("year_day",year_day)
+      IF (year_day.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED year_day IN RCM1D.DEF."
+          STOP
+      ELSE 
+          PRINT *,"--> year_day = ",year_day
+      ENDIF
+
+      periastr = -99999.
+      PRINT *,'MIN DIST STAR-PLANET in AU ?'
+      call getin("periastr",periastr)
+      IF (periastr.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED periastr IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> periastr = ",periastr
+      ENDIF
+
+      apoastr = -99999.
+      PRINT *,'MAX DIST STAR-PLANET in AU ?'
+      call getin("apoastr",apoastr)
+      IF (apoastr.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED apoastr IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> apoastr = ",apoastr
+      ENDIF
+
+      peri_day = -99999.
+      PRINT *,'DATE OF PERIASTRON in days ?'
+      call getin("peri_day",peri_day)
+      IF (peri_day.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED peri_day IN RCM1D.DEF."
+          STOP
+      ELSE IF (peri_day.gt.year_day) THEN
+          PRINT *,"STOP. peri_day.gt.year_day"
+          STOP
+      ELSE  
+          PRINT *,"--> peri_day = ", peri_day
+      ENDIF 
+
+      obliquit = -99999. 
+      PRINT *,'OBLIQUITY in deg ?'
+      call getin("obliquit",obliquit)
+      IF (obliquit.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED obliquit IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> obliquit = ",obliquit
+      ENDIF 
+
+      psurf = -99999.
+      PRINT *,'SURFACE PRESSURE in Pa ?'
+      call getin("psurf",psurf)
+      IF (psurf.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED psurf IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> psurf = ",psurf
+      ENDIF
+      !! we need reference pressures
+      pa=psurf/30.
+      preff=psurf ! these values are not needed in 1D  (are you sure JL12)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!! END PLANETARY CONSTANTS !!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+c  Date et heure locale du debut du run
+c  ------------------------------------
+c    Date (en sols depuis le solstice de printemps) du debut du run
+      day0 = 0 ! default value for day0
+      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
+      call getin("day0",day0)
+      day=float(day0)
+      write(*,*) " day0 = ",day0
+c  Heure de demarrage
+      time=0 ! default value for time
+      write(*,*)'Initial local time (in hours, between 0 and 24)?'
+      call getin("time",time)
+      write(*,*)" time = ",time
+      time=time/24.E+0 ! convert time (hours) to fraction of sol
+
+
+c  Discretisation (Definition de la grille et des pas de temps)
+c  --------------
+c
+      nlayer=nlayermx
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+
+      day_step=48 ! default value for day_step
+      PRINT *,'Number of time steps per sol ?'
+      call getin("day_step",day_step)
+      write(*,*) " day_step = ",day_step
+
+       
+      ecritphy=day_step ! default value for ecritphy
+      PRINT *,'Nunber of steps between writediagfi ?'
+      call getin("ecritphy",ecritphy)
+      write(*,*) " ecritphy = ",ecritphy
+
+      ndt=10 ! default value for ndt
+      PRINT *,'Number of sols to run ?'
+      call getin("ndt",ndt)
+      write(*,*) " ndt = ",ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+      write(*,*)"-------------------------------------"
+      write(*,*)"-------------------------------------"
+      write(*,*)"--> Physical timestep is ",dtphys
+      write(*,*)"-------------------------------------"
+      write(*,*)"-------------------------------------"
+
+c output spectrum?
+      write(*,*)"Output spectral OLR?"
+      specOLR=.false.
+      call getin("specOLR",specOLR)
+      write(*,*)" specOLR = ",specOLR
+
+c
+c  pour le schema d'ondes de gravite
+c  ---------------------------------
+      zmea(1)=0.E+0
+      zstd(1)=0.E+0
+      zsig(1)=0.E+0
+      zgam(1)=0.E+0
+      zthe(1)=0.E+0
+
+c    Initialisation des traceurs
+c    ---------------------------
+
+      DO iq=1,nq
+        DO ilayer=1,nlayer
+           q(ilayer,iq) = 0.
+        ENDDO
+      ENDDO
+     
+      DO iq=1,nq
+        qsurf(iq) = 0.
+      ENDDO
+
+      if (water) then
+         qzero1D               = 0.0
+         qsurf(i_h2o_vap) = qzero1D
+      endif
+
+c   Initialisation pour prendre en compte les vents en 1-D
+c   ------------------------------------------------------
+      ptif=2.E+0*omeg*sinlat(1)
+ 
+
+c    vent geostrophique
+      gru=10. ! default value for gru
+      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
+      call getin("u",gru)
+      write(*,*) " u = ",gru
+      grv=0. !default value for grv
+      PRINT *,'meridional northward component of the geostrophic',
+     &' wind (m/s) ?'
+      call getin("v",grv)
+      write(*,*) " v = ",grv
+
+c     Initialisation des vents  au premier pas de temps
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c     energie cinetique turbulente
+      DO ilevel=1,nlevel
+         q2(ilevel)=0.E+0
+      ENDDO
+
+c  emissivity / surface co2 ice ( + h2o ice??)
+c  -------------------------------------------
+      emis(1)=emissiv ! default value for emissivity
+      PRINT *,'Emissivity of bare ground ?'
+      call getin("emis",emis(1))
+      write(*,*) " emis = ",emis(1)
+      emissiv=emis(1) ! we do this so that condense_co2 sets things to the right
+                   ! value if there is no snow
+
+      if(i_co2_ice.gt.0)then
+         qsurf(i_co2_ice)=0 ! default value for co2ice
+         print*,'Initial CO2 ice on the surface (kg.m-2)'
+         call getin("co2ice",qsurf(i_co2_ice))
+         write(*,*) " co2ice = ",qsurf(i_co2_ice)
+         IF (qsurf(i_co2_ice).ge.1.E+0) THEN
+            ! if we have some CO2 ice on the surface, change emissivity
+            if (lati(1).ge.0) then ! northern hemisphere
+              emis(1)=emisice(1)
+            else ! southern hemisphere
+              emis(1)=emisice(2)
+            endif
+         ENDIF
+      endif
+
+c  calcul des pressions et altitudes en utilisant les niveaux sigma
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates
+c    """"""""""""""""""""
+      hybrid=.true.
+      PRINT *,'Hybrid coordinates ?'
+      call getin("hybrid",hybrid)
+      write(*,*) " hybrid = ", hybrid
+
+
+      autozlevs=.false.
+      PRINT *,'Auto-discretise vertical levels ?'
+      call getin("autozlevs",autozlevs)
+      write(*,*) " autozlevs = ", autozlevs
+
+      pceil = psurf / 1000.0 ! Pascals
+      PRINT *,'Ceiling pressure (Pa) ?'
+      call getin("pceil",pceil)
+      write(*,*) " pceil = ", pceil
+
+! Test of incompatibility:
+! if autozlevs used, cannot have hybrid too
+
+      if (autozlevs.and.hybrid) then
+         print*,'Cannot use autozlevs and hybrid together!'
+         call abort
+      endif
+
+      if(autozlevs)then
+            
+         open(91,file="z2sig.def",form='formatted')
+         read(91,*) Hscale
+         DO ilayer=1,nlayer-2
+            read(91,*) Hmax
+         enddo
+         close(91)
+ 
+            
+         print*,'Hmax = ',Hmax,' km'
+         print*,'Auto-shifting Hscale to:'
+!     Hscale = Hmax / log(psurf/100.0)
+         Hscale = Hmax / log(psurf/pceil)
+         print*,'Hscale = ',Hscale,' km'
+         
+! none of this matters if we dont care about zlay
+         
+      endif
+
+      call disvert
+
+         if(.not.autozlevs)then
+            ! we want only the scale height from z2sig, in order to compute zlay
+            open(91,file="z2sig.def",form='formatted')
+            read(91,*) Hscale
+            close(91)
+         endif
+
+!         if(autozlevs)then
+!            open(94,file="Hscale.temp",form='formatted')
+!            read(94,*) Hscale
+!            close(94)
+!         endif
+
+         DO ilevel=1,nlevel
+            plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+         ENDDO
+         
+         DO ilayer=1,nlayer
+            play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+         ENDDO
+         
+
+
+         DO ilayer=1,nlayer
+!     zlay(ilayer)=-300.E+0 *r*log(play(ilayer)/plev(1))
+!     &   /g
+            zlay(ilayer)=-1000.0*Hscale*log(play(ilayer)/plev(1))
+         ENDDO
+
+!      endif
+
+c  profil de temperature au premier appel
+c  --------------------------------------
+      pks=psurf**rcp
+
+c altitude en km dans profile: on divise zlay par 1000
+      tmp1(0)=0.E+0
+      DO ilayer=1,nlayer
+        tmp1(ilayer)=zlay(ilayer)/1000.E+0
+      ENDDO
+      call profile(nlayer+1,tmp1,tmp2)
+
+      tsurf(1)=tmp2(0)
+      DO ilayer=1,nlayer
+        temp(ilayer)=tmp2(ilayer)
+      ENDDO
+      print*,"check"
+      PRINT*,"INPUT SURFACE TEMPERATURE",tsurf(1)
+      PRINT*,"INPUT TEMPERATURE PROFILE",temp
+
+c  Initialisation albedo / inertie du sol
+c  --------------------------------------
+      albedodat(1)=0.2 ! default value for albedodat
+      PRINT *,'Albedo of bare ground ?'
+      call getin("albedo",albedodat(1))
+      write(*,*) " albedo = ",albedodat(1)
+
+      inertiedat(1,1)=400 ! default value for inertiedat
+      PRINT *,'Soil thermal inertia (SI) ?'
+      call getin("inertia",inertiedat(1,1))
+      write(*,*) " inertia = ",inertiedat(1,1)
+
+! Initialize soil properties and temperature
+! ------------------------------------------
+      volcapa=1.e6 ! volumetric heat capacity
+      DO isoil=1,nsoil
+         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
+         tsoil(isoil)=tsurf(1)  ! soil temperature
+      ENDDO
+
+! Initialize depths
+! -----------------
+      do isoil=0,nsoil-1
+        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
+      enddo
+      do isoil=1,nsoil
+        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
+      enddo
+
+
+! Initialize slab ocean
+! -----------------
+      rnat=1. ! default value for rnat
+      if(inertiedat(1,1).GE.10000.)then
+         rnat=0.
+      endif
+      if(ok_slab_ocean)then
+      rnat=0.
+      tslab(1,1)=tsurf(1)
+      tslab(1,2)=tsurf(1)
+      tsea_ice=tsurf
+      pctsrf_sic=0.
+      sea_ice=0.
+      endif
+
+
+
+c  Write a "startfi" file
+c  --------------------
+c  This file will be read during the first call to "physiq".
+c  It is needed to transfert physics variables to "physiq"...
+
+      call physdem0("startfi.nc",long,lati,nsoilmx,1,llm,nq,
+     &              dtphys,real(day0),time,area,
+     &              albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("startfi.nc",nsoilmx,1,llm,nq,
+     &                dtphys,time,
+     &                tsurf,tsoil,emis,q2,qsurf,
+     &                cloudfrac,totcloudfrac,hice, 
+     &                rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+!      call physdem1(1,"startfi.nc",long,lati,nsoilmx,nq,
+!     &              dtphys,float(day0),
+!     &              time,tsurf,tsoil,emis,q2,qsurf,
+!     &              area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe,
+!     &              cloudfrac,totcloudfrac,hice,nametrac)
+
+c=======================================================================
+c  BOUCLE TEMPORELLE DU MODELE 1D 
+c=======================================================================
+
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+        IF (idt.eq.ndt) then       !test
+         lastcall=.true.
+         call stellarlong(day*1.0,zls)
+!         write(103,*) 'Ls=',zls*180./pi
+!         write(103,*) 'Lat=', lati(1)*180./pi
+!         write(103,*) 'RunEnd - Atmos. Temp. File'
+!         write(103,*) 'RunEnd - Atmos. Temp. File'
+!         write(104,*) 'Ls=',zls*180./pi
+!         write(104,*) 'Lat=', lati(1)
+!         write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c    calcul du geopotentiel 
+c     ~~~~~~~~~~~~~~~~~~~~~
+
+
+      DO ilayer=1,nlayer
+
+!              if(autozlevs)then
+!                 s(ilayer)=(play(ilayer)/psurf)**rcp
+!              else
+          s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+!              endif
+              !s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+          h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+       ENDDO
+
+!      DO ilayer=1,nlayer
+!        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+!        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+!      ENDDO
+      phi(1)=pks*h(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
+     &                  *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       appel de la physique
+c       --------------------
+
+
+      CALL physiq (1,llm,nq,
+     .     tname,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,phi,
+     ,     u, v,temp, q,  
+     ,     w,
+C - sorties
+     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
+
+
+c       evolution du vent : modele 1D
+c       -----------------------------
+ 
+c       la physique calcule les derivees temporelles de u et v.
+c       on y rajoute betement un effet Coriolis.
+c
+c       DO ilayer=1,nlayer
+c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
+c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
+c       ENDDO
+
+c       Pour certain test : pas de coriolis a l'equateur
+c       if(lati(1).eq.0.) then
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c       end if
+c      
+c
+c       Calcul du temps au pas de temps suivant
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       calcul des vitesses et temperature au pas de temps suivant
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       calcul des pressions au pas de temps suivant
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           DO ilevel=1,nlevel
+              plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+                 play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+c       calcul traceur au pas de temps suivant
+c       --------------------------------------
+
+        DO iq = 1, nq
+          DO ilayer=1,nlayer
+             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
+          ENDDO
+        END DO
+
+c    ========================================================
+c    GESTION DES SORTIE
+c    ========================================================
+      if(saveprofile)then
+         OPEN(12,file='profile.out',form='formatted')
+         write(12,*) tsurf
+         DO ilayer=1,nlayermx
+            write(12,*) temp(ilayer) !, play(ilayer) !AS12 only temp so that iprofile=8 can be used
+         ENDDO
+         CLOSE(12)
+      endif
+
+
+      ENDDO   ! fin de la boucle temporelle
+
+      write(*,*) "rcm1d: Everything is cool."
+
+c    ========================================================
+      end                       !rcm1d
+ 
+c***********************************************************************
+c***********************************************************************
+c     Subroutines Bidons utilise seulement en 3D, mais
+c     necessaire a la compilation de rcm1d en 1D
+
+      subroutine gr_fi_dyn
+      RETURN
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+
+#include "../dyn3d_common/disvert.F"
+#include "../dyn3d_common/abort_gcm.F"
+#include "../dyn3d_common/diverg.F"
+#include "../dyn3d_common/grad.F"
+#include "../dyn3d_common/gr_u_scal.F"
+#include "../dyn3d_common/gr_v_scal.F"
+#include "../dyn3d_common/gr_dyn_fi.F"
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rings.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rings.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/rings.F90	(revision 222)
@@ -0,0 +1,197 @@
+SUBROUTINE rings(ngrid, declin, ptime, rad, flat, eclipse)
+! Calculates Saturn's rings shadowing
+! Includes rings opacities measured by Cassini/UVIS
+! Authors: M. Sylvestre, M. Capderou, S. Guerlet, A. Spiga
+
+    use comdiurn_h
+    use comgeomfi_h
+ 
+    implicit none   
+
+    INTEGER, INTENT(IN) :: ngrid  ! horizontal grid dimension
+    REAL, INTENT(IN) :: declin    ! latitude of the subsolar point
+    REAL, INTENT(IN) :: ptime     ! UTC time in sol fraction : ptime=0.5 at noon
+    REAL, INTENT(IN) :: rad       ! equatorial radius of the planet
+    REAL, INTENT(IN) :: flat      ! flattening of the planet 
+    REAL, DIMENSION(ngrid), INTENT(OUT) :: eclipse ! absorption of the light by the rings    
+    
+    REAL :: rpol   ! polar radius of the planet
+    REAL :: e      ! shape excentricity of the planet : (1-e*e) = (1-f)*(1-f)    
+    INTEGER, PARAMETER :: nb_a = 4 ! number of subdivisions of the A ring
+    INTEGER, PARAMETER :: nb_b = 3 ! number of subdivisions of the B ring
+    INTEGER, PARAMETER :: nb_c = 3 ! number of subdivisions of the C ring
+    INTEGER, PARAMETER :: nb_ca = 2 ! number of subdivisions in the Cassini division
+    INTEGER :: i
+
+    ! arrays for the rings. TBD: dynamical?
+    REAL, DIMENSION(nb_a) :: A_Rint ! internal radii of the subdivisions of the A ring 
+    REAL, DIMENSION(nb_a) :: A_Rext ! external radii of the subdivisions of the A ring
+    REAL, DIMENSION(nb_b) :: B_Rint ! internal radii of the subdivisions of the B ring
+    REAL, DIMENSION(nb_b) :: B_Rext ! external radii of the subdivisions of the B ring 
+    REAL, DIMENSION(nb_c) :: C_Rint ! internal radii of the subdivisions of the C ring
+    REAL, DIMENSION(nb_c) :: C_Rext ! external radii of the subdivisions of the C ring 
+    REAL, DIMENSION(nb_ca) :: Ca_Rint ! internal radii of the subdivisions of the Cassini Division
+    REAL, DIMENSION(nb_ca) :: Ca_Rext ! external radii of the subdivisions of the Cassini Division
+
+    ! Opacities of the rings : for each one we can give different opacities for each part
+    REAL, DIMENSION(nb_a) :: tau_A ! opacity of the A ring
+    REAL, DIMENSION(nb_b) :: tau_B ! opacity of the B ring
+    REAL, DIMENSION(nb_c) :: tau_C ! opacity of the C ring
+    REAL, DIMENSION(nb_ca) :: tau_Ca ! opacity of the Cassini Division 
+
+    ! Parameters used to calculate if a point is under a ring subdivision's shadow
+    REAL :: phi_S                             ! subsolar point longitude
+    REAL, PARAMETER :: pi=acos(-1.0)    
+    REAL, DIMENSION(:), ALLOCATABLE:: x, y, z ! cartesian coordinates of the points on the planet
+    REAL :: xs, ys, zs                        ! cartesian coordinates of the points of the subsolar point
+    REAL, DIMENSION(:), ALLOCATABLE :: k
+    REAL, DIMENSION(:), ALLOCATABLE :: N      ! parameter to compute cartesian coordinates on a ellipsoidal planet
+    REAL, DIMENSION(:), ALLOCATABLE :: r      ! distance at which the incident ray of sun crosses the equatorial plane
+                                              ! measured from the center of the planet   
+    REAL :: Ns                                ! (same for the subsolar point)
+   
+    ! equinox --> no shadow (AS: why is this needed?)
+    if(declin .eq. 0.) then
+        eclipse(:) = 0.
+        return 
+    endif 
+
+! 1) INITIALIZATION
+
+    ! Generic
+    rpol = (1.- flat)*rad
+    e = sqrt(2*flat - flat**2)
+    ALLOCATE(x(ngrid))
+    ALLOCATE(y(ngrid))
+    ALLOCATE(z(ngrid))
+    ALLOCATE(k(ngrid))
+    ALLOCATE(N(ngrid))
+    ALLOCATE(r(ngrid))
+    eclipse(:) = 2000.
+
+! Model of the rings with Cassini/UVIS opacities
+
+    ! Size of the rings
+    A_Rint(1) = 2.03*rad
+    A_Rext(1) = 2.06*rad
+    A_Rint(2) = 2.06*rad
+    A_Rext(2) = 2.09*rad
+    A_Rint(3) = 2.09*rad
+    A_Rext(3) = 2.12*rad
+    A_Rint(4) = 2.12*rad
+    A_Rext(4) = 2.27*rad
+
+    B_Rint(1) = 1.53*rad
+    B_Rext(1) = 1.64*rad
+    B_Rint(2) = 1.64*rad
+    B_Rext(2) = 1.83*rad
+    B_Rint(3) = 1.83*rad
+    B_Rext(3) = 1.95*rad
+    
+    C_Rint(1) = 1.24*rad
+    C_Rext(1) = 1.29*rad
+    C_Rint(2) = 1.29*rad
+    C_Rext(2) = 1.43*rad
+    C_Rint(3) = 1.43*rad
+    C_Rext(3) = 1.53*rad
+
+    Ca_Rint(1) = 1.95*rad
+    Ca_Rext(1) = 1.99*rad
+    Ca_Rint(2) = 1.99*rad
+    Ca_Rext(2) = 2.03*rad
+
+
+    ! Opacities of the rings
+    tau_A(1) = 1.24
+    tau_A(2) = 0.81
+    tau_A(3) = 0.67
+    tau_A(4) = 0.58
+                
+    tau_B(1) = 1.29
+    tau_B(2) = 5.13 
+    tau_B(3) = 2.84 
+    
+    tau_C(1) = 0.06
+    tau_C(2) = 0.10
+    tau_C(3) = 0.14
+
+    tau_Ca(1) = 0.06
+    tau_Ca(2) = 0.24
+
+    ! Convert to cartesian coordinates
+    N(:) = rad / sqrt(1-(e**2)*sinlat(:)**2)
+    x(:) = N(:)*coslat(:)*coslon(:)
+    y(:) = N(:)*coslat(:)*sinlon(:)
+    z(:) = N(:)*(1-e**2)*sinlat(:)
+
+! 2) LOCATION OF THE SUBSOLAR POINT 
+ 
+    ! subsolar longitude is deduced from time fraction ptime
+    ! SG: the minus sign is important! ... otherwise subsolar point adopts a reverse rotation
+    phi_S = -(ptime - 0.5)*2.*pi 
+!    write(*,*) 'subsol point coords : ', declin*180./pi, phi_S*180./pi
+
+    ! subsolar latitude is declin (declination of the sun)
+    ! now convert in cartesian coordinates : 
+    Ns = rad/sqrt(1-(e**2)*sin(declin)**2)
+    xs = Ns*cos(declin)*cos(phi_S)
+    ys = Ns*cos(declin)*sin(phi_S)
+    zs = Ns*(1-e**2)*sin(declin)
+
+! 3) WHERE DOES THE INCIDENT RAY OF SUN CROSS THE EQUATORIAL PLAN ?
+
+    k(:) = -z(:)/zs
+    r(:) = (k(:)*xs + x(:))**2 + (k(:)*ys + y(:))**2 
+    r(:) = sqrt(r(:))
+
+! 4) SO WHERE ARE THE SHADOW OF THESE RINGS ?
+
+    ! Summer hemisphere is not under the shadow of the rings
+    where(lati(:)*declin .gt. 0.)
+       eclipse(:) = 1000.
+    end where
+
+    ! No shadow of the rings by night
+    where(x(:)*xs + y(:)*ys + z(:)*zs .lt. 0.)
+       eclipse(:) = 1000.
+    end where
+
+    ! if the incident rays of sun cross a ring, there is a shadow
+    do i=1, nb_A 
+        where(r(:) .ge. A_Rint(i) .and. r(:) .le. A_Rext(i) .and. eclipse(:) .ne. 1000.)
+            eclipse(:) = 1. - exp(-tau_A(i)/abs(sin(declin)))
+        end where
+    end do 
+
+    do i=1, nb_B 
+        where(r(:) .ge. B_Rint(i) .and. r(:) .le. B_Rext(i) .and. eclipse(:) .ne. 1000.)
+            eclipse(:) = 1. - exp(-tau_B(i)/abs(sin(declin)))
+        end where
+    enddo
+    
+    do i=1, nb_C 
+        where(r(:) .ge. C_Rint(i) .and. r(:) .le. C_Rext(i) .and. eclipse(:) .ne. 1000.)
+            eclipse(:) = 1. - exp(-tau_C(i)/abs(sin(declin)))
+        end where
+    enddo
+
+    do i=1, nb_ca
+        where(r(:) .ge. Ca_Rint(i) .and. r(:) .le. Ca_Rext(i) .and. eclipse(:) .ne. 1000.)
+            eclipse(:) = 1. - exp(-tau_Ca(i)/abs(sin(declin)))
+        end where
+    enddo
+
+    ! At the other places and the excluded ones, eclipse is 0. 
+    where(eclipse(:) .eq. 2000. .or. eclipse(:) .eq. 1000.)
+        eclipse(:) = 0. 
+    end where 
+
+! 5) CLEAN THE PLACE
+    DEALLOCATE(x)
+    DEALLOCATE(y)
+    DEALLOCATE(z)
+    DEALLOCATE(k)
+    DEALLOCATE(N)
+    DEALLOCATE(r)
+
+END SUBROUTINE rings
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/scatterers.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/scatterers.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/scatterers.h	(revision 222)
@@ -0,0 +1,11 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'scatterers.h'
+!
+! Number of radiatively active species 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!-----------------------------------------------------------------------
+
+      integer, parameter :: naerkind=1
+
+!-----------------------------------------------------------------------
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/scopyi.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/scopyi.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/scopyi.F	(revision 222)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/setspi.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/setspi.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/setspi.F90	(revision 222)
@@ -0,0 +1,214 @@
+      subroutine setspi
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Set up spectral intervals and Planck function in the longwave.
+!     
+!     Authors
+!     ------- 
+!     Adapted from setspi in the NASA Ames radiative code by
+!     Robin Wordsworth (2009).
+!     
+!     Called by
+!     ---------
+!     callcorrk.F
+!     
+!     Calls
+!     -----
+!     none
+!     
+!==================================================================
+
+      use radinc_h,    only: L_NSPECTI,corrkdir,banddir,NTstar,NTstop,NTfac
+      use radcommon_h, only: BWNI,BLAMI,WNOI,DWNI,WAVEI,planckir,sigma
+      use datafile_mod, only: datadir
+
+      implicit none
+
+#include "callkeys.h"
+#include "comcstfi.h"
+
+      logical file_ok
+      integer nw, nt, m, mm, file_entries
+      real*8 a, b, ans, y, bpa, bma, T, dummy
+
+      character(len=30)  :: temp1
+      character(len=200) :: file_id
+      character(len=200) :: file_path
+
+!     C1 and C2 values from Goody and Yung (2nd edition)  MKS units
+!     These values lead to a "sigma" (sigma*T^4) of 5.67032E-8 W m^-2 K^-4
+
+      real*8 :: c1 = 3.741832D-16 ! W m^-2
+      real*8 :: c2 = 1.438786D-2  ! m K
+      
+      real*8 :: lastband(2), plancksum
+
+      !! used to count lines
+      integer :: nb
+      integer :: ierr
+
+      logical forceEC, planckcheck
+
+      real*8 :: x(12) = [ -0.981560634246719D0,  -0.904117256370475D0, &
+      -0.769902674194305D0,  -0.587317954286617D0,                     &
+      -0.367831498998180D0,  -0.125233408511469D0,                     &
+       0.125233408511469D0,   0.367831498998180D0,                     &
+       0.587317954286617D0,   0.769902674194305D0,                     &
+       0.904117256370475D0,   0.981560634246719D0  ]
+
+      real*8 :: w(12) = [  0.047175336386512D0,   0.106939325995318D0, &
+           0.160078328543346D0,   0.203167426723066D0,                 &
+           0.233492536538355D0,   0.249147045813403D0,                 &
+           0.249147045813403D0,   0.233492536538355D0,                 &
+           0.203167426723066D0,   0.160078328543346D0,                 &
+           0.106939325995318D0,   0.047175336386512D0  ]
+      mm=0
+
+      forceEC=.true.
+      planckcheck=.true.
+
+!=======================================================================
+!     Set up spectral bands - wavenumber [cm^(-1)]. Go from smaller to
+!     larger wavenumbers.
+
+      write(temp1,'(i2.2)') L_NSPECTI
+      !file_id='/corrk_data/' // corrkdir(1:LEN_TRIM(corrkdir)) // '/narrowbands_IR.in'
+      file_id='/corrk_data/'//trim(adjustl(banddir))//'/narrowbands_IR.in' 
+      file_path=TRIM(datadir)//TRIM(file_id)
+
+      ! check that the file exists
+      inquire(FILE=file_path,EXIST=file_ok)
+      if(.not.file_ok) then
+         write(*,*)'The file ',TRIM(file_path)
+         write(*,*)'was not found by setspi.F90, exiting.'
+         write(*,*)'Check that your path to datagcm:',trim(datadir)
+         write(*,*)' is correct. You can change it in callphys.def with:'
+         write(*,*)' datadir = /absolute/path/to/datagcm'
+         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
+         call abort
+      endif
+    
+      nb=0
+      ierr=0
+      ! check that the file contains the right number of bands 
+      open(131,file=file_path,form='formatted')
+      read(131,*,iostat=ierr) file_entries
+      do while (ierr==0)
+        read(131,*,iostat=ierr) dummy
+!        write(*,*) 'setspi: file_entries:',dummy,'ierr=',ierr
+        if (ierr==0) nb=nb+1
+      enddo
+      close(131)
+
+      write(*,*) 'setspi: L_NSPECTI = ',L_NSPECTI, 'in the model '
+      write(*,*) '        there are   ',nb, 'entries in ',TRIM(file_path)
+      if(nb.ne.L_NSPECTI) then
+         write(*,*) 'MISMATCH !! I stop here'
+         call abort
+      endif
+
+      ! load and display the data
+      open(111,file=file_path,form='formatted')
+      read(111,*) 
+      do M=1,L_NSPECTI-1
+         read(111,*) BWNI(M)
+      end do
+      read(111,*) lastband
+      close(111)
+      BWNI(L_NSPECTI)  =lastband(1)
+      BWNI(L_NSPECTI+1)=lastband(2)
+
+      print*,''
+      print*,'setspi: IR band limits:'
+      do M=1,L_NSPECTI+1
+         print*,m,'-->',BWNI(M),' cm^-1'
+      end do
+
+!     Set up mean wavenumbers and wavenumber deltas.  Units of 
+!     wavenumbers is cm^(-1); units of wavelengths is microns.
+
+      do M=1,L_NSPECTI
+         WNOI(M)  = 0.5D0*(BWNI(M+1)+BWNI(M))
+         DWNI(M)  = BWNI(M+1)-BWNI(M)
+         WAVEI(M) = 1.0D+4/WNOI(M)
+         BLAMI(M) = 0.01D0/BWNI(M)         
+      end do
+      BLAMI(M) = 0.01D0/BWNI(M)
+!     note M=L_NSPECTI+1 after loop due to Fortran bizarreness
+
+!=======================================================================
+!     For each IR wavelength interval, compute the integral of B(T), the
+!     Planck function, divided by the wavelength interval, in cm-1.  The
+!     integration is in MKS units, the final answer is the same as the
+!     original planck.f; W m^-2 wavenumber^-1, where wavenumber is in CM^-1.
+
+      print*,''
+      print*,'setspi: Current Planck integration range:'
+      print*,'T = ',dble(NTstar)/NTfac, ' to ',dble(NTstop)/NTfac,' K.'
+
+      do NW=1,L_NSPECTI
+         a = 1.0D-2/BWNI(NW+1)
+         b = 1.0D-2/BWNI(NW)
+         bpa = (b+a)/2.0D0
+         bma = (b-a)/2.0D0
+         do nt=NTstar,NTstop
+            T   = dble(NT)/NTfac
+            ans = 0.0D0
+
+            do mm=1,12
+               y    = bma*x(mm)+bpa
+               ans  = ans + w(mm)*c1/(y**5*(exp(c2/(y*T))-1.0D0))
+            end do
+
+            planckir(NW,nt-NTstar+1) = ans*bma/(PI*DWNI(NW))
+         end do
+      end do
+         
+      ! force planck=sigma*eps*T^4 for each temperature in array
+      if(forceEC)then
+         print*,'setspi: Force F=sigma*eps*T^4 for all values of T!'
+         do nt=NTstar,NTstop
+            plancksum=0.0D0
+            T=dble(NT)/NTfac
+       
+            do NW=1,L_NSPECTI
+               plancksum=plancksum+  &
+                  planckir(NW,nt-NTstar+1)*DWNI(NW)*pi
+            end do
+
+            do NW=1,L_NSPECTI
+               planckir(NW,nt-NTstar+1)=     &
+                  planckir(NW,nt-NTstar+1)*  &
+                          sigma*(dble(nt)/NTfac)**4/plancksum
+            end do
+         end do
+      endif
+
+      if(planckcheck)then
+         ! check energy conservation at lower temperature boundary
+         plancksum=0.0D0
+         nt=NTstar
+         do NW=1,L_NSPECTI
+            plancksum=plancksum+planckir(NW,nt-NTstar+1)*DWNI(NW)*pi
+         end do
+         print*,'setspi: At lower limit:'
+         print*,'in model sig*T^4 = ',plancksum,' W m^-2'
+         print*,'actual sig*T^4   = ',sigma*(dble(nt)/NTfac)**4,' W m^-2'
+         
+         ! check energy conservation at upper temperature boundary
+         plancksum=0.0D0
+         nt=NTstop
+         do NW=1,L_NSPECTI
+            plancksum=plancksum+planckir(NW,nt-NTstar+1)*DWNI(NW)*pi
+         end do
+         print*,'setspi: At upper limit:'
+         print*,'in model sig*T^4 = ',plancksum,' W m^-2'
+         print*,'actual sig*T^4   = ',sigma*(dble(nt)/NTfac)**4,' W m^-2'
+         print*,''
+      endif
+
+      return
+    end subroutine setspi
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/setspv.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/setspv.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/setspv.F90	(revision 222)
@@ -0,0 +1,151 @@
+      subroutine setspv
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Set up spectral intervals, stellar spectrum and Rayleigh 
+!     opacity in the shortwave. 
+!     
+!     Authors
+!     ------- 
+!     Adapted from setspv in the NASA Ames radiative code by
+!     Robin Wordsworth (2009).
+!
+!     Called by
+!     ---------
+!     callcorrk.F
+!     
+!     Calls
+!     -----
+!     ave_stelspec.F
+!     
+!==================================================================
+
+      use radinc_h,    only: L_NSPECTV, corrkdir, banddir
+      use radcommon_h, only: BWNV,BLAMV,WNOV,DWNV,WAVEV, &
+                             STELLARF,TAURAY
+      use datafile_mod, only: datadir
+
+      implicit none
+
+#include "comcstfi.h"
+#include "callkeys.h"
+
+      logical file_ok
+
+      integer N, M, file_entries
+
+      character(len=30)  :: temp1
+      character(len=200) :: file_id
+      character(len=200) :: file_path
+
+      real*8 :: lastband(2)
+
+      real*8 STELLAR(L_NSPECTV)
+      real*8 sum, dummy
+
+      !! used to count lines
+      integer :: nb
+      integer :: ierr
+
+!=======================================================================
+!     Set up spectral bands - wavenumber [cm^(-1)]. Go from smaller to
+!     larger wavenumbers, the same as in the IR.
+
+      write(temp1,'(i2.2)') L_NSPECTV
+      file_id='/corrk_data/'//trim(adjustl(banddir))//'/narrowbands_VI.in' 
+      file_path=TRIM(datadir)//TRIM(file_id)
+
+      ! check that the file exists
+      inquire(FILE=file_path,EXIST=file_ok)
+      if(.not.file_ok) then
+         write(*,*)'The file ',TRIM(file_path)
+         write(*,*)'was not found by setspv.F90, exiting.'
+         write(*,*)'Check that your path to datagcm:',trim(datadir)
+         write(*,*)' is correct. You can change it in callphys.def with:'
+         write(*,*)' datadir = /absolute/path/to/datagcm'
+         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
+         call abort
+      endif
+    
+      nb=0
+      ierr=0
+      ! check that the file contains the right number of bands 
+      open(131,file=file_path,form='formatted')
+      read(131,*,iostat=ierr) file_entries
+      do while (ierr==0)
+        read(131,*,iostat=ierr) dummy
+        if (ierr==0) nb=nb+1
+      enddo
+      close(131)
+
+      write(*,*) 'setspv: L_NSPECTV = ',L_NSPECTV, 'in the model '
+      write(*,*) '        there are   ',nb, 'entries in ',TRIM(file_path)
+      if(nb.ne.L_NSPECTV) then
+         write(*,*) 'MISMATCH !! I stop here'
+         call abort
+      endif
+
+      ! load and display the data
+      open(111,file=file_path,form='formatted')
+      read(111,*) 
+       do M=1,L_NSPECTV-1
+         read(111,*) BWNV(M)
+      end do
+      read(111,*) lastband
+      close(111)
+      BWNV(L_NSPECTV)  =lastband(1)
+      BWNV(L_NSPECTV+1)=lastband(2)
+
+
+      print*,'setspv: VI band limits:'
+      do M=1,L_NSPECTV+1
+         print*,m,'-->',BWNV(M),' cm^-1'
+      end do
+      print*,' '
+
+!     Set up mean wavenumbers and wavenumber deltas.  Units of 
+!     wavenumbers is cm^(-1); units of wavelengths is microns.
+
+      do M=1,L_NSPECTV
+         WNOV(M)  = 0.5*(BWNV(M+1)+BWNV(M))
+         DWNV(M)  = BWNV(M+1)-BWNV(M)
+         WAVEV(M) = 1.0E+4/WNOV(M)
+         BLAMV(M) = 0.01/BWNV(M)
+      end do
+      BLAMV(M) = 0.01/BWNV(M) ! wavelength in METERS for aerosol stuff
+!     note M=L_NSPECTV+1 after loop due to Fortran bizarreness
+
+!=======================================================================
+!     Set up stellar spectrum
+
+      write(*,*)'setspv: Interpolating stellar spectrum from the hires data...'
+      call ave_stelspec(STELLAR)
+
+!     Sum the stellar flux, and write out the result.  
+      sum = 0.0  
+      do N=1,L_NSPECTV
+         STELLARF(N) = STELLAR(N) * Fat1AU
+         sum         = sum+STELLARF(N)
+      end do
+      write(6,'("setspv: Stellar flux at 1 AU = ",f7.2," W m-2")') sum
+      print*,' '
+
+
+!=======================================================================
+!     Set up the wavelength independent part of the Rayleigh scattering.
+!     The pressure dependent part will be computed elsewhere (OPTCV).
+!     WAVEV is in microns.  There is no Rayleigh scattering in the IR.
+
+      if(rayleigh) then
+         call calc_rayleigh
+      else
+         print*,'setspv: No Rayleigh scattering, check for NaN in output!'
+         do N=1,L_NSPECTV
+            TAURAY(N) = 1E-16
+         end do
+      endif
+
+      RETURN
+    END subroutine setspv
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sfluxi.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sfluxi.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sfluxi.F	(revision 222)
@@ -0,0 +1,202 @@
+      SUBROUTINE SFLUXI(PLEV,TLEV,DTAUI,TAUCUMI,UBARI,RSFI,WNOI,DWNI,
+     *                  COSBI,WBARI,GWEIGHT,NFLUXTOPI,NFLUXTOPI_nu,
+     *                  FMNETI,fluxupi,fluxdni,fluxupi_nu,
+     *                  FZEROI,TAUGSURF)
+
+      use radinc_h
+      use radcommon_h, only: planckir, tlimit,sigma
+
+      implicit none
+
+#include "comcstfi.h"
+
+      integer NLEVRAD, L, NW, NG, NTS, NTT
+
+      real*8 TLEV(L_LEVELS), PLEV(L_LEVELS)
+      real*8 TAUCUMI(L_LEVELS,L_NSPECTI,L_NGAUSS)
+      real*8 FMNETI(L_NLAYRAD)
+      real*8 WNOI(L_NSPECTI), DWNI(L_NSPECTI)
+      real*8 DTAUI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+      real*8 FMUPI(L_NLEVRAD), FMDI(L_NLEVRAD)
+      real*8 COSBI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+      real*8 WBARI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
+      real*8 GWEIGHT(L_NGAUSS), NFLUXTOPI
+      real*8 NFLUXTOPI_nu(L_NSPECTI)
+      real*8 fluxupi_nu(L_NLAYRAD,L_NSPECTI)
+      real*8 FTOPUP
+
+      real*8 UBARI, RSFI, TSURF, BSURF, TTOP, BTOP, TAUTOP
+      real*8 PLANCK, PLTOP
+      real*8 fluxupi(L_NLAYRAD), fluxdni(L_NLAYRAD)
+      real*8 FZEROI(L_NSPECTI)
+      real*8 taugsurf(L_NSPECTI,L_NGAUSS-1), fzero
+
+      real*8 fup_tmp(L_NSPECTI),fdn_tmp(L_NSPECTI)
+      real*8 PLANCKSUM,PLANCKREF
+
+
+C======================================================================C
+ 
+      NLEVRAD = L_NLEVRAD
+ 
+
+C     ZERO THE NET FLUXES
+    
+      NFLUXTOPI = 0.0D0
+
+      DO NW=1,L_NSPECTI
+        NFLUXTOPI_nu(NW) = 0.0D0
+        DO L=1,L_NLAYRAD
+           FLUXUPI_nu(L,NW) = 0.0D0
+
+              fup_tmp(nw)=0.0D0
+              fdn_tmp(nw)=0.0D0
+
+        END DO
+      END DO
+
+      DO L=1,L_NLAYRAD
+        FMNETI(L)  = 0.0D0
+        FLUXUPI(L) = 0.0D0
+        FLUXDNI(L) = 0.0D0
+      END DO
+ 
+C     WE NOW ENTER A MAJOR LOOP OVER SPECTRAL INTERVALS IN THE INFRARED
+C     TO CALCULATE THE NET FLUX IN EACH SPECTRAL INTERVAL
+
+      TTOP  = TLEV(2)  ! JL12 why not (1) ???
+      TSURF = TLEV(L_LEVELS)
+
+      NTS   = int(TSURF*NTfac)-NTstar+1
+      NTT   = int(TTOP *NTfac)-NTstar+1
+
+!JL12 corrects the surface planck function so that its integral is equal to sigma Tsurf^4
+!JL12   this ensure that no flux is lost due to:
+!JL12          -truncation of the planck function at high/low wavenumber
+!JL12          -numerical error during first spectral integration
+!JL12          -discrepancy between Tsurf and NTS/NTfac
+      PLANCKSUM=0.d0
+      PLANCKREF=TSURF*TSURF
+      PLANCKREF=sigma*PLANCKREF*PLANCKREF
+      DO NW=1,L_NSPECTI
+         PLANCKSUM=PLANCKSUM+PLANCKIR(NW,NTS)*DWNI(NW)
+      ENDDO
+      PLANCKSUM=PLANCKREF/(PLANCKSUM*Pi)
+!JL12
+
+      DO 501 NW=1,L_NSPECTI
+
+C       SURFACE EMISSIONS - INDEPENDENT OF GAUSS POINTS
+        BSURF = (1.-RSFI)*PLANCKIR(NW,NTS)*PLANCKSUM !JL12 plancksum see above
+        PLTOP = PLANCKIR(NW,NTT)
+
+C  If FZEROI(NW) = 1, then the k-coefficients are zero - skip to the
+C  special Gauss point at the end.
+ 
+        FZERO = FZEROI(NW)
+        IF(FZERO.ge.0.99) goto 40
+ 
+        DO NG=1,L_NGAUSS-1
+         
+          if(TAUGSURF(NW,NG).lt. TLIMIT) then
+            fzero = fzero + (1.0D0-FZEROI(NW))*GWEIGHT(NG)
+            goto 30
+          end if
+
+C         SET UP THE UPPER AND LOWER BOUNDARY CONDITIONS ON THE IR
+C         CALCULATE THE DOWNWELLING RADIATION AT THE TOP OF THE MODEL
+C         OR THE TOP LAYER WILL COOL TO SPACE UNPHYSICALLY
+ 
+!          TAUTOP = DTAUI(1,NW,NG)*PLEV(2)/(PLEV(4)-PLEV(2))
+          TAUTOP = TAUCUMI(2,NW,NG)
+          BTOP   = (1.0D0-EXP(-TAUTOP/UBARI))*PLTOP
+ 
+C         WE CAN NOW SOLVE FOR THE COEFFICIENTS OF THE TWO STREAM
+C         CALL A SUBROUTINE THAT SOLVES  FOR THE FLUX TERMS
+C         WITHIN EACH INTERVAL AT THE MIDPOINT WAVENUMBER 
+          
+          CALL GFLUXI(NLEVRAD,TLEV,NW,DWNI(NW),DTAUI(1,NW,NG),
+     *                TAUCUMI(1,NW,NG),
+     *                WBARI(1,NW,NG),COSBI(1,NW,NG),UBARI,RSFI,BTOP,
+     *                BSURF,FTOPUP,FMUPI,FMDI)
+
+
+
+C         NOW CALCULATE THE CUMULATIVE IR NET FLUX
+
+          NFLUXTOPI = NFLUXTOPI+FTOPUP*DWNI(NW)*GWEIGHT(NG)*
+     *                           (1.0D0-FZEROI(NW))
+
+c         and same thing by spectral band... (RDW)
+          NFLUXTOPI_nu(NW) = NFLUXTOPI_nu(NW)
+     *      +FTOPUP*DWNI(NW)*GWEIGHT(NG)*(1.0D0-FZEROI(NW))
+
+
+          DO L=1,L_NLEVRAD-1
+
+C           CORRECT FOR THE WAVENUMBER INTERVALS
+
+            FMNETI(L)  = FMNETI(L)+(FMUPI(L)-FMDI(L))*DWNI(NW)*
+     *                              GWEIGHT(NG)*(1.0D0-FZEROI(NW))
+            FLUXUPI(L) = FLUXUPI(L) + FMUPI(L)*DWNI(NW)*GWEIGHT(NG)*
+     *                                (1.0D0-FZEROI(NW))
+            FLUXDNI(L) = FLUXDNI(L) + FMDI(L)*DWNI(NW)*GWEIGHT(NG)*
+     *                                (1.0D0-FZEROI(NW))
+
+c         and same thing by spectral band... (RW)
+            FLUXUPI_nu(L,NW) = FLUXUPI_nu(L,NW) + 
+     *                FMUPI(L)*DWNI(NW)*GWEIGHT(NG)*(1.0D0-FZEROI(NW))
+
+          END DO
+
+   30     CONTINUE
+
+       END DO       !End NGAUSS LOOP
+
+   40  CONTINUE
+
+C      SPECIAL 17th Gauss point
+
+       NG     = L_NGAUSS
+
+!       TAUTOP = DTAUI(1,NW,NG)*PLEV(2)/(PLEV(4)-PLEV(2))
+       TAUTOP = TAUCUMI(2,NW,NG)
+       BTOP   = (1.0D0-EXP(-TAUTOP/UBARI))*PLTOP
+
+C      WE CAN NOW SOLVE FOR THE COEFFICIENTS OF THE TWO STREAM
+C      CALL A SUBROUTINE THAT SOLVES  FOR THE FLUX TERMS
+C      WITHIN EACH INTERVAL AT THE MIDPOINT WAVENUMBER 
+
+
+       CALL GFLUXI(NLEVRAD,TLEV,NW,DWNI(NW),DTAUI(1,NW,NG),
+     *                TAUCUMI(1,NW,NG),
+     *                WBARI(1,NW,NG),COSBI(1,NW,NG),UBARI,RSFI,BTOP,
+     *                BSURF,FTOPUP,FMUPI,FMDI)
+ 
+C      NOW CALCULATE THE CUMULATIVE IR NET FLUX
+
+       NFLUXTOPI = NFLUXTOPI+FTOPUP*DWNI(NW)*FZERO
+
+c         and same thing by spectral band... (RW)
+          NFLUXTOPI_nu(NW) = NFLUXTOPI_nu(NW)
+     *      +FTOPUP*DWNI(NW)*FZERO
+
+       DO L=1,L_NLEVRAD-1
+
+C        CORRECT FOR THE WAVENUMBER INTERVALS
+
+         FMNETI(L)  = FMNETI(L)+(FMUPI(L)-FMDI(L))*DWNI(NW)*FZERO
+         FLUXUPI(L) = FLUXUPI(L) + FMUPI(L)*DWNI(NW)*FZERO
+         FLUXDNI(L) = FLUXDNI(L) + FMDI(L)*DWNI(NW)*FZERO
+
+c         and same thing by spectral band... (RW)
+         FLUXUPI_nu(L,NW) = FLUXUPI_nu(L,NW) + FMUPI(L)*DWNI(NW)*FZERO
+
+       END DO
+
+  501 CONTINUE      !End Spectral Interval LOOP
+
+C *** END OF MAJOR SPECTRAL INTERVAL LOOP IN THE INFRARED****
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sfluxv.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sfluxv.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sfluxv.F	(revision 222)
@@ -0,0 +1,188 @@
+      SUBROUTINE SFLUXV(DTAUV,TAUV,TAUCUMV,RSFV,DWNV,WBARV,COSBV,
+     *                  UBAR0,STEL,GWEIGHT,NFLUXTOPV,FLUXTOPVDN,
+     *                  NFLUXOUTV_nu,NFLUXGNDV_nu,
+     *                  FMNETV,FLUXUPV,FLUXDNV,FZEROV,taugsurf)
+
+      use radinc_h
+      use radcommon_h, only: tlimit
+
+      implicit none
+
+      real*8 FMNETV(L_NLAYRAD)
+      real*8 TAUCUMV(L_LEVELS,L_NSPECTV,L_NGAUSS)
+      real*8 TAUV(L_NLEVRAD,L_NSPECTV,L_NGAUSS)
+      real*8 DTAUV(L_NLAYRAD,L_NSPECTV,L_NGAUSS), DWNV(L_NSPECTV)
+      real*8 FMUPV(L_NLAYRAD), FMDV(L_NLAYRAD)
+      real*8 COSBV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+      real*8 WBARV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
+      real*8 STEL(L_NSPECTV)
+      real*8 FLUXUPV(L_NLAYRAD), FLUXDNV(L_NLAYRAD)
+      real*8 NFLUXTOPV, FLUXUP, FLUXDN,FLUXTOPVDN
+      real*8 NFLUXOUTV_nu(L_NSPECTV)
+      real*8 NFLUXGNDV_nu(L_NSPECTV)
+      real*8 GWEIGHT(L_NGAUSS)
+
+      integer L, NG, NW, NG1,k
+      real*8  rsfv, ubar0, f0pi, btop, bsurf, taumax, eterm
+      real*8 FZEROV(L_NSPECTV)
+
+      real*8 DIFFV, DIFFVT
+      real*8 taugsurf(L_NSPECTV,L_NGAUSS-1), fzero
+
+C======================================================================C
+
+      TAUMAX = L_TAUMAX
+
+C     ZERO THE NET FLUXES
+
+      NFLUXTOPV = 0.0
+      FLUXTOPVDN = 0.0
+
+      DO NW=1,L_NSPECTV
+         NFLUXOUTV_nu(NW)=0.0
+         NFLUXGNDV_nu(NW)=0.0
+      END DO
+
+      DO L=1,L_NLAYRAD
+        FMNETV(L)  = 0.0
+        FLUXUPV(L) = 0.0
+        FLUXDNV(L) = 0.0
+      END DO
+
+      DIFFVT = 0.0
+
+C     WE NOW ENTER A MAJOR LOOP OVER SPECTRAL INTERVALS IN THE VISIBLE
+C     TO CALCULATE THE NET FLUX IN EACH SPECTRAL INTERVAL
+
+      DO 500 NW=1,L_NSPECTV
+      
+        F0PI = STEL(NW)
+
+        FZERO = FZEROV(NW)
+        IF(FZERO.ge.0.99) goto 40
+        DO NG=1,L_NGAUSS-1
+
+          if(TAUGSURF(NW,NG) .lt. TLIMIT) then
+
+            fzero = fzero + (1.0-FZEROV(NW))*GWEIGHT(NG)
+
+            goto 30
+          end if
+
+C         SET UP THE UPPER AND LOWER BOUNDARY CONDITIONS ON THE VISIBLE
+
+          BTOP  = 0.0
+          !BSURF = 0./0. ! why was this here?
+          BSURF = 0.
+C         LOOP OVER THE NTERMS BEGINNING HERE
+ 
+
+!      FACTOR    = 1.0D0 - WDEL(1)*CDEL(1)**2
+!      TAU(1)    = TDEL(1)*FACTOR
+
+
+          ETERM = MIN(TAUV(L_NLEVRAD,NW,NG),TAUMAX)
+          BSURF = RSFV*UBAR0*STEL(NW)*EXP(-ETERM/UBAR0)
+
+C         WE CAN NOW SOLVE FOR THE COEFFICIENTS OF THE TWO STREAM
+C         CALL A SUBROUTINE THAT SOLVES  FOR THE FLUX TERMS
+C         WITHIN EACH INTERVAL AT THE MIDPOINT WAVENUMBER
+C 
+C         FUW AND FDW ARE WORKING FLUX ARRAYS THAT WILL BE USED TO 
+C         RETURN FLUXES FOR A GIVEN NT
+
+
+          CALL GFLUXV(DTAUV(1,NW,NG),TAUV(1,NW,NG),TAUCUMV(1,NW,NG),
+     *                WBARV(1,NW,NG),COSBV(1,NW,NG),UBAR0,F0PI,RSFV,
+     *                BTOP,BSURF,FMUPV,FMDV,DIFFV,FLUXUP,FLUXDN)
+
+C         NOW CALCULATE THE CUMULATIVE VISIBLE NET FLUX 
+
+          NFLUXTOPV = NFLUXTOPV+(FLUXUP-FLUXDN)*GWEIGHT(NG)*
+     *                          (1.0-FZEROV(NW))
+          FLUXTOPVDN = FLUXTOPVDN+FLUXDN*GWEIGHT(NG)*
+     *                          (1.0-FZEROV(NW))
+          DO L=1,L_NLAYRAD
+            FMNETV(L)=FMNETV(L)+( FMUPV(L)-FMDV(L) )*
+     *                           GWEIGHT(NG)*(1.0-FZEROV(NW))
+            FLUXUPV(L) = FLUXUPV(L) + FMUPV(L)*GWEIGHT(NG)*
+     *                   (1.0-FZEROV(NW))
+            FLUXDNV(L) = FLUXDNV(L) + FMDV(L)*GWEIGHT(NG)*
+     *                   (1.0-FZEROV(NW))
+          END DO
+
+c     band-resolved flux leaving TOA (RDW)
+          NFLUXOUTV_nu(NW) = NFLUXOUTV_nu(NW)
+     *      +FLUXUP*GWEIGHT(NG)*(1.0-FZEROV(NW))
+
+c     band-resolved flux at ground (RDW)
+          NFLUXGNDV_nu(NW) = NFLUXGNDV_nu(NW)
+     *      +FMDV(L_NLAYRAD)*GWEIGHT(NG)*(1.0-FZEROV(NW))
+
+
+C         THE DIFFUSE COMPONENT OF THE DOWNWARD STELLAR FLUX
+
+          DIFFVT = DIFFVT + DIFFV*GWEIGHT(NG)*(1.0-FZEROV(NW))
+
+   30     CONTINUE 
+
+        END DO   ! the Gauss loop 
+
+   40   continue 
+C       Special 17th Gauss point
+
+        NG = L_NGAUSS
+
+C       SET UP THE UPPER AND LOWER BOUNDARY CONDITIONS ON THE VISIBLE
+ 
+        BTOP = 0.0
+
+C       LOOP OVER THE NTERMS BEGINNING HERE
+ 
+        ETERM = MIN(TAUV(L_NLEVRAD,NW,NG),TAUMAX)
+        BSURF = RSFV*UBAR0*STEL(NW)*EXP(-ETERM/UBAR0)
+
+
+C       WE CAN NOW SOLVE FOR THE COEFFICIENTS OF THE TWO STREAM
+C       CALL A SUBROUTINE THAT SOLVES  FOR THE FLUX TERMS
+C       WITHIN EACH INTERVAL AT THE MIDPOINT WAVENUMBER
+C 
+C       FUW AND FDW ARE WORKING FLUX ARRAYS THAT WILL BE USED TO 
+C       RETURN FLUXES FOR A GIVEN NT
+
+        CALL GFLUXV(DTAUV(1,NW,NG),TAUV(1,NW,NG),TAUCUMV(1,NW,NG),
+     *              WBARV(1,NW,NG),COSBV(1,NW,NG),UBAR0,F0PI,RSFV,
+     *              BTOP,BSURF,FMUPV,FMDV,DIFFV,FLUXUP,FLUXDN)
+
+
+C       NOW CALCULATE THE CUMULATIVE VISIBLE NET FLUX 
+
+        NFLUXTOPV = NFLUXTOPV+(FLUXUP-FLUXDN)*FZERO
+        FLUXTOPVDN = FLUXTOPVDN+FLUXDN*FZERO
+        DO L=1,L_NLAYRAD
+          FMNETV(L)=FMNETV(L)+( FMUPV(L)-FMDV(L) )*FZERO
+          FLUXUPV(L) = FLUXUPV(L) + FMUPV(L)*FZERO
+          FLUXDNV(L) = FLUXDNV(L) + FMDV(L)*FZERO
+        END DO
+
+c     band-resolved flux leaving TOA (RDW)
+          NFLUXOUTV_nu(NW) = NFLUXOUTV_nu(NW)
+     *      +FLUXUP*FZERO
+
+c     band-resolved flux at ground (RDW)
+          NFLUXGNDV_nu(NW) = NFLUXGNDV_nu(NW)+FMDV(L_NLAYRAD)*FZERO
+
+
+C       THE DIFFUSE COMPONENT OF THE DOWNWARD STELLAR FLUX
+
+        DIFFVT = DIFFVT + DIFFV*FZERO
+
+
+  500 CONTINUE
+
+
+C     *** END OF MAJOR SPECTRAL INTERVAL LOOP IN THE VISIBLE*****
+
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/slab_ice_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/slab_ice_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/slab_ice_h.F90	(revision 222)
@@ -0,0 +1,39 @@
+      module slab_ice_h
+
+      implicit none
+
+! noceanmx : number of oceanic layers
+      integer, parameter :: noceanmx = 2 ! number of oceanic layers
+
+      real, parameter :: ice_cap=2.05e+03       ! J/kg/K
+      real, parameter :: ice_den=945.0          ! kg/m3
+      real, parameter :: ice_lat=0.334e+05      ! J/kg
+      real, parameter :: ice_cond=2.1           ! W/m/K
+      real, parameter :: alb_ice_min=0.2       
+      real, parameter :: alb_ice_max=0.65 
+      real, parameter :: alb_ocean=0.07
+      real, parameter :: ice_frac_min=0.0001
+      real, parameter :: ice_frac_max=1.!0.9999
+      real, parameter :: h_alb_ice=0.5*ice_den   !m->kg/m2
+      real, parameter :: h_ice_thin=0.2*ice_den
+      real, parameter :: h_ice_thick=2.5*ice_den
+      real, parameter :: h_ice_min=0.000001*ice_den
+      real, parameter :: h_ice_max=10000.0
+
+      real, parameter :: capcalocean=50.*4.228e+06!121635.0
+      real, parameter :: capcalseaice=5.1444e+06*0.15
+      real, parameter :: capcalsno=2.3867e+06*0.15
+
+      real, parameter :: epsfra=1.0E-05
+      real, parameter :: soil_hdiff=25000.0
+
+!      real, parameter :: calice=1.0/(5.1444e+06*0.15)
+!      real, parameter :: tau_gl=86400.*5.
+!      real, parameter :: calsno=1./(2.3867e+06*0.15)
+
+
+
+
+
+
+      end module slab_ice_h
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/soil.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/soil.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/soil.F	(revision 222)
@@ -0,0 +1,187 @@
+      subroutine soil(ngrid,nsoil,firstcall,lastcall,
+     &          therm_i,
+     &          timestep,tsurf,tsoil,
+     &          capcal,fluxgrd)
+
+      use comsoil_h, only: layer, mlayer, volcapa
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!  Author: Ehouarn Millour
+!
+!  Purpose: Compute soil temperature using an implict 1st order scheme
+!  
+!  Note: depths of layers and mid-layers, soil thermal inertia and 
+!        heat capacity are commons in comsoil.h
+!-----------------------------------------------------------------------
+
+      include "dimensions.h"
+      include "dimphys.h"
+
+
+c-----------------------------------------------------------------------
+!  arguments
+!  ---------
+!  inputs:
+      integer,intent(in) :: ngrid	! number of (horizontal) grid-points 
+      integer,intent(in) :: nsoil	! number of soil layers 
+      logical,intent(in) :: firstcall ! identifier for initialization call 
+      logical,intent(in) :: lastcall
+      real,intent(in) :: therm_i(ngrid,nsoil) ! thermal inertia
+      real,intent(in) :: timestep	    ! time step
+      real,intent(in) :: tsurf(ngrid)   ! surface temperature
+! outputs:
+      real,intent(out) :: tsoil(ngrid,nsoil) ! soil (mid-layer) temperature
+      real,intent(out) :: capcal(ngrid) ! surface specific heat
+      real,intent(out) :: fluxgrd(ngrid) ! surface diffusive heat flux
+
+! local saved variables:
+      real,dimension(:,:),save,allocatable :: mthermdiff ! mid-layer thermal diffusivity
+      real,dimension(:,:),save,allocatable :: thermdiff ! inter-layer thermal diffusivity
+      real,dimension(:),save,allocatable :: coefq ! q_{k+1/2} coefficients
+      real,dimension(:,:),save,allocatable :: coefd ! d_k coefficients
+      real,dimension(:,:),save,allocatable :: alph ! alpha_k coefficients
+      real,dimension(:,:),save,allocatable :: beta ! beta_k coefficients
+      real,save :: mu
+            
+! local variables:
+      integer ig,ik
+
+
+! 0. Initialisations and preprocessing step
+      if (firstcall) then
+      ! note: firstcall is set to .true. or .false. by the caller
+      !       and not changed by soil.F 
+
+      ALLOCATE(mthermdiff(ngrid,0:nsoil-1)) ! mid-layer thermal diffusivity
+      ALLOCATE(thermdiff(ngrid,nsoil-1))    ! inter-layer thermal diffusivity
+      ALLOCATE(coefq(0:nsoil-1))              ! q_{k+1/2} coefficients
+      ALLOCATE(coefd(ngrid,nsoil-1))        ! d_k coefficients
+      ALLOCATE(alph(ngrid,nsoil-1))         ! alpha_k coefficients
+      ALLOCATE(beta(ngrid,nsoil-1))         ! beta_k coefficients
+
+! 0.1 Build mthermdiff(:), the mid-layer thermal diffusivities
+      do ig=1,ngrid
+        do ik=0,nsoil-1
+	  mthermdiff(ig,ik)=therm_i(ig,ik+1)*therm_i(ig,ik+1)/volcapa
+!	  write(*,*),'soil: ik: ',ik,' mthermdiff:',mthermdiff(ig,ik)
+	enddo
+      enddo
+
+! 0.2 Build thermdiff(:), the "interlayer" thermal diffusivities
+      do ig=1,ngrid
+        do ik=1,nsoil-1
+      thermdiff(ig,ik)=((layer(ik)-mlayer(ik-1))*mthermdiff(ig,ik)
+     &                +(mlayer(ik)-layer(ik))*mthermdiff(ig,ik-1))
+     &                    /(mlayer(ik)-mlayer(ik-1))
+!	write(*,*),'soil: ik: ',ik,' thermdiff:',thermdiff(ig,ik)
+	enddo
+      enddo
+
+! 0.3 Build coefficients mu, q_{k+1/2}, d_k, alpha_k and capcal
+      ! mu
+      mu=mlayer(0)/(mlayer(1)-mlayer(0))
+
+      ! q_{1/2}
+      coefq(0)=volcapa*layer(1)/timestep
+	! q_{k+1/2}
+        do ik=1,nsoil-1
+          coefq(ik)=volcapa*(layer(ik+1)-layer(ik))
+     &                 /timestep
+	enddo
+
+      do ig=1,ngrid
+	! d_k
+	do ik=1,nsoil-1
+	  coefd(ig,ik)=thermdiff(ig,ik)/(mlayer(ik)-mlayer(ik-1))
+	enddo
+	
+	! alph_{N-1}
+	alph(ig,nsoil-1)=coefd(ig,nsoil-1)/
+     &                  (coefq(nsoil-1)+coefd(ig,nsoil-1))
+        ! alph_k
+        do ik=nsoil-2,1,-1
+	  alph(ig,ik)=coefd(ig,ik)/(coefq(ik)+coefd(ig,ik+1)*
+     &                              (1.-alph(ig,ik+1))+coefd(ig,ik))
+	enddo
+
+        ! capcal
+! Cstar
+        capcal(ig)=volcapa*layer(1)+
+     &              (thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+     &              (timestep*(1.-alph(ig,1)))
+! Cs
+        capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+      !write(*,*)'soil: ig=',ig,' capcal(ig)=',capcal(ig)
+      enddo ! of do ig=1,ngrid
+            
+      else ! of if (firstcall)
+
+
+!  1. Compute soil temperatures
+! First layer:
+      do ig=1,ngrid
+        tsoil(ig,1)=(tsurf(ig)+mu*beta(ig,1)*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))/
+     &              (1.+mu*(1.0-alph(ig,1))*
+     &               thermdiff(ig,1)/mthermdiff(ig,0))
+      enddo
+! Other layers:
+      do ik=1,nsoil-1
+        do ig=1,ngrid
+	  tsoil(ig,ik+1)=alph(ig,ik)*tsoil(ig,ik)+beta(ig,ik)
+	enddo
+      enddo
+      
+      endif! of if (firstcall)
+
+!  2. Compute beta coefficients (preprocessing for next time step)
+! Bottom layer, beta_{N-1}
+      do ig=1,ngrid
+        beta(ig,nsoil-1)=coefq(nsoil-1)*tsoil(ig,nsoil)
+     &                   /(coefq(nsoil-1)+coefd(ig,nsoil-1))
+      enddo
+! Other layers
+      do ik=nsoil-2,1,-1
+        do ig=1,ngrid
+	  beta(ig,ik)=(coefq(ik)*tsoil(ig,ik+1)+
+     &                 coefd(ig,ik+1)*beta(ig,ik+1))/
+     &                 (coefq(ik)+coefd(ig,ik+1)*(1.0-alph(ig,ik+1))
+     &                  +coefd(ig,ik))
+	enddo
+      enddo
+
+
+!  3. Compute surface diffusive flux & calorific capacity
+      do ig=1,ngrid
+! Cstar
+!        capcal(ig)=volcapa(ig,1)*layer(ig,1)+
+!     &              (thermdiff(ig,1)/(mlayer(ig,1)-mlayer(ig,0)))*
+!     &              (timestep*(1.-alph(ig,1)))
+! Fstar
+
+!         print*,'this far in soil 1'
+!         print*,'thermdiff=',thermdiff(ig,1)
+!         print*,'mlayer=',mlayer
+!         print*,'beta=',beta(ig,1)
+!         print*,'alph=',alph(ig,1)
+!         print*,'tsoil=',tsoil(ig,1)
+
+        fluxgrd(ig)=(thermdiff(ig,1)/(mlayer(1)-mlayer(0)))*
+     &              (beta(ig,1)+(alph(ig,1)-1.0)*tsoil(ig,1))
+
+!        mu=mlayer(ig,0)/(mlayer(ig,1)-mlayer(ig,0))
+!        capcal(ig)=capcal(ig)/(1.+mu*(1.0-alph(ig,1))*
+!     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+! Fs
+        fluxgrd(ig)=fluxgrd(ig)+(capcal(ig)/timestep)*
+     &              (tsoil(ig,1)*(1.+mu*(1.0-alph(ig,1))*
+     &                         thermdiff(ig,1)/mthermdiff(ig,0))
+     &               -tsurf(ig)-mu*beta(ig,1)*
+     &                          thermdiff(ig,1)/mthermdiff(ig,0))
+      enddo
+
+      end
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/soil_settings.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/soil_settings.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/soil_settings.F	(revision 222)
@@ -0,0 +1,328 @@
+      subroutine soil_settings(nid,ngrid,nsoil,tsurf,tsoil,indextime)
+
+!      use netcdf
+      use comsoil_h, only: layer, mlayer, inertiedat, volcapa
+      use iostart, only: inquire_field_ndims, get_var, get_field,
+     &                   inquire_field, inquire_dimension_length
+      implicit none
+
+!======================================================================
+!  Author: Ehouarn Millour (07/2006)
+!
+!  Purpose: Read and/or initialise soil depths and properties
+!
+! Modifications: Aug.2010 EM : use NetCDF90 to load variables (enables using
+!                      r4 or r8 restarts independently of having compiled
+!                      the GCM in r4 or r8)
+!                June 2013 TN : Possibility to read files with a time axis
+!
+!
+!  This subroutine reads from a NetCDF file (opened by the caller)
+!  of "startfi.nc" format.
+!  The various actions and variable read/initialized are:
+!  1. Check out the number of soil layers (in datafile); if it isn't equal
+!     to nsoil, then some interpolation will be required
+!     Also check if data in file "startfi.nc" is in older format (ie:
+!     thermal inertia was depth-independent; and there was no "depth"
+!     coordinate.
+!     Read/build layer (and midlayer) depths
+!  2. Read volumetric specific heat (or initialise it to default value)
+!  3. Read Thermal inertia
+!  4. Read soil temperatures
+!  5. Interpolate thermal inertia and temperature on the new grid, if
+!     necessary
+!======================================================================
+
+!======================================================================
+!  arguments
+!  ---------
+!  inputs:
+      integer,intent(in) :: nid	! Input Netcdf file ID 
+      integer,intent(in) :: ngrid	! # of horizontal grid points
+      integer,intent(in) :: nsoil	! # of soil layers
+      real,intent(in) :: tsurf(ngrid)   ! surface temperature
+      integer,intent(in) :: indextime	! position on time axis
+!  output:
+      real,intent(out) :: tsoil(ngrid,nsoil)	! soil temperature
+
+!======================================================================
+! local variables:
+      integer ierr	! status (returned by NetCDF functions)
+      integer nvarid	! ID of NetCDF variable
+      integer dimid	! ID of NetCDF dimension
+      integer dimlen	! length along the "depth" dimension
+      integer ndims	! # of dimensions of read <inertiedat> data
+      integer ig,iloop	! loop counters
+      
+      integer edges(3),corner(3) ! to read a specific time
+
+      logical :: olddepthdef=.false. ! flag
+      logical :: interpol=.false. ! flag: true if interpolation will be requiered
+
+      ! to store "old" values
+      real,dimension(:),allocatable :: surfinertia !surface thermal inertia
+      real,dimension(:),allocatable :: oldmlayer
+      real,dimension(:,:),allocatable :: oldinertiedat
+      real,dimension(:,:),allocatable :: oldtsoil
+      ! for interpolation
+      real,dimension(:),allocatable :: oldgrid
+      real,dimension(:),allocatable :: oldval
+      real,dimension(:),allocatable :: newval
+
+      real alpha,lay1 ! coefficients for building layers
+      real xmin,xmax ! to display min and max of a field
+
+      real,parameter :: default_volcapa=1.e6
+
+      logical :: found,ok
+!======================================================================
+! 1. Depth coordinate
+! -------------------
+! 1.1 Start by reading how many layers of soil there are
+        dimlen=inquire_dimension_length("subsurface_layers")
+
+        if (dimlen.ne.nsoil) then
+          write(*,*)'soil_settings: Interpolation of soil temperature ',
+     &              'and thermal inertia will be required!'
+	! if dimlen doesn't match nsoil, then interpolation of
+	! soil temperatures and thermal inertia will be requiered
+	  interpol=.true.
+	endif
+! 1.2 Find out the # of dimensions <inertiedat> was defined as using
+      ndims=inquire_field_ndims("inertiedat")
+! 1.3 Read depths values or set olddepthdef flag and values
+      if (ndims.eq.1) then ! we know that there is none
+        write(*,*)'soil_settings: no <soildepth> field expected'
+	write(*,*)'building one mimicking old definitions'
+        olddepthdef=.true.
+	interpol=.true.
+        ! allocate oldmlayer
+        if (.not.allocated(oldmlayer)) then
+          allocate(oldmlayer(dimlen),stat=ierr)
+          if (ierr.ne.0) then
+            write(*,*) 'soil_settings: failed allocation of oldmlayer!'
+            stop
+          endif
+        endif
+	do iloop=1,dimlen
+	  oldmlayer(iloop)=sqrt(887.75/3.14)*((2.**(iloop-0.5))-1.)
+	enddo
+      else ! Look for depth 
+        ! read <depth> coordinate
+        if (interpol) then !put values in oldmlayer
+          call get_var("soildepth",oldmlayer,found)
+          if (.not.found) then
+            write(*,*)'soil_settings: Problem while reading <soildepth>'
+          endif
+        else ! put values in mlayer
+          call get_var("soildepth",mlayer,found)
+          print*,"mlayer",mlayer
+	  if (.not.found) then
+            write(*,*)'soil_settings: Problem while reading <soildepth>'
+          endif
+        endif !of if (interpol)
+      endif !of if (ndims.eq.1)
+! 1.4 Build mlayer(), if necessary
+      if (interpol) then
+      ! default mlayer distribution, following a power law:
+      !  mlayer(k)=lay1*alpha**(k-1/2)
+        lay1=2.e-4
+	alpha=2
+        do iloop=0,nsoil-1
+	  mlayer(iloop)=lay1*(alpha**(iloop-0.5))
+        enddo
+      endif
+! 1.5 Build layer(); following the same law as mlayer()
+      ! Assuming layer distribution follows mid-layer law:
+      ! layer(k)=lay1*alpha**(k-1)
+      lay1=sqrt(mlayer(0)*mlayer(1))
+      alpha=mlayer(1)/mlayer(0)
+      do iloop=1,nsoil
+        layer(iloop)=lay1*(alpha**(iloop-1))
+      enddo
+! 2. Volumetric heat capacity (note: it is declared in comsoil_h)
+! ---------------------------
+! "volcapa" is (so far) 0D and written in "controle" table of startfi file 
+! volcapa is read or set when "controle" is read (see tabfi.F)
+! Just in case, we check here that it is not zero. If it is, we
+! set it to "default_volcapa"
+
+      if (volcapa.le.0.0) then
+        write(*,*)'soil_settings: Warning, volcapa = ',volcapa
+	write(*,*)'               That doesn t seem right'
+        write(*,*)'        Initializing Volumetric heat capacity to ',
+     &             default_volcapa
+	volcapa=default_volcapa
+      endif
+
+! 3. Thermal inertia (note: it is declared in comsoil_h)
+! ------------------
+! 3.1 Look (again) for thermal inertia data (to reset nvarid)
+
+! 3.2 Knowing the # of dimensions <inertidat> was defined as using,
+!     read/build thermal inertia
+
+      if (ndims.eq.1) then ! "old 2D-surface" format
+       write(*,*)'soil_settings: Thermal inertia is only given as surfac
+     &e data!'
+       ! Read Surface thermal inertia
+       allocate(surfinertia(ngrid))
+       call get_field("inertiedat",surfinertia,found)
+       if (.not.found) then
+         write(*,*) "soil_settings: Failed loading <inertiedat>"
+         call abort
+       endif
+       
+       write(*,*)' => Building soil thermal inertia (using reference sur
+     &face thermal inertia)'
+       do iloop=1,nsoil
+         inertiedat(:,iloop)=surfinertia(:)
+       enddo
+       deallocate(surfinertia)
+
+      else ! "3D surface+depth" format
+       if (interpol) then ! put values in oldinertiedat
+         if (.not.allocated(oldinertiedat)) then
+           allocate(oldinertiedat(ngrid,dimlen),stat=ierr)
+           if (ierr.ne.0) then
+            write(*,*) 'soil_settings: failed allocation of ',
+     &                 'oldinertiedat!'
+            stop
+           endif
+         endif ! of if (.not.allocated(oldinertiedat))
+        call get_field("inertiedat",oldinertiedat,found)
+        if (.not.found) then
+          write(*,*) "soil_settings: Failed loading <inertiedat>"
+          call abort
+        endif
+       else ! put values in therm_i
+         call get_field("inertiedat",inertiedat,found)
+         if (.not.found) then
+           write(*,*) "soil_settings: Failed loading <inertiedat>"
+           call abort
+         endif
+!        endif
+       endif ! of if (interpol)
+      endif ! of if (ndims.eq.1)
+      
+! 4. Read soil temperatures
+! -------------------------
+!      ierr=nf90_inq_varid(nid,"tsoil",nvarid)
+      ok=inquire_field("tsoil")
+!      if (ierr.ne.nf90_noerr) then
+      if (.not.ok) then
+        write(*,*)'soil_settings: Field <tsoil> not found!'
+	write(*,*)' => Building <tsoil> from surface values <tsurf>'
+	do iloop=1,nsoil
+	  tsoil(:,iloop)=tsurf(:)
+	enddo
+      else ! <tsoil> found
+       if (interpol) then ! put values in oldtsoil
+         if (.not.allocated(oldtsoil)) then
+           allocate(oldtsoil(ngrid,dimlen),stat=ierr)
+           if (ierr.ne.0) then
+             write(*,*) 'soil_settings: failed allocation of ',
+     &                  'oldtsoil!'
+             stop
+           endif
+         endif
+         call get_field("tsoil",oldtsoil,found)
+         if (.not.found) then
+           write(*,*) "soil_settings: Failed loading <tsoil>"
+           call abort
+         endif
+       else ! put values in tsoil
+         call get_field("tsoil",tsoil,found,timeindex=indextime)
+         if (.not.found) then
+           write(*,*) "soil_settings: Failed loading <tsoil>"
+           call abort
+         endif
+       endif ! of if (interpol) 
+      endif! of if (.not.ok)
+
+! 5. If necessary, interpolate soil temperatures and thermal inertias
+! -------------------------------------------------------------------
+      if (olddepthdef) then
+      ! tsoil needs to be interpolated, but not therm_i
+        allocate(oldgrid(dimlen+1))
+        allocate(oldval(dimlen+1))
+	allocate(newval(nsoil))
+
+        do ig=1,ngrid
+	  ! copy values
+	  oldval(1)=tsurf(ig)
+	  oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen)
+	  ! build vertical coordinate
+	  oldgrid(1)=0. ! ground
+	  oldgrid(2:dimlen+1)=oldmlayer(1:dimlen)*
+     &                (inertiedat(ig,1)/volcapa)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil)
+	  ! copy result in tsoil
+	  tsoil(ig,:)=newval(:)
+	enddo
+
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+	interpol=.false. ! no need for interpolation any more      
+      endif !of if (olddepthdef)
+
+      if (interpol) then
+      write(*,*)'soil_settings: Vertical interpolation along new grid'
+      ! interpolate soil temperatures and thermal inertias
+        if (.not.allocated(oldgrid)) then
+          allocate(oldgrid(dimlen+1))
+          allocate(oldval(dimlen+1))
+	  allocate(newval(nsoil))
+        endif
+
+      ! thermal inertia
+        do ig=1,ngrid
+	  ! copy data
+	  oldval(1:dimlen)=oldinertiedat(ig,dimlen)
+	  ! interpolate
+	  call interp_line(oldmlayer,oldval,dimlen,mlayer,newval,nsoil)
+	  !copy result in inertiedat
+	  inertiedat(ig,:)=newval(:)
+	enddo
+        
+      ! soil temperature
+        ! vertical coordinate
+	oldgrid(1)=0.0
+	oldgrid(2:dimlen+1)=oldmlayer(1:dimlen)
+        do ig=1,ngrid
+	  ! data
+	  oldval(1)=tsurf(ig)
+	  oldval(2:dimlen+1)=oldtsoil(ig,1:dimlen)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,dimlen+1,mlayer,newval,nsoil)
+	  ! copy result in inertiedat
+	  tsoil(ig,:)=newval(:)
+	enddo
+	
+	!cleanup
+        deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+	deallocate(oldinertiedat)
+	deallocate(oldtsoil)
+      endif ! of if (interpol)
+      
+! 6. Report min and max values of soil temperatures and thermal inertias
+! ----------------------------------------------------------------------
+
+      write(*,*)
+      write(*,*)'Soil volumetric heat capacity:',volcapa
+
+      xmin = MINVAL(inertiedat)
+      xmax = MAXVAL(inertiedat)
+      write(*,*)'Soil thermal inertia <inertiedat>:',xmin,xmax
+
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(tsoil)
+      xmax = MAXVAL(tsoil)
+      write(*,*)'Soil temperature <tsoil>:',xmin,xmax
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/start2archive.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/start2archive.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/start2archive.F	(revision 222)
@@ -0,0 +1,517 @@
+c=======================================================================
+      PROGRAM start2archive
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c
+c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
+c   -----    "startfi" a un fichier netcdf unique "start_archive" 
+c
+c  "start_archive" est une banque d'etats initiaux:
+c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
+c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
+c 
+c
+c
+c=======================================================================
+
+      use infotrac, only: iniadvtrac, nqtot, tname
+      USE comsoil_h
+      USE comgeomfi_h, ONLY: lati, long, area
+!      use control_mod
+      use comgeomphy, only: initcomgeomphy
+      use slab_ice_h, only: noceanmx
+! to use  'getin'
+      USE ioipsl_getincom
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+!#include "control.h"
+#include "ener.h"
+
+#include "dimphys.h"
+#include "planete.h"
+!#include"advtrac.h"
+#include "netcdf.inc"
+#include "callkeys.h"
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c variables dynamiques du GCM
+c -----------------------------
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
+      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL beta(iip1,jjp1,llm)
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
+      REAL ps(ip1jmp1)                       ! pression au sol
+      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
+      
+c Variable Physiques (grille physique)
+c ------------------------------------
+      REAL tsurf(ngridmx)	! Surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL q2(ngridmx,nlayermx+1)
+      REAL,ALLOCATABLE :: qsurf(:,:)
+      REAL emis(ngridmx)
+      INTEGER start,length
+      PARAMETER (length = 100)
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      REAL tab_cntrl_dyn(length) ! tableau des parametres de start
+      INTEGER*4 day_ini_fi
+
+!     added by FF for cloud fraction setup
+      REAL hice(ngridmx)
+      REAL cloudfrac(ngridmx,nlayermx),totalcloudfrac(ngridmx)
+
+!     added by BC for slab ocean
+      REAL rnat(ngridmx),pctsrf_sic(ngridmx),sea_ice(ngridmx)
+      REAL tslab(ngridmx,noceanmx),tsea_ice(ngridmx)
+
+
+c Variable naturelle / grille scalaire
+c ------------------------------------
+      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
+      REAL tsurfS(ip1jmp1)
+      REAL tsoilS(ip1jmp1,nsoilmx)
+      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
+      REAL co2iceS(ip1jmp1)
+      REAL q2S(ip1jmp1,llm+1)
+      REAL,ALLOCATABLE :: qsurfS(:,:)
+      REAL emisS(ip1jmp1)
+
+!     added by FF for cloud fraction setup
+      REAL hiceS(ip1jmp1)
+      REAL cloudfracS(ip1jmp1,llm),totalcloudfracS(ip1jmp1)
+
+!     added by BC for slab ocean
+      REAL rnatS(ip1jmp1),pctsrf_sicS(ip1jmp1),sea_iceS(ip1jmp1)
+      REAL tslabS(ip1jmp1,noceanmx),tsea_iceS(ip1jmp1)
+
+
+c Variables intermediaires : vent naturel, mais pas coord scalaire
+c----------------------------------------------------------------
+      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
+
+c Autres  variables
+c -----------------
+      LOGICAL startdrs
+      INTEGER Lmodif
+
+      REAL ptotal, co2icetotal
+      REAL timedyn,timefi !fraction du jour dans start, startfi
+      REAL date
+
+      CHARACTER*2 str2
+      CHARACTER*80 fichier 
+      data  fichier /'startfi'/
+
+      INTEGER ij, l,i,j,isoil,iq
+      character*80      fichnom
+      integer :: ierr,ntime
+      integer :: nq,numvanle
+      character(len=30) :: txt ! to store some text
+
+c Netcdf
+c-------
+      integer varid,dimid,timelen 
+      INTEGER nid,nid1
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .TRUE. )
+      grireg   = .TRUE.
+
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+      ! ALLOCATE ARRAYS IN comgeomfi_h (usually done in inifis)
+      ! this must be here for start2archive to work
+      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(ngridmx))
+      IF (.not. ALLOCATED(long)) ALLOCATE(long(ngridmx))
+      IF (.not. ALLOCATED(area)) ALLOCATE(area(ngridmx))
+
+c=======================================================================
+c Lecture des donnees
+c=======================================================================
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+
+! allocate arrays:
+      allocate(q(ip1jmp1,llm,nqtot))
+      allocate(qsurf(ngridmx,nqtot))
+      allocate(qsurfS(ip1jmp1,nqtot))
+! other array allocations:
+      call ini_comsoil_h(ngridmx)
+
+      fichnom = 'start.nc'
+      CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,timedyn)
+
+! load 'controle' array from dynamics start file
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_dyn)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_dyn)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+
+      ierr = NF_CLOSE(nid1)
+      
+
+      fichnom = 'startfi.nc'
+      Lmodif=0
+
+
+      CALL phyetat0 (ngridmx,fichnom,0,Lmodif,nsoilmx,nqtot,day_ini_fi,
+     .      timefi,
+     .      tsurf,tsoil,emis,q2,qsurf,
+!       change FF 05/2011
+     .       cloudfrac,totalcloudfrac,hice,
+!       change BC 05/2014
+     .       rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+
+
+
+! load 'controle' array from physics start file
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+
+      ierr = NF_CLOSE(nid1)
+
+
+c-----------------------------------------------------------------------
+c Controle de la synchro
+c-----------------------------------------------------------------------
+!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
+      if ((day_ini_fi.ne.day_ini)) 
+     &  stop ' Probleme de Synchro entre start et startfi !!!'
+
+
+c *****************************************************************
+c    Option : Reinitialisation des dates dans la premieres annees :
+       do while (day_ini.ge.year_day)
+          day_ini=day_ini-year_day
+       enddo
+c *****************************************************************
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .FALSE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+
+c=======================================================================
+c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
+c=======================================================================
+c  Les variables modeles dependent de la resolution. Il faut donc
+c  eliminer les facteurs responsables de cette dependance
+c  (pour utiliser newstart)
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Vent   (depend de la resolution horizontale) 
+c-----------------------------------------------------------------------
+c
+c ucov --> un  et  vcov --> vn
+c un --> us  et   vn --> vs
+c
+c-----------------------------------------------------------------------
+
+      call covnat(llm,ucov, vcov, un, vn) 
+      call wind_scal(un,vn,us,vs) 
+
+c-----------------------------------------------------------------------
+c Temperature  (depend de la resolution verticale => de "sigma.def")
+c-----------------------------------------------------------------------
+c
+c h --> T
+c
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c Variable physique 
+c-----------------------------------------------------------------------
+c
+c tsurf --> tsurfS
+c co2ice --> co2iceS
+c tsoil --> tsoilS
+c emis --> emisS
+c q2 --> q2S
+c qsurf --> qsurfS
+c
+c-----------------------------------------------------------------------
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
+!      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
+      ! Note: thermal inertia "inertiedat" is in comsoil.h
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
+      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
+      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
+      call gr_fi_dyn(llm,ngridmx,iip1,jjp1,cloudfrac,cloudfracS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,hice,hiceS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,totalcloudfrac,totalcloudfracS)
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,rnat,rnatS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,pctsrf_sic,pctsrf_sicS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsea_ice,tsea_iceS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,sea_ice,sea_iceS)
+      call gr_fi_dyn(noceanmx,ngridmx,iip1,jjp1,tslab,tslabS)
+
+c=======================================================================
+c Info pour controler
+c=======================================================================
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
+!           co2icetotal = co2icetotal + 
+!     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
+         ENDDO
+      ENDDO
+      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
+!      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
+
+c-----------------------------------------------------------------------
+c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
+c-----------------------------------------------------------------------
+
+      tab_cntrl_fi(49) = ptotal
+      tab_cntrl_fi(50) = co2icetotal
+
+c=======================================================================
+c Ecriture dans le fichier  "start_archive"
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Ouverture de "start_archive" 
+c-----------------------------------------------------------------------
+
+      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
+ 
+c-----------------------------------------------------------------------
+c  si "start_archive" n'existe pas:
+c    1_ ouverture
+c    2_ creation de l'entete dynamique ("ini_archive")
+c-----------------------------------------------------------------------
+c ini_archive:
+c On met dans l'entete le tab_cntrl dynamique (1 a 16) 
+c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
+c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
+c-----------------------------------------------------------------------
+
+      if (ierr.ne.NF_NOERR) then
+         write(*,*)'OK, Could not open file "start_archive.nc"'
+         write(*,*)'So let s create a new "start_archive"'
+         ierr = NF_CREATE('start_archive.nc', NF_CLOBBER, nid)
+         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi,
+     &                                          tab_cntrl_dyn)
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture de la coordonnee temps (date en jours)
+c-----------------------------------------------------------------------
+
+      date = day_ini
+      ierr= NF_INQ_VARID(nid,"Time",varid)
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      ntime=timelen+1
+
+      write(*,*) "******************"
+      write(*,*) "ntime",ntime
+      write(*,*) "******************"
+#ifdef NC_DOUBLE
+      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write(*,*) "time matter ",NF_STRERROR(ierr)
+         stop
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
+c-----------------------------------------------------------------------
+c ATTENTION: q2 a une couche de plus!!!!
+c    Pour creer un fichier netcdf lisible par grads,
+c    On passe donc une des couches de q2 a part
+c    comme une variable 2D (la couche au sol: "q2surf")
+c    Les lmm autres couches sont nommees "q2atm" (3D) 
+c-----------------------------------------------------------------------
+
+!      call write_archive(nid,ntime,'co2ice','couche de glace co2',
+!     &  'kg/m2',2,co2iceS)
+      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
+      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
+      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
+      call write_archive(nid,ntime,'temp','temperature','K',3,t)
+      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
+      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
+      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
+     .              q2S)
+      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
+     .              q2S(1,2))
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  q  ( q[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
+     &         3,q(1,1,iq))
+      end do
+c-----------------------------------------------------------------------
+c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+        txt=trim(tname(iq))//"_surf"
+        call write_archive(nid,ntime,txt,'Tracer on surface',
+     &  'kg.m-2',2,qsurfS(1,iq))
+      enddo
+
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  tsoil  ( Tg[1,10] )
+c-----------------------------------------------------------------------
+c "tsoil" Temperature au sol definie dans 10 couches dans le sol
+c   Les 10 couches sont lues comme 10 champs 
+c  nommees Tg[1,10]
+
+c      do isoil=1,nsoilmx
+c       write(str2,'(i2.2)') isoil
+c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
+c     .   'K',2,tsoilS(1,isoil))
+c      enddo
+
+! Write soil temperatures tsoil
+      call write_archive(nid,ntime,'tsoil','Soil temperature',
+     &     'K',-3,tsoilS)
+
+! Write soil thermal inertia
+      call write_archive(nid,ntime,'inertiedat',
+     &     'Soil thermal inertia',
+     &     'J.s-1/2.m-2.K-1',-3,ithS)
+
+! Write (0D) volumetric heat capacity (stored in comsoil.h)
+!      call write_archive(nid,ntime,'volcapa',
+!     &     'Soil volumetric heat capacity',
+!     &     'J.m-3.K-1',0,volcapa)
+! Note: no need to write volcapa, it is stored in "controle" table
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  cloudfrac,hice,totalcloudfrac
+c-----------------------------------------------------------------------
+      call write_archive(nid,ntime,'hice',
+     &         'Height of oceanic ice','m',2,hiceS)
+      call write_archive(nid,ntime,'totalcloudfrac',
+     &        'Total cloud Fraction','',2,totalcloudfracS)
+      call write_archive(nid,ntime,'cloudfrac'
+     &        ,'Cloud fraction','',3,cloudfracS)
+
+c-----------------------------------------------------------------------
+c Slab ocean
+c-----------------------------------------------------------------------
+      OPEN(99,file='callphys.def',status='old',form='formatted'
+     &     ,iostat=ierr)
+      CLOSE(99)
+
+      IF(ierr.EQ.0) THEN
+
+
+         write(*,*) "Use slab-ocean ?"
+         ok_slab_ocean=.false.         ! default value
+         call getin("ok_slab_ocean",ok_slab_ocean)
+         write(*,*) "ok_slab_ocean = ",ok_slab_ocean
+
+      if(ok_slab_ocean) then
+      call write_archive(nid,ntime,'rnat'
+     &        ,'rnat','',2,rnatS)
+      call write_archive(nid,ntime,'pctsrf_sic'
+     &        ,'pctsrf_sic','',2,pctsrf_sicS)
+      call write_archive(nid,ntime,'sea_ice'
+     &        ,'sea_ice','',2,sea_iceS)
+      call write_archive(nid,ntime,'tslab'
+     &        ,'tslab','',3,tslabS)
+      call write_archive(nid,ntime,'tsea_ice'
+     &        ,'tsea_ice','',2,tsea_iceS)
+      endif !ok_slab_ocean
+      ENDIF
+c-----------------------------------------------------------------------
+c Fin 
+c-----------------------------------------------------------------------
+      ierr=NF_CLOSE(nid)
+
+      write(*,*) "start2archive: All is well that ends well."
+
+      end 
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/statto.h
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/statto.h	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/statto.h	(revision 222)
@@ -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: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stelang.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stelang.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stelang.F	(revision 222)
@@ -0,0 +1,121 @@
+      subroutine stelang(kgrid,psilon,pcolon,psilat,pcolat,
+     &                ptim1,ptim2,ptim3,pmu0,pfract, pflat)
+      IMPLICIT NONE
+
+C
+C**** *LW*   - ORGANIZES THE LONGWAVE CALCULATIONS
+C
+C     PURPOSE.
+C     --------
+C          CALCULATES THE STELLAR ANGLE FOR ALL THE POINTS OF THE GRID
+C
+C**   INTERFACE.
+C     ----------
+C      SUBROUTINE STELANG ( KGRID )
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C     ==== INPUTS  ===
+C
+C PSILON(KGRID)   : SINUS OF THE LONGITUDE
+C PCOLON(KGRID)   : COSINUS OF THE LONGITUDE
+C PSILAT(KGRID)   : SINUS OF THE LATITUDE
+C PCOLAT(KGRID)   : COSINUS OF THE LATITUDE
+C PTIM1           : SIN(DECLI)
+C PTIM2           : COS(DECLI)*COS(TIME)
+C PTIM3           : SIN(DECLI)*SIN(TIME)
+C
+C     ==== OUTPUTS ===
+C
+C PMU0 (KGRID)    : SOLAR ANGLE
+C PFRACT(KGRID)   : DAY FRACTION OF THE TIME INTERVAL
+C
+C        IMPLICIT ARGUMENTS :   NONE
+C        --------------------
+C
+C     METHOD.
+C     -------
+C
+C     EXTERNALS.
+C     ----------
+C
+C         NONE
+C
+C     REFERENCE.
+C     ----------
+C
+C         RADIATIVE PROCESSES IN METEOROLOGIE AND CLIMATOLOGIE
+C         PALTRIDGE AND PLATT
+C
+C     AUTHOR.
+C     -------
+C        FREDERIC HOURDIN
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL :90-01-14
+C                  92-02-14 CALCULATIONS DONE THE ENTIER GRID (J.Polcher)
+C-----------------------------------------------------------------------
+C
+C     ------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+C
+C*      0.1   ARGUMENTS
+C             ---------
+C
+      INTEGER,INTENT(IN) :: kgrid
+      REAL,INTENT(IN) :: ptim1,ptim2,ptim3, pflat
+      REAL,INTENT(IN) :: psilon(kgrid),pcolon(kgrid)
+      REAL,INTENT(IN) :: psilat(kgrid), pcolat(kgrid)
+      REAL,INTENT(OUT) :: pmu0(kgrid),pfract(kgrid)
+C
+      INTEGER jl
+      REAL ztim1,ztim2,ztim3, rap
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C------------------------------------------------------------------------
+C
+C------------------------------------------------------------------------
+C
+C*     1.     INITIALISATION
+C             --------------
+C
+c----- SG: geometry adapted to a flattened planet (Feb2014)
+
+      rap = 1./((1.-pflat)**2)
+
+ 100  CONTINUE
+C
+      DO jl=1,kgrid
+        pmu0(jl)=0.
+        pfract(jl)=0.
+      ENDDO
+C
+C*     1.1     COMPUTATION OF THE SOLAR ANGLE
+C              ------------------------------
+C
+      DO jl=1,kgrid
+        ztim1=psilat(jl)*ptim1*rap
+        ztim2=pcolat(jl)*ptim2
+        ztim3=pcolat(jl)*ptim3
+        pmu0(jl)=ztim1+ztim2*pcolon(jl)+ztim3*psilon(jl)
+	pmu0(jl)=pmu0(jl)/SQRT(pcolat(jl)**2+(rap**2)*(psilat(jl)**2))
+
+      ENDDO
+C
+C*     1.2      DISTINCTION BETWEEN DAY AND NIGHT
+C               ---------------------------------
+C
+      DO jl=1,kgrid
+        IF (pmu0(jl).gt.0.) THEN
+          pfract(jl)=1.
+c       pmu0(jl)=sqrt(1224.*pmu0(jl)*pmu0(jl)+1.)/35.
+      ELSE
+c       pmu0(jl)=0.
+        pfract(jl)=0.
+        ENDIF
+      ENDDO
+C
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stellarlong.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stellarlong.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stellarlong.F	(revision 222)
@@ -0,0 +1,101 @@
+      SUBROUTINE stellarlong(pday,pstellong)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Objet:
+c   ------
+c
+c      Calcul de la distance soleil-planete et de la declinaison
+c   en fonction du jour de l'annee.
+c
+c
+c   Methode:
+c   --------
+c
+c      Calcul complet de l'elipse
+c
+c   Interface:
+c   ----------
+c
+c      Uncommon comprenant les parametres orbitaux.
+c
+c   Arguments:
+c   ----------
+c
+c   Input:
+c   ------
+c   pday          jour de l'annee (le jour 0 correspondant a l'equinoxe)
+c
+c   Output:
+c   -------
+c   pdist_star     distance entre le soleil et la planete
+c                 ( en unite astronomique pour utiliser la constante 
+c                  solaire terrestre 1370 Wm-2 )
+c   pdecli        declinaison ( en radians )
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "planete.h"
+#include "comcstfi.h"
+
+c arguments:
+c ----------
+
+      REAL pday,pdist_star,pdecli,pstellong
+      LOGICAL lwrite
+
+c Local:
+c ------
+
+      REAL zanom,xref,zx0,zdx,zteta,zz
+      INTEGER iter
+
+
+c-----------------------------------------------------------------------
+c calcul de l'angle polaire et de la distance au soleil :
+c -------------------------------------------------------
+
+c  calcul de l'zanomalie moyenne
+
+      zz=(pday-peri_day)/year_day
+      pi=2.*asin(1.)
+      zanom=2.*pi*(zz-nint(zz))
+      xref=abs(zanom)
+
+c  resolution de l'equation horaire  zx0 - e * sin (zx0) = xref
+c  methode de Newton
+
+      zx0=xref+e_elips*sin(xref)
+      DO 110 iter=1,10
+         zdx=-(zx0-e_elips*sin(zx0)-xref)/(1.-e_elips*cos(zx0))
+         if(abs(zdx).le.(1.e-7)) goto 120
+         zx0=zx0+zdx
+110   continue
+120   continue
+      zx0=zx0+zdx
+      if(zanom.lt.0.) zx0=-zx0
+
+c zteta est la longitude solaire
+
+      zteta=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.))
+
+      pstellong=zteta-timeperi
+
+      IF(pstellong.LT.0.) pstellong=pstellong+2.*pi
+      IF(pstellong.GT.2.*pi) pstellong=pstellong-2.*pi
+c-----------------------------------------------------------------------
+c   sorties eventuelles:
+c   ---------------------
+
+c     IF (lwrite) THEN
+c        PRINT*,'jour de l"annee   :',pday
+c        PRINT*,'distance au soleil (en unite astronomique) :',pdist_star
+c        PRINT*,'declinaison (en degres) :',pdecli*180./pi
+c     ENDIF
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stokes.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stokes.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/stokes.F90	(revision 222)
@@ -0,0 +1,67 @@
+      subroutine stokes(p,t,rd,w,rho_aer)
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the sedimentation velocity in a low pressure 
+!     atmosphere.
+!
+!     Authors
+!     ------- 
+!     Francois Forget (1997)
+!
+!==================================================================
+
+!      use radcommon_h, only : Rgas
+
+      implicit none
+
+#include "comcstfi.h"
+
+!     input
+!     -----
+!     pressure (Pa), Temperature (K), particle radius (m), density
+      real p, t, rd, rho_aer 
+
+!     output
+!     ------
+!     sedimentation velocity (m/s, >0)
+      real w
+
+!     locally saved variables
+!     ---------------------
+      real a,b,molrad,visc
+      save a,b
+  
+      LOGICAL firstcall
+      SAVE firstcall
+      DATA firstcall/.true./
+
+      if (firstcall) then
+
+         !print*,'Routine not working: replace Rgas with r'
+	 !stop
+         !a = 0.707*Rgas/(4*pi*molrad**2 * avocado)
+
+         molrad=2.2e-10   ! CO2 (only used in condense_co2cloud at the moment)
+         visc=1.e-5       ! CO2
+
+
+         a = 0.707*R/(4*pi*molrad**2 * avocado)
+         b = (2./9.) * rho_aer * g / visc 
+	!print*,'molrad=',molrad
+	!print*,'visc=',visc
+	!print*,'a=',a
+	!print*,'b=',b
+	!print*,'rho_aer=',rho_aer
+	!stop
+ 
+         firstcall=.false.
+      end if
+
+!     Sedimentation velocity =
+!     Stokes' Law corrected for low pressures by the Cunningham
+!     slip-flow correction according to Rossow (Icarus 36, 1-50, 1978)
+      w = b * rd*rd * (1 + 1.333* (a*T/P)/rd )  
+      return
+    end subroutine stokes
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/su_gases.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/su_gases.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/su_gases.F90	(revision 222)
@@ -0,0 +1,125 @@
+subroutine su_gases
+
+  use gases_h
+
+  implicit none
+
+  integer igas, ierr, count
+
+  !==================================================================
+  !     
+  !     Purpose
+  !     -------
+  !     Load atmospheric composition info
+  !     
+  !     Authors
+  !     -------
+  !     R. Wordsworth (2011)
+  !     Allocatable arrays by A. Spiga (2011)
+  !     
+  !==================================================================
+
+  ! load gas names from file 'gases.def'
+  open(90,file='gases.def',status='old',form='formatted',iostat=ierr)
+  if (ierr.eq.0) then
+     write(*,*) "sugases.F90: reading file gases.def"
+     read(90,*)
+     read(90,*,iostat=ierr) ngasmx
+     if (ierr.ne.0) then
+        write(*,*) "sugases.F90: error reading number of gases"
+        write(*,*) "   (first line of gases.def) "
+        call abort
+     endif
+
+     print*,ngasmx, " gases found in gases.def. Allocating names and molar fractions..."
+
+     if (.not.allocated(gnom)) allocate(gnom(ngasmx))
+     do igas=1,ngasmx
+        read(90,*,iostat=ierr) gnom(igas)
+        if (ierr.ne.0) then
+           write(*,*) 'sugases.F90: error reading gas names in gases.def...'
+           call abort
+        endif
+     enddo                  !of do igas=1,ngasmx
+
+     vgas=0
+     if(.not.allocated(gfrac)) allocate(gfrac(ngasmx))
+     do igas=1,ngasmx
+        read(90,*,iostat=ierr) gfrac(igas)
+        if (ierr.ne.0) then
+           write(*,*) 'sugases.F90: error reading gas molar fractions in gases.def...'
+           call abort
+        endif
+
+        ! find variable gas (if any)
+        if(gfrac(igas).eq.-1.0)then 
+           if(vgas.eq.0)then
+              vgas=igas
+           else
+              print*,'You seem to be choosing two variable gases'
+              print*,'Check that gases.def is correct'
+              call abort
+           endif
+        endif
+
+     enddo                  !of do igas=1,ngasmx
+
+
+     ! assign the 'igas_X' labels
+     count=0
+     do igas=1,ngasmx
+        if (trim(gnom(igas)).eq."H2_" .or. trim(gnom(igas)).eq."H2") then
+           igas_H2=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."He_" .or. trim(gnom(igas)).eq."He") then
+           igas_He=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."H2O") then
+           igas_H2O=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."CO2") then
+           igas_CO2=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."CO_" .or. trim(gnom(igas)).eq."CO") then
+           igas_CO=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."N2_" .or. trim(gnom(igas)).eq."N2") then
+           igas_N2=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."O2_" .or. trim(gnom(igas)).eq."O2") then
+           igas_O2=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."SO2") then
+           igas_SO2=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."H2S") then
+           igas_H2S=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."CH4") then
+           igas_CH4=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."NH3") then
+           igas_NH3=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."C2H6") then
+           igas_C2H6=igas
+           count=count+1
+        elseif (trim(gnom(igas)).eq."C2H2") then
+           igas_C2H2=igas
+           count=count+1
+        endif
+     enddo
+
+     if(count.ne.ngasmx)then
+        print*,'Mismatch between ngas and number of recognised gases in sugas_corrk.F90.'
+        print*,'Either we haven`t managed to assign all the gases, or there are duplicates.'
+        print*,'Please try again.'
+     endif
+
+  else
+     write(*,*) 'Cannot find required file "gases.def"'
+     call abort
+  endif
+  close(90)
+
+end subroutine su_gases
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/su_watercycle.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/su_watercycle.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/su_watercycle.F90	(revision 222)
@@ -0,0 +1,32 @@
+      subroutine su_watercycle
+
+      use watercommon_h
+      implicit none
+#include "comcstfi.h"
+#include "callkeys.h"
+
+
+!==================================================================
+!
+!     Purpose
+!     -------
+!     Set up relevant constants and parameters for the water cycle, and water cloud properties
+!
+!     Authors
+!     -------
+!     Robin Wordsworth (2010)
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+
+      epsi   = mH2O / mugaz
+      RCPD   = cpp 
+
+      !RV = 1000.*R/mH2O
+      RV = 1000.*8.314/mH2O ! caution! R is R/mugaz already!
+
+      RCPV   = 1.88e3 ! specific heat capacity of water vapor at 350K
+
+      RVTMP2 = RCPV/RCPD-1. ! not currently used...
+
+      end subroutine su_watercycle
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/suaer_corrk.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/suaer_corrk.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/suaer_corrk.F90	(revision 222)
@@ -0,0 +1,449 @@
+      subroutine suaer_corrk
+
+      ! inputs
+      use radinc_h,    only: L_NSPECTI,L_NSPECTV,nsizemax,iim,jjm,naerkind
+      use radcommon_h, only: blamv,blami,lamrefir,lamrefvis
+      use datafile_mod, only: datadir
+
+      ! outputs
+      use radcommon_h, only: QVISsQREF,omegavis,gvis,QIRsQREF,omegair,gir
+      use radcommon_h, only: radiustab,nsize,tstellar
+      use radcommon_h, only: qrefvis,qrefir,omegarefvis,omegarefir
+      use aerosol_mod
+
+      implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Initialize all radiative aerosol properties
+!
+!     Notes
+!     -----
+!     Reads the optical properties -> Mean  -> Variable assignment
+!     (ASCII files)                  (see radcommon_h.F90)
+!     wvl(nwvl)                      longsun
+!     ep(nwvl)                       epav     QVISsQREF(L_NSPECTV)
+!     omeg(nwvl)                     omegav   omegavis(L_NSPECTV)
+!     gfactor(nwvl)                  gav      gvis(L_NSPECTV)
+!     
+!     Authors
+!     ------- 
+!     Richard Fournier (1996) Francois Forget (1996)
+!     Frederic Hourdin
+!     Jean-jacques morcrette *ECMWF*
+!     MODIF Francois Forget (2000)
+!     MODIF Franck Montmessin (add water ice)
+!     MODIF J.-B. Madeleine 2008W27
+!     - Optical properties read in ASCII files
+!     - Add varying radius of the particules
+!     - Add water ice clouds
+!     MODIF R. Wordsworth (2009)
+!     - generalisation to arbitrary spectral bands 
+!
+!==================================================================
+
+#include "callkeys.h"
+!     Optical properties (read in external ASCII files)
+      INTEGER          :: nwvl  ! Number of wavelengths in
+                                ! the domain (VIS or IR)
+
+!      REAL             :: solsir ! visible to infrared ratio
+!                                ! (tau_0.67um/tau_9um)
+
+      REAL, DIMENSION(:),&
+      ALLOCATABLE, SAVE :: wvl  ! Wavelength axis
+      REAL, DIMENSION(:),&
+      ALLOCATABLE, SAVE :: radiusdyn ! Particle size axis
+
+      REAL, DIMENSION(:,:),&
+      ALLOCATABLE, SAVE :: ep,& ! Extinction coefficient Qext
+      omeg,&                    ! Single Scattering Albedo
+      gfactor                   ! Assymetry Factor
+
+!     Local variables:
+
+      INTEGER :: iaer           ! Aerosol index
+      INTEGER :: idomain        ! Domain index (1=VIS,2=IR)
+      INTEGER :: ilw            ! longwave index
+      INTEGER :: isw           ! shortwave index
+      INTEGER :: isize          ! Particle size index
+      INTEGER :: jfile          ! ASCII file scan index
+      INTEGER :: file_unit = 60
+      LOGICAL :: file_ok, endwhile
+      CHARACTER(LEN=132) :: scanline ! ASCII file scanning line
+
+!     I/O  of "aerave" (subroutine that spectrally averages
+!     the single scattering parameters)
+
+      REAL lamref                      ! reference wavelengths
+      REAL epref                       ! reference extinction ep
+
+!      REAL epav(L_NSPECTI)            ! Average ep (= <Qext>/Qext(lamref) if epref=1)
+!      REAL omegav(L_NSPECTI)          ! Average single scattering albedo
+!      REAL gav(L_NSPECTI)             ! Average assymetry parameter
+
+      REAL epavVI(L_NSPECTV)            ! Average ep (= <Qext>/Qext(lamref) if epref=1)
+      REAL omegavVI(L_NSPECTV)          ! Average single scattering albedo
+      REAL gavVI(L_NSPECTV)             ! Average assymetry parameter
+
+      REAL epavIR(L_NSPECTI)            ! Average ep (= <Qext>/Qext(lamref) if epref=1)
+      REAL omegavIR(L_NSPECTI)          ! Average single scattering albedo
+      REAL gavIR(L_NSPECTI)             ! Average assymetry parameter
+      
+      logical forgetit                  ! use francois' data?
+      integer iwvl
+
+!     Local saved variables:
+
+      CHARACTER(LEN=30), DIMENSION(naerkind,2), SAVE :: file_id
+!---- Please indicate the names of the optical property files below
+!     Please also choose the reference wavelengths of each aerosol
+
+      if (noaero) then
+        print*, 'naerkind= 0'
+      endif
+      do iaer=1,naerkind
+       if (iaer.eq.iaero_co2) then
+        forgetit=.true.
+          if (.not.noaero) then
+              print*, 'naerkind= co2', iaer
+          end if
+!     visible
+        if(forgetit)then
+           file_id(iaer,1) = 'optprop_co2_vis_ff.dat' ! Francois' values
+        else
+           file_id(iaer,1) = 'optprop_co2ice_vis_n50.dat'
+        endif
+        lamrefvis(iaer)=1.5E-6   ! 1.5um OMEGA/MEx ???
+
+!     infrared
+        if(forgetit)then
+           file_id(iaer,2) = 'optprop_co2_ir_ff.dat' ! Francois' values
+        else
+           file_id(iaer,2) = 'optprop_co2ice_ir_n50.dat'
+        endif
+        lamrefir(iaer)=12.1E-6   ! 825cm-1 TES/MGS ???
+       endif ! CO2 aerosols  
+! NOTE: these lamref's are currently for dust, not CO2 ice.
+! JB thinks this shouldn't matter too much, but it needs to be 
+! fixed / decided for the final version.
+
+       if (iaer.eq.iaero_h2o) then
+        print*, 'naerkind= h2o', iaer
+
+!     visible
+         file_id(iaer,1) = 'optprop_icevis_n50.dat'
+         lamrefvis(iaer)=1.5E-6   ! 1.5um OMEGA/MEx
+!     infrared
+         file_id(iaer,2) = 'optprop_iceir_n50.dat'
+         lamrefir(iaer)=12.1E-6   ! 825cm-1 TES/MGS
+       endif
+
+       if (iaer.eq.iaero_dust) then
+        print*, 'naerkind= dust', iaer
+
+!     visible
+         file_id(iaer,1) = 'optprop_dustvis_n50.dat'
+         !lamrefvis(iaer)=1.5E-6   ! 1.5um OMEGA/MEx
+         lamrefvis(iaer)=0.67e-6
+!     infrared
+         file_id(iaer,2) = 'optprop_dustir_n50.dat'
+         !lamrefir(iaer)=12.1E-6   ! 825cm-1 TES/MGS
+         lamrefir(iaer)=9.3E-6
+       endif 
+
+       if (iaer.eq.iaero_h2so4) then
+         print*, 'naerkind= h2so4', iaer
+
+!     visible
+         file_id(iaer,1) = 'optprop_h2so4vis_n20.dat'
+         !lamrefir(iaer)=  doesn't exist?
+         lamrefvis(iaer)=1.5E-6   ! no idea, must find
+!     infrared
+         file_id(iaer,2) = 'optprop_h2so4ir_n20.dat'
+         !lamrefir(iaer)=12.1E-6   ! 825cm-1 TES/MGS
+         lamrefir(iaer)=9.3E-6 ! no idea, must find
+! added by LK
+       endif
+
+       if (iaer.eq.iaero_back2lay) then
+         print*, 'naerkind= back2lay', iaer
+
+!     visible
+         file_id(iaer,1) = 'optprop_saturn_vis_n20.dat'
+         lamrefvis(iaer)=0.8E-6  ! 
+!     infrared
+         file_id(iaer,2) = 'optprop_saturn_ir_n20.dat'
+         lamrefir(iaer)=6.E-6  ! 
+! added by SG
+       endif
+       
+       
+      enddo
+
+!------------------------------------------------------------------
+
+!     Initializations:
+
+      radiustab(:,:,:) = 0.0
+      gvis(:,:,:)      = 0.0
+      omegavis(:,:,:)  = 0.0
+      QVISsQREF(:,:,:) = 0.0
+      gir(:,:,:)       = 0.0
+      omegair(:,:,:)   = 0.0
+      QIRsQREF(:,:,:)  = 0.0
+
+      DO iaer = 1, naerkind     ! Loop on aerosol kind
+         DO idomain = 1, 2      ! Loop on radiation domain (VIS or IR)
+!==================================================================
+!     1. READ OPTICAL PROPERTIES
+!==================================================================
+
+!     1.1 Open the ASCII file
+
+            INQUIRE(FILE=TRIM(datadir)//&
+         '/'//TRIM(file_id(iaer,idomain)),&
+            EXIST=file_ok)
+            IF(.NOT.file_ok) THEN
+               write(*,*)'suaer_corrk: Problem opening ',&
+               TRIM(file_id(iaer,idomain))
+               write(*,*)'It should be in: ',TRIM(datadir)
+               write(*,*)'1) You can set this directory address ',&
+               'in callphys.def with:'
+               write(*,*)' datadir = /absolute/path/to/datagcm'
+               write(*,*)'2) If ',&
+              TRIM(file_id(iaer,idomain)),&
+               ' is a LMD reference datafile, it'
+               write(*,*)' can be obtained online at:'
+               write(*,*)' http://www.lmd.jussieu.fr/',&
+               '~forget/datagcm/datafile'
+               CALL ABORT 
+            ENDIF
+            OPEN(UNIT=file_unit,&
+            FILE=TRIM(datadir)//&
+         '/'//TRIM(file_id(iaer,idomain)),&
+            FORM='formatted')
+
+!     1.2 Allocate the optical property table
+
+            jfile = 1
+            endwhile = .false.
+            DO WHILE (.NOT.endwhile)
+               READ(file_unit,*) scanline
+               IF ((scanline(1:1) .ne. '#').and.&
+               (scanline(1:1) .ne. ' ')) THEN
+               BACKSPACE(file_unit)
+               reading1_seq: SELECT CASE (jfile) ! ====================
+            CASE(1) reading1_seq ! nwvl ----------------------------
+               read(file_unit,*) nwvl
+               jfile = jfile+1
+            CASE(2) reading1_seq ! nsize ---------------------------
+               read(file_unit,*) nsize(iaer,idomain)
+               endwhile = .true.
+            CASE DEFAULT reading1_seq ! ---------------------------- 
+               WRITE(*,*) 'readoptprop: ',& 
+               'Error while loading optical properties.' 
+               CALL ABORT 
+            END SELECT reading1_seq ! ==============================
+         ENDIF
+      ENDDO
+
+      ALLOCATE(wvl(nwvl))       ! wvl
+      ALLOCATE(radiusdyn(nsize(iaer,idomain))) ! radiusdyn
+      ALLOCATE(ep(nwvl,nsize(iaer,idomain))) ! ep
+      ALLOCATE(omeg(nwvl,nsize(iaer,idomain))) ! omeg 
+      ALLOCATE(gfactor(nwvl,nsize(iaer,idomain))) ! g
+
+
+!     1.3 Read the data
+
+      jfile = 1
+      endwhile = .false.
+      DO WHILE (.NOT.endwhile)
+         READ(file_unit,*) scanline
+         IF ((scanline(1:1) .ne. '#').and.&
+         (scanline(1:1) .ne. ' ')) THEN
+         BACKSPACE(file_unit)
+         reading2_seq: SELECT CASE (jfile) ! ====================
+      CASE(1) reading2_seq      ! wvl -----------------------------
+         read(file_unit,*) wvl
+         jfile = jfile+1
+      CASE(2) reading2_seq      ! radiusdyn -----------------------
+         read(file_unit,*) radiusdyn
+         jfile = jfile+1
+      CASE(3) reading2_seq      ! ep ------------------------------
+         isize = 1
+         DO WHILE (isize .le. nsize(iaer,idomain))
+            READ(file_unit,*) scanline
+            IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+            BACKSPACE(file_unit)
+            read(file_unit,*) ep(:,isize)
+            isize = isize + 1
+         ENDIF
+      ENDDO
+
+      jfile = jfile+1
+      CASE(4) reading2_seq      ! omeg ----------------------------
+         isize = 1
+         DO WHILE (isize .le. nsize(iaer,idomain))
+            READ(file_unit,*) scanline
+            IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+            BACKSPACE(file_unit)
+            read(file_unit,*) omeg(:,isize)
+            isize = isize + 1
+         ENDIF
+      ENDDO
+
+      jfile = jfile+1
+      CASE(5) reading2_seq      ! gfactor -------------------------
+         isize = 1
+         DO WHILE (isize .le. nsize(iaer,idomain))
+            READ(file_unit,*) scanline
+            IF ((scanline(1:1) .ne. '#').and.&
+            (scanline(1:1) .ne. ' ')) THEN
+            BACKSPACE(file_unit)
+            read(file_unit,*) gfactor(:,isize)
+            isize = isize + 1
+         ENDIF
+      ENDDO
+
+      jfile = jfile+1
+      IF ((idomain.NE.iaero_co2).OR.(iaer.NE.iaero_co2)) THEN
+         endwhile = .true.
+      ENDIF
+      CASE(6) reading2_seq
+         endwhile = .true.
+      CASE DEFAULT reading2_seq ! ----------------------------
+         WRITE(*,*) 'readoptprop: ',&
+         'Error while loading optical properties.'
+         CALL ABORT
+      END SELECT reading2_seq   ! ==============================
+      ENDIF
+      ENDDO
+
+!     1.4 Close the file
+
+      CLOSE(file_unit)
+
+!     1.5 If Francois' data, convert wvl to metres
+       if(iaer.eq.iaero_co2)then
+         if(forgetit)then
+         !   print*,'please sort out forgetit for naerkind>1'
+            do iwvl=1,nwvl
+               wvl(iwvl)=wvl(iwvl)*1.e-6
+            enddo
+         endif
+      endif
+
+
+
+
+
+
+!==================================================================
+!     2. AVERAGED PROPERTIES AND VARIABLE ASSIGNMENTS
+!==================================================================
+      domain: SELECT CASE (idomain)
+!==================================================================
+      CASE(1) domain            !       VISIBLE DOMAIN (idomain=1)
+!==================================================================
+
+         lamref=lamrefvis(iaer)
+         epref=1.E+0
+
+         DO isize=1,nsize(iaer,idomain)
+
+!     Save the particle sizes
+            radiustab(iaer,idomain,isize)=radiusdyn(isize)
+
+!     Averaged optical properties (GCM channels)
+
+!            CALL aerave ( nwvl,&
+!            wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+!            lamref,epref,tstellar,&
+!            L_NSPECTV,blamv,epavVI,&
+!            omegavVI,gavVI,QREFvis(iaer,isize))!,omegaREFir(iaer,isize))
+            CALL aerave_new ( nwvl,&
+            wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+            lamref,epref,tstellar,&
+            L_NSPECTV,blamv,epavVI,&
+            omegavVI,gavVI,QREFvis(iaer,isize),omegaREFir(iaer,isize))
+
+!     Variable assignments (declared in radcommon)
+            DO isw=1,L_NSPECTV
+               QVISsQREF(isw,iaer,isize)=epavVI(isw)
+               gvis(isw,iaer,isize)=gavVI(isw)
+               omegavis(isw,iaer,isize)=omegavVI(isw)
+            END DO
+
+         ENDDO
+
+!==================================================================
+      CASE(2) domain            !      INFRARED DOMAIN (idomain=2)
+!==================================================================
+
+
+         DO isize=1,nsize(iaer,idomain) ! ----------------------------------
+
+            lamref=lamrefir(iaer)
+            epref=1.E+0
+
+!     Save the particle sizes
+            radiustab(iaer,idomain,isize)=radiusdyn(isize)
+
+!     Averaged optical properties (GCM channels)
+
+!     epav is <QIR>/Qext(lamrefir) since epref=1
+!     Note: aerave also computes the extinction coefficient at
+!     the reference wavelength. This is called QREFvis or QREFir
+!     (not epref, which is a different parameter).
+!     Reference wavelengths SHOULD BE defined for each aerosol in
+!     radcommon_h.F90
+
+!            CALL aerave ( nwvl,&
+!            wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+!            lamref,epref,tplanet,&
+!            L_NSPECTI,blami,epavIR,&
+!            omegavIR,gavIR,QREFir(iaer,isize))!,omegaREFir(iaer,isize))
+            CALL aerave_new ( nwvl,&
+            wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),&
+            lamref,epref,tplanet,&
+            L_NSPECTI,blami,epavIR,&
+            omegavIR,gavIR,QREFir(iaer,isize),omegaREFir(iaer,isize))
+
+
+!     Variable assignments (declared in radcommon)
+            DO ilw=1,L_NSPECTI
+               QIRsQREF(ilw,iaer,isize)=epavIR(ilw)
+               gir(ilw,iaer,isize)=gavIR(ilw)
+               omegair(ilw,iaer,isize)=omegavIR(ilw)
+            END DO
+
+
+      ENDDO                     ! isize (particle size) -------------------------------------
+
+      END SELECT domain
+
+!========================================================================
+!     3. Deallocate temporary variables that were read in the ASCII files
+!========================================================================
+
+      DEALLOCATE(wvl)           ! wvl
+      DEALLOCATE(radiusdyn)     ! radiusdyn
+      DEALLOCATE(ep)            ! ep 
+      DEALLOCATE(omeg)          ! omeg 
+      DEALLOCATE(gfactor)       ! g
+
+      END DO                    ! Loop on iaer
+      END DO                    ! Loop on idomain
+!========================================================================
+
+      RETURN
+
+
+
+    END subroutine suaer_corrk
+      
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sugas_corrk.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sugas_corrk.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/sugas_corrk.F90	(revision 222)
@@ -0,0 +1,661 @@
+      subroutine sugas_corrk
+
+!==================================================================
+!
+!     Purpose
+!     -------
+!     Set up gaseous absorption parameters used by the radiation code.
+!     This subroutine is a replacement for the old 'setrad', which contained
+!     both absorption and scattering data.
+!
+!     Authors
+!     -------
+!     Adapted and generalised from the NASA Ames code by Robin Wordsworth (2009)
+!     Added double gray case by Jeremy Leconte (2012)
+!     New HITRAN continuum data section by RW (2012)
+!
+!     Summary
+!     -------
+!
+!==================================================================
+
+      use radinc_h
+      use radcommon_h, only : pgasref,pfgasref,pgasmin,pgasmax
+      use radcommon_h, only : tgasref,tgasmin,tgasmax
+      use radcommon_h, only : gasv,gasi,FZEROI,FZEROV,gweight
+      use radcommon_h, only : wrefvar,WNOI,WNOV
+      use datafile_mod, only: datadir
+
+      use gases_h
+      use ioipsl_getincom 
+      implicit none
+
+#include "callkeys.h"
+#include "comcstfi.h"
+
+!==================================================================
+
+      logical file_ok
+
+      integer n, nt, np, nh, ng, nw, m, i
+      integer L_NGAUSScheck
+
+      character(len=200) :: file_id
+      character(len=500) :: file_path
+
+      ! ALLOCATABLE ARRAYS -- AS 12/2011
+      REAL*8, DIMENSION(:,:,:,:,:), ALLOCATABLE :: gasi8, gasv8
+      character*20,allocatable,DIMENSION(:) :: gastype ! for check with gnom
+
+      real*8 x, xi(4), yi(4), ans, p
+!     For gray case (JL12)
+      real kappa_IR, kappa_VI, IR_VI_wnlimit
+      integer nVI_limit,nIR_limit
+
+      integer ngas, igas, jgas
+
+      double precision testcont ! for continuum absorption initialisation
+
+      integer :: dummy
+
+!=======================================================================
+!     Load variable species data, exit if we have wrong database
+      file_id='/corrk_data/' // TRIM(corrkdir) // '/Q.dat'
+      file_path=TRIM(datadir)//TRIM(file_id)
+
+      ! check that the file exists
+      inquire(FILE=file_path,EXIST=file_ok)
+      if(.not.file_ok) then
+         write(*,*)'The file ',TRIM(file_path)
+         write(*,*)'was not found by sugas_corrk.F90, exiting.'
+         write(*,*)'Check that your path to datagcm:',trim(datadir)
+         write(*,*)' is correct. You can change it in callphys.def with:'
+         write(*,*)' datadir = /absolute/path/to/datagcm'
+         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
+         call abort
+      endif
+
+      ! check that database matches varactive toggle
+      open(111,file=TRIM(file_path),form='formatted')
+      read(111,*) ngas
+
+      if(ngas.ne.ngasmx)then
+         print*,'Number of gases in radiative transfer data (',ngas,') does not', &
+                'match that in gases.def (',ngasmx,'), exiting.'
+         call abort
+      endif 
+
+      if(ngas.eq.1 .and. (varactive.or.varfixed))then
+         print*,'You have varactive/fixed=.true. but the database [',  &
+                     corrkdir(1:LEN_TRIM(corrkdir)),           &
+                '] has no variable species, exiting.'
+         call abort
+      elseif(ngas.gt.5 .or. ngas.lt.1)then
+         print*,ngas,' species in database [',               &
+                     corrkdir(1:LEN_TRIM(corrkdir)),           &
+                '], radiative code cannot handle this.'
+         call abort
+      endif 
+
+      ! dynamically allocate gastype and read from Q.dat
+      IF ( .NOT. ALLOCATED( gastype ) ) ALLOCATE( gastype( ngas ) )
+
+      do igas=1,ngas
+         read(111,*) gastype(igas)
+         print*,'Gas ',igas,' is ',gastype(igas)
+      enddo
+
+      ! get array size, load the coefficients
+      open(111,file=TRIM(file_path),form='formatted')
+      read(111,*) L_REFVAR
+      IF( .NOT. ALLOCATED( wrefvar ) ) ALLOCATE( WREFVAR(L_REFVAR) )
+      read(111,*) wrefvar
+      close(111)
+
+      if(L_REFVAR.gt.1 .and. (.not.varactive) .and. (.not.varfixed))then
+         print*,'You have varactive and varfixed=.false. and the database [', &
+                     corrkdir(1:LEN_TRIM(corrkdir)),           &
+                '] has a variable species.'
+         call abort
+      endif
+
+      ! Check that gastype and gnom match
+      do igas=1,ngas
+         print*,'Gas ',igas,' is ',trim(gnom(igas))
+         if (trim(gnom(igas)).ne.trim(gastype(igas))) then
+            print*,'Name of a gas in radiative transfer data (',trim(gastype(igas)),') does not ', &
+                 'match that in gases.def (',trim(gnom(igas)),'), exiting. You should compare ', &
+                 'gases.def with Q.dat in your radiative transfer directory.' 
+            call abort
+         endif
+      enddo
+      print*,'Confirmed gas match in radiative transfer and gases.def!'
+
+      ! display the values
+      print*,'Variable gas volume mixing ratios:'
+      do n=1,L_REFVAR
+         !print*,n,'.',wrefvar(n),' kg/kg' ! pay attention!
+         print*,n,'.',wrefvar(n),' mol/mol'
+      end do
+      print*,''
+
+!=======================================================================
+!     Set the weighting in g-space
+
+      file_id='/corrk_data/' // TRIM(corrkdir) // '/g.dat'
+      file_path=TRIM(datadir)//TRIM(file_id)
+
+      ! check that the file exists
+      inquire(FILE=file_path,EXIST=file_ok)
+      if(.not.file_ok) then
+         write(*,*)'The file ',TRIM(file_path)
+         write(*,*)'was not found by sugas_corrk.F90, exiting.'
+         write(*,*)'Check that your path to datagcm:',trim(datadir)
+         write(*,*)' is correct. You can change it in callphys.def with:'
+         write(*,*)' datadir = /absolute/path/to/datagcm'
+         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
+         call abort
+      endif
+      
+      ! check the array size is correct, load the coefficients
+      open(111,file=TRIM(file_path),form='formatted')
+      read(111,*) L_NGAUSScheck
+      if(.not.(L_NGAUSScheck.eq.L_NGAUSS)) then
+         print*,'The size of your radiative transfer g-space array does '
+         print*,'not match the value given in g.dat, exiting.'
+         call abort
+      endif
+      read(111,*) gweight
+      close(111)
+ 
+      ! display the values
+      print*,'Correlated-k g-space grid:'
+      do n=1,L_NGAUSS
+         print*,n,'.',gweight(n)
+      end do
+      print*,''
+
+!=======================================================================
+!     Set the reference pressure and temperature arrays.  These are
+!     the pressures and temperatures at which we have k-coefficients.
+
+!-----------------------------------------------------------------------
+! pressure
+
+      file_id='/corrk_data/' // TRIM(corrkdir) // '/p.dat'
+      file_path=TRIM(datadir)//TRIM(file_id)
+
+      ! check that the file exists
+      inquire(FILE=file_path,EXIST=file_ok)
+      if(.not.file_ok) then
+         write(*,*)'The file ',TRIM(file_path)
+         write(*,*)'was not found by sugas_corrk.F90, exiting.'
+         write(*,*)'Check that your path to datagcm:',trim(datadir)
+         write(*,*)' is correct. You can change it in callphys.def with:'
+         write(*,*)' datadir = /absolute/path/to/datagcm'
+         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
+         call abort
+      endif
+     
+      ! get array size, load the coefficients
+      open(111,file=TRIM(file_path),form='formatted')
+      read(111,*) L_NPREF
+      IF( .NOT. ALLOCATED( pgasref ) ) ALLOCATE( PGASREF(L_NPREF) )
+      read(111,*) pgasref
+      close(111)
+      L_PINT = (L_NPREF-1)*5+1
+      IF( .NOT. ALLOCATED( pfgasref ) ) ALLOCATE( PFGASREF(L_PINT) )
+
+      ! display the values
+      print*,'Correlated-k pressure grid (mBar):'
+      do n=1,L_NPREF
+         print*,n,'. 1 x 10^',pgasref(n),' mBar'
+      end do
+      print*,''
+
+      ! save the min / max matrix values
+      pgasmin = 10.0**pgasref(1)
+      pgasmax = 10.0**pgasref(L_NPREF)
+
+      ! interpolate to finer grid
+      do n=1,L_NPREF-1
+         do m=1,5
+            pfgasref((n-1)*5+m) = pgasref(n)+(m-1)*0.2
+         end do
+      end do
+      pfgasref(L_PINT) = pgasref(L_NPREF)
+      ! Warning, pfgasref needs generalisation to uneven grids!
+
+!-----------------------------------------------------------------------
+! temperature
+
+      file_id='/corrk_data/' // TRIM(corrkdir) // '/T.dat'
+      file_path=TRIM(datadir)//TRIM(file_id)
+
+      ! check that the file exists
+      inquire(FILE=file_path,EXIST=file_ok)
+      if(.not.file_ok) then
+         write(*,*)'The file ',TRIM(file_path)
+         write(*,*)'was not found by sugas_corrk.F90, exiting.'
+         write(*,*)'Check that your path to datagcm:',trim(datadir)
+         write(*,*)' is correct. You can change it in callphys.def with:'
+         write(*,*)' datadir = /absolute/path/to/datagcm'
+         write(*,*)'Also check that the corrkdir you chose in callphys.def exists.'
+         call abort
+      endif
+
+      ! get array size, load the coefficients
+      open(111,file=TRIM(file_path),form='formatted')
+      read(111,*) L_NTREF
+      IF( .NOT. ALLOCATED( tgasref ) ) ALLOCATE( TGASREF(L_NTREF) )
+      read(111,*) tgasref
+      close(111)
+
+      ! display the values
+      print*,'Correlated-k temperature grid:'
+      do n=1,L_NTREF
+         print*,n,'.',tgasref(n),' K'
+      end do
+
+      ! save the min / max matrix values
+      tgasmin = tgasref(1)
+      tgasmax = tgasref(L_NTREF)
+
+!-----------------------------------------------------------------------
+! allocate the multidimensional arrays in radcommon_h
+
+      IF( .NOT. ALLOCATED( gasi8 ) ) ALLOCATE( gasi8(L_NTREF,L_NPREF,L_REFVAR,L_NSPECTI,L_NGAUSS) )
+      IF( .NOT. ALLOCATED( gasv8 ) ) ALLOCATE( gasv8(L_NTREF,L_NPREF,L_REFVAR,L_NSPECTV,L_NGAUSS) )
+      IF( .NOT. ALLOCATED( gasi ) ) ALLOCATE( gasi(L_NTREF,L_PINT,L_REFVAR,L_NSPECTI,L_NGAUSS) )
+      IF( .NOT. ALLOCATED( gasv ) ) ALLOCATE( gasv(L_NTREF,L_PINT,L_REFVAR,L_NSPECTV,L_NGAUSS) )
+
+      ! display the values
+      print*,''
+      print*,'Correlated-k matrix size:' 
+      print*,'[',L_NTREF,',',L_NPREF,',',L_REFVAR,',',L_NGAUSS,']' 
+
+!=======================================================================
+!     Get gaseous k-coefficients and interpolate onto finer pressure grid
+
+
+!        wavelength used to separate IR from VI in graybody. We will need that anyway
+         IR_VI_wnlimit=3000.
+         write(*,*)"graybody: Visible / Infrared separation set at",10000./IR_VI_wnlimit,"um"
+	 
+	 nVI_limit=0
+	 Do nw=1,L_NSPECTV
+	    if ((WNOV(nw).gt.IR_VI_wnlimit).and.(L_NSPECTV.gt.1)) then
+	       nVI_limit=nw-1
+	       exit
+	    endif
+	 End do
+	 nIR_limit=L_NSPECTI
+	 Do nw=1,L_NSPECTI
+	    if ((WNOI(nw).gt.IR_VI_wnlimit).and.(L_NSPECTI.gt.1)) then
+	       nIR_limit=nw-1
+	       exit
+	    endif
+	 End do
+
+      if (graybody) then
+!        constant absorption coefficient in visible
+         write(*,*)"graybody: constant absorption coefficient in visible:"
+         kappa_VI=-100000.
+         call getin("kappa_VI",kappa_VI)
+         write(*,*)" kappa_VI = ",kappa_VI
+	 kappa_VI=kappa_VI*1.e4* mugaz * 1.672621e-27	 ! conversion from m^2/kg to cm^2/molecule         
+      
+!        constant absorption coefficient in IR
+         write(*,*)"graybody: constant absorption coefficient in InfraRed:"
+         kappa_IR=-100000.
+         call getin("kappa_IR",kappa_IR)
+         write(*,*)" kappa_IR = ",kappa_IR	 
+         kappa_IR=kappa_IR*1.e4* mugaz * 1.672621e-27	 ! conversion from m^2/kg to cm^2/molecule 
+
+         write(*,*)"graybody: Visible / Infrared separation set at band: IR=",nIR_limit,", VI=",nVI_limit
+	       
+      Else
+         kappa_VI=1.e-30      
+         kappa_IR=1.e-30        
+      End if
+
+!      print*,corrkdir(1:4)
+      ! VISIBLE
+      if (callgasvis) then
+         if ((corrkdir(1:4).eq.'null'))then   !(TRIM(corrkdir).eq.'null_LowTeffStar')) then
+            gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)=0.0
+            print*,'using no corrk data'
+            print*,'Visible corrk gaseous absorption is set to zero if graybody=F'
+	 else
+            file_id='/corrk_data/'//trim(adjustl(banddir))//'/corrk_gcm_VI.dat' 
+            file_path=TRIM(datadir)//TRIM(file_id)
+            
+            ! check that the file exists
+            inquire(FILE=file_path,EXIST=file_ok)
+            if(.not.file_ok) then
+               write(*,*)'The file ',TRIM(file_path)
+               write(*,*)'was not found by sugas_corrk.F90.'
+               write(*,*)'Are you sure you have absorption data for these bands?'
+               call abort
+            endif
+         
+            open(111,file=TRIM(file_path),form='formatted')
+            read(111,*) gasv8
+            close(111)
+	 end if
+
+         if(nVI_limit.eq.0) then
+	    gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)=   &
+	          gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)+kappa_VI
+         else if (nVI_limit.eq.L_NSPECTV) then
+	    gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)=   &
+	          gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)+kappa_IR
+	 else
+	    gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:nVI_limit,1:L_NGAUSS)=   &
+	          gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:nVI_limit,1:L_NGAUSS)+kappa_IR
+	    gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,nVI_limit+1:L_NSPECTV,1:L_NGAUSS)=   &
+	          gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,nVI_limit+1:L_NSPECTV,1:L_NGAUSS)+kappa_VI
+	 end if
+      else
+         print*,'Visible corrk gaseous absorption is set to zero.'
+         gasv8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTV,1:L_NGAUSS)=0.0
+      endif
+
+      ! INFRA-RED
+      if ((corrkdir(1:4).eq.'null'))then       !.or.(TRIM(corrkdir).eq.'null_LowTeffStar')) then
+         print*,'Infrared corrk gaseous absorption is set to zero if graybody=F'
+         gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)=0.0
+      else  
+         file_id='/corrk_data/'//trim(adjustl(banddir))//'/corrk_gcm_IR.dat' 
+         file_path=TRIM(datadir)//TRIM(file_id)
+      
+         ! check that the file exists
+         inquire(FILE=file_path,EXIST=file_ok)
+         if(.not.file_ok) then
+            write(*,*)'The file ',TRIM(file_path)
+            write(*,*)'was not found by sugas_corrk.F90.'
+            write(*,*)'Are you sure you have absorption data for these bands?'
+            call abort
+         endif
+         
+         open(111,file=TRIM(file_path),form='formatted')
+         read(111,*) gasi8
+         close(111)
+     
+         ! 'fzero' is a currently unused feature that allows optimisation
+         ! of the radiative transfer by neglecting bands where absorption
+         ! is close to zero. As it could be useful in the future, this 
+         ! section of the code has been kept commented and not erased.
+         ! RW 7/3/12.
+
+         do nw=1,L_NSPECTI
+            fzeroi(nw) = 0.d0
+!            do nt=1,L_NTREF
+!               do np=1,L_NPREF
+!                  do nh=1,L_REFVAR
+!                     do ng = 1,L_NGAUSS
+!                        if(gasi8(nt,np,nh,nw,ng).lt.1.0e-25)then
+!                           fzeroi(nw)=fzeroi(nw)+1.d0
+!                        endif
+!                     end do
+!                  end do
+!               end do
+!            end do
+!            fzeroi(nw)=fzeroi(nw)/dble(L_NTREF*L_NPREF*L_REFVAR*L_NGAUSS)
+         end do
+
+         do nw=1,L_NSPECTV
+            fzerov(nw) = 0.d0
+!            do nt=1,L_NTREF
+!               do np=1,L_NPREF
+!                  do nh=1,L_REFVAR
+!                     do ng = 1,L_NGAUSS
+!                        if(gasv8(nt,np,nh,nw,ng).lt.1.0e-25)then
+!                           fzerov(nw)=fzerov(nw)+1.d0
+!                        endif
+!                     end do
+!                  end do
+!               end do
+!            end do
+!            fzerov(nw)=fzerov(nw)/dble(L_NTREF*L_NPREF*L_REFVAR*L_NGAUSS)
+         end do
+
+      endif
+
+      if(nIR_limit.eq.0) then
+         gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)=   &
+	          gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)+kappa_VI
+      else if (nIR_limit.eq.L_NSPECTI) then
+	 gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)=   &
+	          gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:L_NSPECTI,1:L_NGAUSS)+kappa_IR
+      else
+	 gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:nIR_limit,1:L_NGAUSS)=   &
+	          gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,1:nIR_limit,1:L_NGAUSS)+kappa_IR
+	 gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,nIR_limit+1:L_NSPECTI,1:L_NGAUSS)=   &
+	          gasi8(1:L_NTREF,1:L_NPREF,1:L_REFVAR,nIR_limit+1:L_NSPECTI,1:L_NGAUSS)+kappa_VI
+      end if
+
+
+!     Take log10 of the values - this is what we will interpolate.
+!     Smallest value is 1.0E-200.
+
+      do nt=1,L_NTREF
+         do np=1,L_NPREF
+            do nh=1,L_REFVAR
+               do ng = 1,L_NGAUSS
+
+                  do nw=1,L_NSPECTV
+                     if(gasv8(nt,np,nh,nw,ng).gt.1.0d-200) then
+                        gasv8(nt,np,nh,nw,ng) = log10(gasv8(nt,np,nh,nw,ng))
+                     else
+                        gasv8(nt,np,nh,nw,ng) = -200.0
+                     end if
+                  end do
+
+                  do nw=1,L_NSPECTI
+                     if(gasi8(nt,np,nh,nw,ng).gt.1.0d-200) then
+                        gasi8(nt,np,nh,nw,ng) = log10(gasi8(nt,np,nh,nw,ng))
+                     else
+                        gasi8(nt,np,nh,nw,ng) = -200.0
+                     end if
+                  end do
+                  
+               end do
+            end do
+         end do
+      end do
+
+!     Interpolate the values:  first the longwave
+
+      do nt=1,L_NTREF
+         do nh=1,L_REFVAR
+            do nw=1,L_NSPECTI
+               do ng=1,L_NGAUSS
+
+!     First, the initial interval
+
+                  n = 1 
+                  do m=1,5
+                     x     = pfgasref(m)
+                     xi(1) = pgasref(n)
+                     xi(2) = pgasref(n+1)
+                     xi(3) = pgasref(n+2)
+                     xi(4) = pgasref(n+3)
+                     yi(1) = gasi8(nt,n,nh,nw,ng)
+                     yi(2) = gasi8(nt,n+1,nh,nw,ng)
+                     yi(3) = gasi8(nt,n+2,nh,nw,ng)
+                     yi(4) = gasi8(nt,n+3,nh,nw,ng)
+                     call lagrange(x,xi,yi,ans)
+                     gasi(nt,m,nh,nw,ng) = 10.0**ans
+                  end do 
+                  
+                  do n=2,L_NPREF-2
+                     do m=1,5
+                        i     = (n-1)*5+m
+                        x     = pfgasref(i)
+                        xi(1) = pgasref(n-1)
+                        xi(2) = pgasref(n)
+                        xi(3) = pgasref(n+1)
+                        xi(4) = pgasref(n+2)
+                        yi(1) = gasi8(nt,n-1,nh,nw,ng)
+                        yi(2) = gasi8(nt,n,nh,nw,ng)
+                        yi(3) = gasi8(nt,n+1,nh,nw,ng)
+                        yi(4) = gasi8(nt,n+2,nh,nw,ng)
+                        call lagrange(x,xi,yi,ans)
+                        gasi(nt,i,nh,nw,ng) = 10.0**ans
+                     end do 
+                  end do
+
+!     Now, get the last interval
+
+                  n = L_NPREF-1                 
+                  do m=1,5
+                     i     = (n-1)*5+m
+                     x     = pfgasref(i)
+                     xi(1) = pgasref(n-2)
+                     xi(2) = pgasref(n-1)
+                     xi(3) = pgasref(n)
+                     xi(4) = pgasref(n+1)
+                     yi(1) = gasi8(nt,n-2,nh,nw,ng)
+                     yi(2) = gasi8(nt,n-1,nh,nw,ng)
+                     yi(3) = gasi8(nt,n,nh,nw,ng)
+                     yi(4) = gasi8(nt,n+1,nh,nw,ng)
+                     call lagrange(x,xi,yi,ans)
+                     gasi(nt,i,nh,nw,ng) = 10.0**ans
+                  end do  
+
+!     Fill the last pressure point
+
+                  gasi(nt,L_PINT,nh,nw,ng) = &
+                       10.0**gasi8(nt,L_NPREF,nh,nw,ng)
+
+               end do
+            end do
+         end do
+      end do
+
+!     Interpolate the values:  now the shortwave
+
+      do nt=1,L_NTREF
+         do nh=1,L_REFVAR
+            do nw=1,L_NSPECTV
+               do ng=1,L_NGAUSS
+
+!     First, the initial interval
+
+                  n = 1 
+                  do m=1,5
+                     x     = pfgasref(m)
+                     xi(1) = pgasref(n)
+                     xi(2) = pgasref(n+1)
+                     xi(3) = pgasref(n+2)
+                     xi(4) = pgasref(n+3)
+                     yi(1) = gasv8(nt,n,nh,nw,ng)
+                     yi(2) = gasv8(nt,n+1,nh,nw,ng)
+                     yi(3) = gasv8(nt,n+2,nh,nw,ng)
+                     yi(4) = gasv8(nt,n+3,nh,nw,ng)
+                     call lagrange(x,xi,yi,ans)
+                     gasv(nt,m,nh,nw,ng) = 10.0**ans
+                  end do 
+                  
+                  do n=2,L_NPREF-2
+                     do m=1,5
+                        i     = (n-1)*5+m
+                        x     = pfgasref(i)
+                        xi(1) = pgasref(n-1)
+                        xi(2) = pgasref(n)
+                        xi(3) = pgasref(n+1)
+                        xi(4) = pgasref(n+2)
+                        yi(1) = gasv8(nt,n-1,nh,nw,ng)
+                        yi(2) = gasv8(nt,n,nh,nw,ng)
+                        yi(3) = gasv8(nt,n+1,nh,nw,ng)
+                        yi(4) = gasv8(nt,n+2,nh,nw,ng)
+                        call lagrange(x,xi,yi,ans)
+                        gasv(nt,i,nh,nw,ng) = 10.0**ans
+                     end do 
+                  end do
+
+!     Now, get the last interval
+
+                  n = L_NPREF-1
+                  do m=1,5
+                     i     = (n-1)*5+m
+                     x     = pfgasref(i)
+                     xi(1) = pgasref(n-2)
+                     xi(2) = pgasref(n-1)
+                     xi(3) = pgasref(n)
+                     xi(4) = pgasref(n+1)
+                     yi(1) = gasv8(nt,n-2,nh,nw,ng)
+                     yi(2) = gasv8(nt,n-1,nh,nw,ng)
+                     yi(3) = gasv8(nt,n,nh,nw,ng)
+                     yi(4) = gasv8(nt,n+1,nh,nw,ng)
+                     call lagrange(x,xi,yi,ans)
+                     gasv(nt,i,nh,nw,ng) = 10.0**ans
+                  end do  
+
+!     Fill the last pressure point
+
+                  gasv(nt,L_PINT,nh,nw,ng) = &
+                      10.0**gasv8(nt,L_NPREF,nh,nw,ng)
+                  
+               end do
+            end do
+         end do
+      end do
+
+
+!=======================================================================
+!     Initialise the continuum absorption data
+      if(continuum)then
+      do igas=1,ngasmx
+
+         if (igas .eq. igas_N2) then
+
+            dummy = -9999
+            call interpolateN2N2(100.D+0,250.D+0,17500.D+0,testcont,.true.,dummy)
+
+         elseif (igas .eq. igas_H2) then
+
+            ! first do self-induced absorption
+            dummy = -9999
+            call interpolateH2H2(500.D+0,250.D+0,17500.D+0,testcont,.true.,dummy)
+            ! then cross-interactions with other gases
+            do jgas=1,ngasmx
+               if (jgas .eq. igas_N2) then
+                  dummy = -9999
+                  call interpolateN2H2(592.D+0,278.15D+0,200000.D+0,10000.D+0,testcont,.true.,dummy)
+               elseif (jgas .eq. igas_He) then
+                  dummy = -9999
+                  call interpolateH2He(500.D+0,250.D+0,200000.D+0,10000.D+0,testcont,.true.,dummy)
+               endif
+            enddo
+
+         elseif (igas .eq. igas_H2O) then
+
+            ! H2O is special 
+            if(H2Ocont_simple)then
+               call interpolateH2Ocont_PPC(990.D+0,296.D+0,683.2D+0*2,0.D+0,testcont,.true.)
+            else
+               dummy = -9999
+               call interpolateH2Ocont_CKD(990.D+0,296.D+0,683.2D+0*2,0.D+0,testcont,.true.,dummy)
+            endif
+
+         endif
+
+      enddo
+      endif
+
+      print*,'----------------------------------------------------'
+      print*,'And that`s all we have. It`s possible that other'
+      print*,'continuum absorption may be present, but if it is we'
+      print*,'don`t yet have data for it...'
+      print*,''
+
+!     Deallocate local arrays
+      IF( ALLOCATED( gasi8 ) ) DEALLOCATE( gasi8 )
+      IF( ALLOCATED( gasv8 ) ) DEALLOCATE( gasv8 )
+      IF( ALLOCATED( pgasref ) ) DEALLOCATE( pgasref )
+      IF( ALLOCATED( gastype ) ) DEALLOCATE( gastype )
+
+      return
+    end subroutine sugas_corrk
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surf_heat_transp_mod.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surf_heat_transp_mod.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surf_heat_transp_mod.F90	(revision 222)
@@ -0,0 +1,233 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/ocean_slab_mod.F90,v 1.3 2008-02-04 16:24:28 fairhead Exp $
+!
+MODULE surf_heat_transp_mod
+
+
+CONTAINS
+
+      SUBROUTINE divgrad_phy(nlevs,temp,delta)
+
+
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "comcstfi.h"
+#include "comgeom.h"
+#include "comhdiff.h"
+      
+      INTEGER nlevs, ll
+      REAL temp(ngridmx,nlevs)
+      REAL delta_2d(ip1jmp1,nlevs)
+      REAL delta(ngridmx,nlevs)
+      REAL ghx(ip1jmp1,nlevs), ghy(ip1jm,nlevs)
+
+
+      CALL gr_fi_dyn(nlevs,ngridmx,iip1,jjp1,temp,delta_2d)
+      CALL grad(nlevs,delta_2d,ghx,ghy)
+      DO ll=1,nlevs
+          ghx(:,ll)=ghx(:,ll)*zmasqu
+! pas de diffusion zonale  
+!          ghx(:,ll)=0.
+          ghy(:,ll)=ghy(:,ll)*zmasqv
+      END DO
+      CALL diverg(nlevs,ghx,ghy,delta_2d)
+      CALL gr_dyn_fi(nlevs,iip1,jjp1,ngridmx,delta_2d,delta)
+
+
+  END SUBROUTINE divgrad_phy
+
+
+
+      SUBROUTINE init_masquv(zmasq)
+     
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "comcstfi.h"   
+#include "comgeom.h"
+#include "comhdiff.h"
+
+
+      REAL zmasq(ngridmx)
+      REAL zmasq_2d(ip1jmp1)
+      REAL ff(ip1jm)
+      REAL eps
+      INTEGER i
+
+
+! Masques u,v
+      zmasqu=1.
+      zmasqv=1.
+
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zmasq,zmasq_2d)
+
+      DO i=1,ip1jmp1-1
+        IF (zmasq_2d(i).GT.1e-5 .OR. zmasq_2d(i+1).GT.1e-5) THEN
+                zmasqu(i)=0.
+        ENDIF
+      END DO
+      DO i=iip1,ip1jmp1,iip1
+        zmasqu(i)=zmasqu(i-iim)
+      END DO
+      DO i=1,ip1jm
+        IF (zmasq_2d(i).GT.1e-5 .OR. zmasq_2d(i+iip1).GT.1e-5) THEN  
+                zmasqv(i)=0.
+        END IF
+      END DO
+
+
+! Coriolis (pour Ekman transp.)
+      eps=1e-5
+!      CALL getin('slab_eps',eps)
+!      print *,'epsilon=',eps
+      ff=fext*unsairez       
+      DO i=1,ip1jm
+        unsev(i)=eps/(ff(i)*ff(i)+eps**2)
+        unsfv(i)=ff(i)/(ff(i)*ff(i)+eps**2)
+      ENDDO
+      CALL gr_v_scal(1,unsfv,unsfu)
+      CALL gr_v_scal(1,unsev,unseu)
+! Alpha variable?
+!      alpha_var=.FALSE.
+!      CALL getin('slab_alphav',alpha_var)
+
+
+      
+  END SUBROUTINE init_masquv
+
+
+
+      SUBROUTINE slab_ekman2(tx_phy,ty_phy,ts_phy,dt_phy)
+  
+          use slab_ice_h 
+
+      IMPLICIT NONE
+      
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comgeom.h"
+#include "comhdiff.h"
+
+      INTEGER ij
+      REAL txv(ip1jm),fluxm(ip1jm),tyv(ip1jm)
+      REAL fluxtm(ip1jm,noceanmx),fluxtz(ip1jmp1,noceanmx)
+      REAL tyu(ip1jmp1),txu(ip1jmp1),fluxz(ip1jmp1),fluxv(ip1jmp1)
+      REAL dt(ip1jmp1,noceanmx),ts(ip1jmp1,noceanmx)
+      REAL tx_phy(ngridmx),ty_phy(ngridmx)
+      REAL dt_phy(ngridmx,noceanmx),ts_phy(ngridmx,noceanmx)
+
+
+
+
+! Passage taux,y sur grilles 2d
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,tx_phy,txu)
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,ty_phy,tyu)
+! Passage grille u,v
+! Multiplication par f ou eps.
+      CALL gr_v_scal(1,txu,txv)
+      CALL gr_v_scal(1,tyu,tyv)
+      fluxm=tyv*unsev-txv*unsfv
+!      fluxm=-txv*unsfv
+      CALL gr_u_scal(1,txu,txu)
+      CALL gr_u_scal(1,tyu,tyu)
+      fluxz=tyu*unsfu+txu*unseu
+!      fluxz=tyu*unsfu
+            
+! Calcul de T, Tdeep
+      CALL gr_fi_dyn(2,ngridmx,iip1,jjp1,ts_phy,ts)
+       
+! Flux de masse
+      fluxm=fluxm*cv*cuvsurcv*zmasqv
+      fluxz=fluxz*cu*cvusurcu*zmasqu
+! Flux de masse vertical
+      DO ij=iip2,ip1jm
+        fluxv(ij)=fluxz(ij)-fluxz(ij-1)-fluxm(ij)+fluxm(ij-iip1)
+      ENDDO
+      DO ij=iip1,ip1jmi1,iip1
+         fluxv(ij+1)=fluxv(ij+iip1)
+      END DO
+! Poles
+      fluxv(1)=-SUM(fluxm(1:iim))     
+      fluxv(ip1jmp1)=SUM(fluxm(ip1jm-iim:ip1jm-1))
+      fluxv=fluxv
+
+!Calcul flux de chaleur méridiens
+      DO ij=1,ip1jm
+          fluxtm(ij,1)=fluxm(ij)*(ts(ij+iip1,1)+ts(ij,1))/2.
+          fluxtm(ij,2)=-fluxm(ij)*(ts(ij+iip1,2)+ts(ij,2))/2.
+      END DO
+
+!Calcul flux chaleur zonaux
+      DO ij=iip2,ip1jm
+      IF (fluxz(ij).GE.0.) THEN
+             fluxtz(ij,1)=fluxz(ij)*ts(ij,1)
+             fluxtz(ij,2)=-fluxz(ij)*ts(ij+1,2)
+      ELSE
+             fluxtz(ij,1)=fluxz(ij)*ts(ij+1,1)
+             fluxtz(ij,2)=-fluxz(ij)*ts(ij,2)
+      ENDIF
+      END DO
+      DO ij=iip1*2,ip1jmp1,iip1
+             fluxtz(ij,:)=fluxtz(ij-iim,:)
+      END DO
+                   
+! Calcul de dT
+      DO ij=iip2,ip1jm
+         dt(ij,:)=fluxtz(ij-1,:)-fluxtz(ij,:)   &
+                  +fluxtm(ij,:)-fluxtm(ij-iip1,:)
+         IF (fluxv(ij).GT.0.) THEN
+           dt(ij,1)=dt(ij,1)+fluxv(ij)*ts(ij,2)
+           dt(ij,2)=dt(ij,2)-fluxv(ij)*ts(ij,2)
+         ELSE
+           dt(ij,1)=dt(ij,1)+fluxv(ij)*ts(ij,1)
+           dt(ij,2)=dt(ij,2)-fluxv(ij)*ts(ij,1)
+         ENDIF
+         dt(ij,:)=dt(ij,:)/aire(ij)
+      END DO
+      DO ij=iip1,ip1jmi1,iip1
+         dt(ij+1,:)=dt(ij+iip1,:) 
+      END DO
+! Pôles
+      dt(1,:)=SUM(fluxtm(1:iim,:),dim=1)
+        IF (fluxv(1).GT.0.) THEN
+          dt(1,1)=dt(1,1)+fluxv(1)*ts(1,2)
+          dt(1,2)=dt(1,2)-fluxv(1)*ts(1,2)
+        ELSE
+          dt(1,1)=dt(1,1)+fluxv(1)*ts(1,1)
+          dt(1,2)=dt(1,2)-fluxv(1)*ts(1,1)
+        ENDIF
+      dt(1,:)=dt(1,:)/apoln
+      dt(ip1jmp1,:)=-SUM(fluxtm(ip1jm-iim:ip1jm-1,:),dim=1)
+       IF (fluxv(ip1jmp1).GT.0.) THEN
+         dt(ip1jmp1,1)=dt(ip1jmp1,1)+fluxv(ip1jmp1)*ts(ip1jmp1,2)
+         dt(ip1jmp1,2)=dt(ip1jmp1,2)-fluxv(ip1jmp1)*ts(ip1jmp1,2)
+       ELSE
+         dt(ip1jmp1,1)=dt(ip1jmp1,1)+fluxv(ip1jmp1)*ts(ip1jmp1,1)
+         dt(ip1jmp1,2)=dt(ip1jmp1,2)-fluxv(ip1jmp1)*ts(ip1jmp1,1)
+       ENDIF
+      dt(ip1jmp1,:)=dt(ip1jmp1,:)/apols
+      dt(2:iip1,1)=dt(1,1)
+      dt(2:iip1,2)=dt(1,2)
+      dt(ip1jm+1:ip1jmp1,1)=dt(ip1jmp1,1)
+      dt(ip1jm+1:ip1jmp1,2)=dt(ip1jmp1,2)
+
+! Retour grille physique
+      CALL gr_dyn_fi(2,iip1,jjp1,ngridmx,dt,dt_phy)
+
+
+  END SUBROUTINE slab_ekman2
+
+ 
+END MODULE surf_heat_transp_mod
+
+
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surface_nature.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surface_nature.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surface_nature.F	(revision 222)
@@ -0,0 +1,69 @@
+      SUBROUTINE surface_nature(ngrid,nq,obliquit,qsurf,qsurfliquid
+     &   ,qsurfsnow,rnat,oceanarea)
+
+      USE surfdat_h
+      USE comsoil_h
+      USE comgeomfi_h
+      USE tracer_h
+
+      IMPLICIT none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Defines a few things
+!     
+!     Authors
+!     ------- 
+!     B. Charnay (2010)
+!     
+!     Called by
+!     ---------
+!     physiq.F
+!     
+!     Calls
+!     -----
+!     none
+!
+!     Notes
+!     -----
+!     rnat is terrain type: 0-ocean; 1-continent; 2-continental ice
+!     
+!==================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+        integer ngrid,nq
+
+	REAL qsurf(ngrid,nq),ps(ngrid)
+	REAL qsurfliquid(ngrid)
+	REAL qsurfsnow(ngrid)
+	INTEGER iq, ig
+	INTEGER rnat(ngrid)
+ 	REAL oceanarea
+	REAL obliquit
+
+	do ig=1,ngrid
+           rnat(ig)=1
+           dryness(ig)=1        !(coefficient for evaporation)
+           if (inertiedat(ig,1).gt.1E4) then
+              rnat(ig)=0
+           end if
+	end do
+
+! surface of all the oceans
+        
+        oceanarea=0.
+	do ig=1,ngrid
+           if (rnat(ig).eq.0)then
+              oceanarea=oceanarea+area(ig)
+           end if
+	enddo
+
+        return
+        end
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surfdat_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surfdat_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surfdat_h.F90	(revision 222)
@@ -0,0 +1,22 @@
+
+       module surfdat_h
+
+       implicit none
+
+       real,allocatable,dimension(:) :: albedodat ! albedo of bare ground
+       ! Ehouarn: moved inertiedat to comsoil.h
+       !      real inertiedat, ! thermal inertia
+       real,allocatable,dimension(:) :: phisfi ! geopotential at ground level
+       real,dimension(2) :: albedice
+       real,dimension(2) :: emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere
+       real emissiv
+       real,dimension(2) :: iceradius, dtemisice
+       real,allocatable,dimension(:) :: zmea,zstd,zsig,zgam,zthe
+
+       real,allocatable,dimension(:) :: dryness  !"Dryness coefficient" for grnd water ice sublimation
+                                                 ! AS: previously in tracer.h. it is more logical here.
+
+       logical,allocatable,dimension(:) :: watercaptag !! was in watercap.h
+
+       end module surfdat_h
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surfini.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surfini.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/surfini.F	(revision 222)
@@ -0,0 +1,63 @@
+      SUBROUTINE surfini(ngrid,nq,qsurf,psolaralb)
+
+      USE surfdat_h, only: albedodat, albedice
+      USE tracer_h, only: igcm_co2_ice
+      use comgeomfi_h, only: lati
+      use planetwide_mod, only: planetwide_maxval, planetwide_minval
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   creation des calottes pour l'etat initial
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+c
+      INTEGER,INTENT(IN) :: ngrid
+      INTEGER,INTENT(IN) :: nq
+      REAL,INTENT(OUT) :: psolaralb(ngrid)
+      REAL,INTENT(IN) :: qsurf(ngrid,nq) !tracer on surface (kg/m2)
+
+      INTEGER :: ig,icap
+      REAL :: min_albedo,max_albedo
+c
+c=======================================================================
+
+
+      DO ig=1,ngrid
+         psolaralb(ig)=albedodat(ig)
+      ENDDO
+
+      call planetwide_minval(albedodat,min_albedo)
+      call planetwide_maxval(albedodat,max_albedo)
+      write(*,*) 'surfini: minimum corrected albedo',min_albedo
+      write(*,*) 'surfini: maximum corrected albedo',max_albedo
+
+      if (igcm_co2_ice.ne.0) then
+! Change Albedo if there is CO2 ice on the surface
+        DO ig=1,ngrid
+          IF (qsurf(ig,igcm_co2_ice) .GT. 0.) THEN
+             IF(lati(ig).LT.0.) THEN
+                icap=2 ! Southern hemisphere
+             ELSE
+                icap=1 ! Northern hemisphere
+             ENDIF
+             psolaralb(ig) = albedice(icap)
+          END IF
+        ENDDO ! of DO ig=1,ngrid     
+      else
+        write(*,*) "surfini: No CO2 ice tracer on surface  ..."
+        write(*,*) "         and therefore no albedo change."
+      endif
+
+      call planetwide_minval(psolaralb,min_albedo)
+      call planetwide_maxval(psolaralb,max_albedo)
+      write(*,*) 'surfini: minimum corrected albedo',min_albedo
+      write(*,*) 'surfini: maximum corrected albedo',max_albedo
+
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tabfi.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tabfi.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tabfi.F	(revision 222)
@@ -0,0 +1,544 @@
+c=======================================================================
+      SUBROUTINE tabfi(ngrid,nid,Lmodif,tab0,day_ini,lmax,p_rad,
+     .                 p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
+c=======================================================================
+c
+c   C. Hourdin 15/11/96
+c
+c   Object:        Lecture du tab_cntrl physique dans un fichier 
+c   ------            et initialisation des constantes physiques
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c      - nid:    unitne logique du fichier ou on va lire le tab_cntrl    
+c                      (ouvert dans le programme appellant) 
+c
+c                 si nid=0:
+c                       pas de lecture du tab_cntrl mais
+c                       Valeurs par default des constantes physiques
+c        
+c      - tab0:    Offset de tab_cntrl a partir duquel sont ranges 
+c                  les parametres physiques (50 pour start_archive)
+c
+c      - Lmodif:  si on souhaite modifier les constantes  Lmodif = 1 = TRUE
+c
+c
+c     Outputs:
+c     --------
+c
+c      - day_ini: tab_cntrl(tab0+3) (Dans les cas ou l'on souhaite
+c                              comparer avec le day_ini dynamique)
+c
+c      - lmax:    tab_cntrl(tab0+2) (pour test avec nlayermx)
+c
+c      - p_rad
+c      - p_omeg   !
+c      - p_g      ! Constantes physiques ayant des 
+c      - p_mugaz  ! homonymes dynamiques
+c      - p_daysec !
+c
+c=======================================================================
+! to use  'getin'
+      use ioipsl_getincom , only: getin
+
+      use surfdat_h, only: albedice, emisice, iceradius, dtemisice,
+     &                     emissiv
+      use comsoil_h, only: volcapa
+      use iostart, only: get_var
+      use mod_phys_lmdz_para, only: is_parallel
+
+      implicit none
+ 
+#include "comcstfi.h"
+#include "planete.h"
+#include "netcdf.inc"
+#include "callkeys.h"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c Arguments
+c ---------
+      INTEGER,INTENT(IN) :: ngrid,nid,tab0
+      INTEGER*4,INTENT(OUT) :: day_ini
+      INTEGER,INTENT(IN) :: Lmodif
+      INTEGER,INTENT(OUT) :: lmax
+      REAL,INTENT(OUT) :: p_rad,p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time
+
+c Variables
+c ---------
+      INTEGER,PARAMETER :: length=100
+      REAL tab_cntrl(length) ! array in which are stored the run's parameters
+      INTEGER  ierr,nvarid
+      INTEGER size
+      CHARACTER modif*20
+      LOGICAL :: found
+      
+      write(*,*)"tabfi: nid=",nid," tab0=",tab0," Lmodif=",Lmodif
+
+      IF (nid.eq.0) then
+c-----------------------------------------------------------------------
+c  Initialization of various physical constants to defaut values (nid = 0 case)
+c-----------------------------------------------------------------------
+      ELSE
+c-----------------------------------------------------------------------
+c  Initialization of physical constants by reading array tab_cntrl(:)
+c		which contains these parameters	(nid != 0 case)
+c-----------------------------------------------------------------------
+c Read 'controle' array
+c
+
+       call get_var("controle",tab_cntrl,found)
+       if (.not.found) then
+         write(*,*)"tabfi: Failed reading <controle> array"
+         call abort
+       else
+         write(*,*)'tabfi: tab_cntrl',tab_cntrl
+       endif
+c
+c  Initialization of some physical constants
+c informations on physics grid
+!      if(ngrid.ne.tab_cntrl(tab0+1)) then
+!         print*,'tabfi: WARNING !!! tab_cntrl(tab0+1).ne.ngrid'
+!         print*,tab_cntrl(tab0+1),ngrid
+!      endif
+      lmax = nint(tab_cntrl(tab0+2))
+      day_ini = tab_cntrl(tab0+3)
+      time = tab_cntrl(tab0+4)
+      write (*,*) 'IN tabfi day_ini=',day_ini
+c Informations about planet for dynamics and physics
+      rad = tab_cntrl(tab0+5)
+      omeg = tab_cntrl(tab0+6)
+      g = tab_cntrl(tab0+7)
+      mugaz = tab_cntrl(tab0+8)
+      rcp = tab_cntrl(tab0+9)
+      cpp=(8.314511/(mugaz/1000.0))/rcp
+      daysec = tab_cntrl(tab0+10)
+      dtphys = tab_cntrl(tab0+11)
+c Informations about planet for the physics only
+      year_day = tab_cntrl(tab0+14)
+      periastr = tab_cntrl(tab0+15)
+      apoastr = tab_cntrl(tab0+16)
+      peri_day = tab_cntrl(tab0+17)
+      obliquit = tab_cntrl(tab0+18)
+c boundary layer and turbeulence
+      z0 = tab_cntrl(tab0+19)
+      lmixmin = tab_cntrl(tab0+20)
+      emin_turb = tab_cntrl(tab0+21)
+c optical properties of polar caps and ground emissivity
+      albedice(1)= tab_cntrl(tab0+22)
+      albedice(2)= tab_cntrl(tab0+23)
+      emisice(1) = tab_cntrl(tab0+24)
+      emisice(2) = tab_cntrl(tab0+25)
+      emissiv    = tab_cntrl(tab0+26)
+      iceradius(1)= tab_cntrl(tab0+31) ! mean scat radius of CO2 snow (north)
+      iceradius(2)= tab_cntrl(tab0+32) ! mean scat radius of CO2 snow (south)
+      dtemisice(1)= tab_cntrl(tab0+33) !time scale for snow metamorphism (north)
+      dtemisice(2)= tab_cntrl(tab0+34) !time scale for snow metamorphism (south)
+c soil properties
+      volcapa = tab_cntrl(tab0+35) ! volumetric heat capacity
+c-----------------------------------------------------------------------
+c	Save some constants for later use (as routine arguments)
+c-----------------------------------------------------------------------
+      p_omeg = omeg
+      p_g = g
+      p_cpp = cpp
+      p_mugaz = mugaz
+      p_daysec = daysec
+      p_rad=rad
+
+      ENDIF    ! end of (nid = 0) 
+
+c-----------------------------------------------------------------------
+c	Write physical constants to output before modifying them
+c-----------------------------------------------------------------------
+ 
+   6  FORMAT(a20,e15.6,e15.6)
+   5  FORMAT(a20,f12.2,f12.2)
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'Reading tab_cntrl when calling tabfi before changes'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)        = ngrid?',tab_cntrl(tab0+1),float(ngrid)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periastr',tab_cntrl(tab0+15),periastr
+      write(*,5) '(16)        apoastr',tab_cntrl(tab0+16),apoastr
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+
+      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+
+      write(*,*)
+      write(*,*) 'Lmodif in tabfi!!!!!!!',Lmodif
+
+c-----------------------------------------------------------------------
+c	 Modifications...
+! NB: Modifying controls should only be done by newstart, and in seq mode
+      if ((Lmodif.eq.1).and.is_parallel) then
+        write(*,*) "tabfi: Error modifying tab_control should",
+     &             " only happen in serial mode (eg: by newstart)"
+        stop
+      endif
+c-----------------------------------------------------------------------
+
+      IF(Lmodif.eq.1) then
+
+      write(*,*)
+      write(*,*) 'Change values in tab_cntrl ? :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*) '(Current values given above)'
+      write(*,*)
+      write(*,*) '(3)          day_ini : Initial day (=0 at Ls=0)'
+      write(*,*) '(19)              z0 :  surface roughness (m)'
+      write(*,*) '(21)       emin_turb :  minimal energy (PBL)'
+      write(*,*) '(20)         lmixmin : mixing length (PBL)'
+      write(*,*) '(26)         emissiv : ground emissivity'
+      write(*,*) '(24 et 25)   emisice : CO2 ice max emissivity '
+      write(*,*) '(22 et 23)  albedice : CO2 ice cap albedos'
+      write(*,*) '(31 et 32) iceradius : mean scat radius of CO2 snow'
+      write(*,*) '(33 et 34) dtemisice : time scale for snow',
+     &           'metamorphism'
+      write(*,*) '(35)      volcapa : soil volumetric heat capacity'
+      write(*,*) '(18)     obliquit : planet obliquity (deg)'
+      write(*,*) '(17)     peri_day : periastron date (sols since Ls=0)'
+      write(*,*) '(15)     periastr : min. star-planet dist (UA)'
+      write(*,*) '(16)     apoastr  : max. star-planet (UA)'
+      write(*,*) '(14)     year_day : length of year (in sols)'
+      write(*,*) '(5)      rad      : radius of the planet (m)'
+      write(*,*) '(6)      omeg     : planet rotation rate (rad/s)'
+      write(*,*) '(7)      g        : gravity (m/s2)'
+      write(*,*) '(8)      mugaz    : molecular mass '
+      write(*,*) '                       of the atmosphere (g/mol)'
+      write(*,*) '(9)      rcp      : r/Cp'
+      write(*,*) '(8)+(9)  calc_cpp_mugaz : r/Cp and mugaz '
+      write(*,*) '                 computed from gases.def'
+      write(*,*) '(10)     daysec   : length of a sol (s)'
+      write(*,*)
+ 
+ 
+      do while(modif(1:1).ne.'hello')
+        write(*,*)
+        write(*,*)
+        write(*,*) 'Changes to perform ?'
+        write(*,*) '   (enter keyword or return )'
+        write(*,*)
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') goto 999
+ 
+        write(*,*)
+        write(*,*) modif(1:len_trim(modif)) , ' : '
+
+        if (modif(1:len_trim(modif)) .eq. 'day_ini') then
+          write(*,*) 'current value:',day_ini
+          write(*,*) 'enter new value:'
+ 101      read(*,*,iostat=ierr) day_ini
+          if(ierr.ne.0) goto 101
+          write(*,*) ' '
+          write(*,*) 'day_ini (new value):',day_ini
+
+        else if (modif(1:len_trim(modif)) .eq. 'z0') then
+          write(*,*) 'current value:',z0
+          write(*,*) 'enter new value:'
+ 102      read(*,*,iostat=ierr) z0
+          if(ierr.ne.0) goto 102
+          write(*,*) ' '
+          write(*,*) ' z0 (new value):',z0
+
+        else if (modif(1:len_trim(modif)) .eq. 'emin_turb') then
+          write(*,*) 'current value:',emin_turb
+          write(*,*) 'enter new value:'
+ 103      read(*,*,iostat=ierr) emin_turb
+          if(ierr.ne.0) goto 103
+          write(*,*) ' '
+          write(*,*) ' emin_turb (new value):',emin_turb
+
+        else if (modif(1:len_trim(modif)) .eq. 'lmixmin') then
+          write(*,*) 'current value:',lmixmin
+          write(*,*) 'enter new value:'
+ 104      read(*,*,iostat=ierr) lmixmin
+          if(ierr.ne.0) goto 104
+          write(*,*) ' '
+          write(*,*) ' lmixmin (new value):',lmixmin
+
+        else if (modif(1:len_trim(modif)) .eq. 'emissiv') then
+          write(*,*) 'current value:',emissiv
+          write(*,*) 'enter new value:'
+ 105      read(*,*,iostat=ierr) emissiv
+          if(ierr.ne.0) goto 105
+          write(*,*) ' '
+          write(*,*) ' emissiv (new value):',emissiv
+
+        else if (modif(1:len_trim(modif)) .eq. 'emisice') then
+          write(*,*) 'current value emisice(1) North:',emisice(1)
+          write(*,*) 'enter new value:'
+ 106      read(*,*,iostat=ierr) emisice(1)
+          if(ierr.ne.0) goto 106
+          write(*,*) 
+          write(*,*) ' emisice(1) (new value):',emisice(1)
+          write(*,*)
+
+          write(*,*) 'current value emisice(2) South:',emisice(2)
+          write(*,*) 'enter new value:'
+ 107      read(*,*,iostat=ierr) emisice(2)
+          if(ierr.ne.0) goto 107
+          write(*,*) 
+          write(*,*) ' emisice(2) (new value):',emisice(2)
+
+        else if (modif(1:len_trim(modif)) .eq. 'albedice') then
+          write(*,*) 'current value albedice(1) North:',albedice(1)
+          write(*,*) 'enter new value:'
+ 108      read(*,*,iostat=ierr) albedice(1)
+          if(ierr.ne.0) goto 108
+          write(*,*) 
+          write(*,*) ' albedice(1) (new value):',albedice(1)
+          write(*,*)
+
+          write(*,*) 'current value albedice(2) South:',albedice(2)
+          write(*,*) 'enter new value:'
+ 109      read(*,*,iostat=ierr) albedice(2)
+          if(ierr.ne.0) goto 109
+          write(*,*) 
+          write(*,*) ' albedice(2) (new value):',albedice(2)
+
+        else if (modif(1:len_trim(modif)) .eq. 'iceradius') then
+          write(*,*) 'current value iceradius(1) North:',iceradius(1)
+          write(*,*) 'enter new value:'
+ 110      read(*,*,iostat=ierr) iceradius(1)
+          if(ierr.ne.0) goto 110
+          write(*,*) 
+          write(*,*) ' iceradius(1) (new value):',iceradius(1)
+          write(*,*)
+
+          write(*,*) 'current value iceradius(2) South:',iceradius(2)
+          write(*,*) 'enter new value:'
+ 111      read(*,*,iostat=ierr) iceradius(2)
+          if(ierr.ne.0) goto 111
+          write(*,*) 
+          write(*,*) ' iceradius(2) (new value):',iceradius(2)
+
+        else if (modif(1:len_trim(modif)) .eq. 'dtemisice') then
+          write(*,*) 'current value dtemisice(1) North:',dtemisice(1)
+          write(*,*) 'enter new value:'
+ 112      read(*,*,iostat=ierr) dtemisice(1)
+          if(ierr.ne.0) goto 112
+          write(*,*) 
+          write(*,*) ' dtemisice(1) (new value):',dtemisice(1)
+          write(*,*)
+
+          write(*,*) 'current value dtemisice(2) South:',dtemisice(2)
+          write(*,*) 'enter new value:'
+ 113      read(*,*,iostat=ierr) dtemisice(2)
+          if(ierr.ne.0) goto 113
+          write(*,*) 
+          write(*,*) ' dtemisice(2) (new value):',dtemisice(2)
+
+        else if (modif(1:len_trim(modif)) .eq. 'obliquit') then
+          write(*,*) 'current value:',obliquit
+          write(*,*) 'obliquit should be 25.19 on current Mars'
+          write(*,*) 'enter new value:'
+ 115      read(*,*,iostat=ierr) obliquit
+          if(ierr.ne.0) goto 115
+          write(*,*) 
+          write(*,*) ' obliquit (new value):',obliquit
+
+        else if (modif(1:len_trim(modif)) .eq. 'peri_day') then
+          write(*,*) 'current value:',peri_day
+          write(*,*) 'peri_day should be 485 on current Mars'
+          write(*,*) 'enter new value:'
+ 116      read(*,*,iostat=ierr) peri_day
+          if(ierr.ne.0) goto 116
+          write(*,*) 
+          write(*,*) ' peri_day (new value):',peri_day
+
+        else if (modif(1:len_trim(modif)) .eq. 'periastr') then
+          write(*,*) 'current value:',periastr
+          write(*,*) 'periastr should be 206.66 on present-day Mars'
+          write(*,*) 'enter new value:'
+ 117      read(*,*,iostat=ierr) periastr
+          if(ierr.ne.0) goto 117
+          write(*,*) 
+          write(*,*) ' periastr (new value):',periastr
+ 
+        else if (modif(1:len_trim(modif)) .eq. 'apoastr') then
+          write(*,*) 'current value:',apoastr
+          write(*,*) 'apoastr should be 249.22 on present-day Mars'
+          write(*,*) 'enter new value:'
+ 118      read(*,*,iostat=ierr) apoastr
+          if(ierr.ne.0) goto 118
+          write(*,*) 
+          write(*,*) ' apoastr (new value):',apoastr
+ 
+        else if (modif(1:len_trim(modif)) .eq. 'volcapa') then
+          write(*,*) 'current value:',volcapa
+          write(*,*) 'enter new value:'
+ 119      read(*,*,iostat=ierr) volcapa
+          if(ierr.ne.0) goto 119
+          write(*,*) 
+          write(*,*) ' volcapa (new value):',volcapa
+        
+        else if (modif(1:len_trim(modif)).eq.'rad') then
+          write(*,*) 'current value:',rad
+          write(*,*) 'enter new value:'
+ 120      read(*,*,iostat=ierr) rad
+          if(ierr.ne.0) goto 120
+          write(*,*) 
+          write(*,*) ' rad (new value):',rad
+
+        else if (modif(1:len_trim(modif)).eq.'omeg') then
+          write(*,*) 'current value:',omeg
+          write(*,*) 'enter new value:'
+ 121      read(*,*,iostat=ierr) omeg
+          if(ierr.ne.0) goto 121
+          write(*,*) 
+          write(*,*) ' omeg (new value):',omeg
+        
+        else if (modif(1:len_trim(modif)).eq.'g') then
+          write(*,*) 'current value:',g
+          write(*,*) 'enter new value:'
+ 122      read(*,*,iostat=ierr) g
+          if(ierr.ne.0) goto 122
+          write(*,*) 
+          write(*,*) ' g (new value):',g
+
+        else if (modif(1:len_trim(modif)).eq.'mugaz') then
+          write(*,*) 'current value:',mugaz
+          write(*,*) 'enter new value:'
+ 123      read(*,*,iostat=ierr) mugaz
+          if(ierr.ne.0) goto 123
+          write(*,*) 
+          write(*,*) ' mugaz (new value):',mugaz
+          r=8.314511/(mugaz/1000.0)
+          write(*,*) ' R (new value):',r
+
+        else if (modif(1:len_trim(modif)).eq.'rcp') then
+          write(*,*) 'current value:',rcp
+          write(*,*) 'enter new value:'
+ 124      read(*,*,iostat=ierr) rcp
+          if(ierr.ne.0) goto 124
+          write(*,*) 
+          write(*,*) ' rcp (new value):',rcp
+          r=8.314511/(mugaz/1000.0)
+          cpp=r/rcp
+          write(*,*) ' cpp (new value):',cpp
+
+        else if (modif(1:len_trim(modif)).eq.'calc_cpp_mugaz') then
+          write(*,*) 'current value rcp, mugaz:',rcp,mugaz
+          check_cpp_match=.false.
+	  force_cpp=.false.
+	  call su_gases
+	  call calc_cpp_mugaz
+          write(*,*) 
+          write(*,*) ' cpp (new value):',cpp
+          write(*,*) ' mugaz (new value):',mugaz
+          r=8.314511/(mugaz/1000.0)
+          rcp=r/cpp
+          write(*,*) ' rcp (new value):',rcp
+	  
+        else if (modif(1:len_trim(modif)).eq.'daysec') then
+          write(*,*) 'current value:',daysec
+          write(*,*) 'enter new value:'
+ 125      read(*,*,iostat=ierr) daysec
+          if(ierr.ne.0) goto 125
+          write(*,*) 
+          write(*,*) ' daysec (new value):',daysec
+
+!         added by RW!
+        else if (modif(1:len_trim(modif)).eq.'year_day') then
+          write(*,*) 'current value:',year_day
+          write(*,*) 'enter new value:' 
+ 126      read(*,*,iostat=ierr) year_day
+          if(ierr.ne.0) goto 126
+          write(*,*)
+          write(*,*) ' year_day (new value):',year_day
+
+        endif
+      enddo ! of do while(modif(1:1).ne.'hello')
+
+ 999  continue
+
+c-----------------------------------------------------------------------
+c	Write values of physical constants after modifications
+c-----------------------------------------------------------------------
+ 
+      write(*,*) '*****************************************************'
+      write(*,*) 'Reading tab_cntrl when calling tabfi AFTER changes'
+      write(*,*) '*****************************************************'
+      write(*,5) '(1)        = ngrid?',tab_cntrl(tab0+1),float(ngrid)
+      write(*,5) '(2)            lmax',tab_cntrl(tab0+2),float(lmax)
+      write(*,5) '(3)         day_ini',tab_cntrl(tab0+3),float(day_ini)
+      write(*,5) '(5)             rad',tab_cntrl(tab0+5),rad
+      write(*,5) '(10)         daysec',tab_cntrl(tab0+10),daysec
+      write(*,6) '(6)            omeg',tab_cntrl(tab0+6),omeg
+      write(*,5) '(7)               g',tab_cntrl(tab0+7),g
+      write(*,5) '(8)           mugaz',tab_cntrl(tab0+8),mugaz
+      write(*,5) '(9)             rcp',tab_cntrl(tab0+9),rcp
+      write(*,6) '(11)        dtphys?',tab_cntrl(tab0+11),dtphys
+ 
+      write(*,5) '(14)       year_day',tab_cntrl(tab0+14),year_day
+      write(*,5) '(15)       periastr',tab_cntrl(tab0+15),periastr
+      write(*,5) '(16)        apoastr',tab_cntrl(tab0+16),apoastr
+      write(*,5) '(17)       peri_day',tab_cntrl(tab0+17),peri_day
+      write(*,5) '(18)       obliquit',tab_cntrl(tab0+18),obliquit
+ 
+      write(*,6) '(19)             z0',tab_cntrl(tab0+19),z0
+      write(*,6) '(21)      emin_turb',tab_cntrl(tab0+21),emin_turb
+      write(*,5) '(20)        lmixmin',tab_cntrl(tab0+20),lmixmin
+ 
+      write(*,5) '(26)        emissiv',tab_cntrl(tab0+26),emissiv
+      write(*,5) '(24)     emisice(1)',tab_cntrl(tab0+24),emisice(1)
+      write(*,5) '(25)     emisice(2)',tab_cntrl(tab0+25),emisice(2)
+      write(*,5) '(22)    albedice(1)',tab_cntrl(tab0+22),albedice(1)
+      write(*,5) '(23)    albedice(2)',tab_cntrl(tab0+23),albedice(2)
+      write(*,6) '(31)   iceradius(1)',tab_cntrl(tab0+31),iceradius(1)
+      write(*,6) '(32)   iceradius(2)',tab_cntrl(tab0+32),iceradius(2)
+      write(*,5) '(33)   dtemisice(1)',tab_cntrl(tab0+33),dtemisice(1)
+      write(*,5) '(34)   dtemisice(2)',tab_cntrl(tab0+34),dtemisice(2)
+ 
+      write(*,5) '(35)        volcapa',tab_cntrl(tab0+35),volcapa
+
+      write(*,*)  
+      write(*,*) 
+
+      ENDIF 			!	of if (Lmodif == 1)
+
+c-----------------------------------------------------------------------
+c	Save some constants for later use (as routine arguments)
+c-----------------------------------------------------------------------
+      p_omeg = omeg
+      p_g = g
+      p_cpp = cpp
+      p_mugaz = mugaz
+      p_daysec = daysec
+      p_rad=rad
+
+
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/totalcloudfrac.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/totalcloudfrac.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/totalcloudfrac.F90	(revision 222)
@@ -0,0 +1,113 @@
+      subroutine totalcloudfrac(ngrid,nq,rneb,totalrneb,pplev,pq,tau)
+
+      use watercommon_h
+      use comdiurn_h
+      USE comgeomfi_h
+      USE tracer_h, only: igcm_h2o_ice
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Calculates the total cloud fraction 
+!     
+!     Authors
+!     -------
+!     Adapted from the LMDTERRE code by B Charnay (2010)
+!     
+!==================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+      integer,intent(in) :: ngrid        ! number of atmospheric columns
+      integer,intent(in) :: nq           ! number of tracers
+      real,intent(in) :: rneb(ngrid,nlayermx)    ! cloud fraction     
+      real,intent(out) :: totalrneb(ngrid)       ! total cloud fraction 
+      real,intent(in) :: pplev(ngrid,nlayermx+1) ! inter-layer pressure (Pa)
+      real,intent(in) :: pq(ngrid,nlayermx,nq)   ! tracers (.../kg_of_air)
+      real,intent(in) :: tau(ngrid,nlayermx)
+
+      real, dimension(nlayermx+1) :: masse
+      integer, parameter          :: recovery=7
+      integer ltau_max
+      real massetot
+
+! hypothesis behind recovery. value: 
+! 1 = random recovery
+! 2 = maximal recovery
+! 3 = minimal recovery
+! 4 = fixed recovery
+! 5 = recovery on the thicker layer
+!     Local variables
+      integer ig, l
+      real clear,tau_min
+      real, parameter ::  tau_c=0.1 !threshold of optical depth for the calculation of total cloud fraction 
+      real rneb2(nlayermx)
+
+
+      do ig=1,ngrid
+         totalrneb(ig) = 0.
+
+         if (recovery.eq.1) then
+            clear = (1.-rneb(ig,1))
+            do l=2,nlayermx       
+               clear = clear*(1.-rneb(ig,l))
+            enddo
+            totalrneb(ig) = 1.-clear
+
+         elseif (recovery.eq.2) then
+            totalrneb(ig) = rneb(ig,1)
+            do l=2,14 !nlayermx       
+               totalrneb(ig) = max(rneb(ig,l),totalrneb(ig))
+            enddo
+            
+         elseif (recovery.eq.3) then
+            totalrneb(ig) = rneb(ig,1)
+            do l=2,nlayermx       
+               totalrneb(ig) = min(rneb(ig,l),totalrneb(ig))
+            enddo
+         
+         elseif (recovery.eq.4) then
+            totalrneb(ig) = CLFfixval
+
+         elseif (recovery.eq.5) then
+            totalrneb(ig) = rneb(ig,1)            
+            do l=1,nlayermx
+               masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1))
+            enddo
+            ltau_max=maxloc(masse,dim=1)
+            totalrneb(ig) = rneb(ig,ltau_max)
+
+         elseif (recovery.eq.6) then
+            totalrneb(ig) = 0.            
+            do l=1,nlayermx
+               masse(l)=pq(ig,l,igcm_h2o_ice)*(pplev(ig,l)-pplev(ig,l+1))
+               masse(l)=max(masse(l),0.)
+            enddo
+            massetot=sum(masse,dim=1)
+            do l=1,nlayermx
+               totalrneb(ig) = totalrneb(ig)+rneb(ig,l)*masse(l)/massetot
+            enddo
+
+         elseif (recovery.eq.7) then
+
+            rneb2(:)=rneb(ig,1:nlayermx)
+	    tau_min=MIN(tau_c,MAXVAL(tau(ig,1:nlayermx))/2.)
+            do l=1,nlayermx
+               if(tau(ig,l)<tau_min) rneb2(l)=0.      	
+            enddo
+            totalrneb(ig)=maxval(rneb2(1:nlayermx))
+
+         endif                  ! (recovery=)   
+
+         totalrneb(ig) = min(1.,totalrneb(ig))
+         totalrneb(ig) = max(0.,totalrneb(ig))
+         
+      enddo                     ! (ig=)
+      
+      
+    end subroutine totalcloudfrac
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tpindex.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tpindex.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tpindex.F	(revision 222)
@@ -0,0 +1,137 @@
+      subroutine tpindex(pw,tw,qvar,pref,tref,wrefvar,LCOEF,MT,MP,
+     &     NVAR,wratio)
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Interpolate K-coefficients to the given P,T and Qvar values.
+!
+!     Notes
+!     -----
+!     The interpolation is the usual one in two dimensions given
+!     in "Numerical Recipes", where the "X" are P, the "Y" are
+!     T, and the F(X,Y) are the CO2 K-coefficients.
+!
+!     The interpolating box is:
+!
+!           (PL,TU)                        (PR,TU)
+!
+!                          (TW,PW)
+!
+!           
+!           (PL,TL)                        (PR,TL)
+!
+!      PL  - Pressure left
+!      PR  - Pressure right
+!      TL  - Temperature lower
+!      TU  - Temperature upper
+!      PW  - Pressure wanted
+!      TW  - Temperature wanted
+!
+!     Inputs
+!     ------
+!     PW                 - The pressure to interpolate to
+!     TW                 - The temperature to interpolate to
+!     Pref(NP)           - The pressure grid array
+!     Tref(NT)           - The temperature grid array
+!   
+!     Outputs
+!     -------
+!     TI                 - Interpolation term (pressure)
+!     UI                 - Interpolation term (temperature)
+!     MT                 - Temperature index (bottom left temperature)
+!                          of bounding box
+!     MP                 - Pressure index (bottom left pressure)
+!                          of bounding box
+!
+!     Authors
+!     -------
+!     Adapted from the NASA Ames code by R. Wordsworth (2009)
+!     
+!==================================================================
+
+      use radinc_h
+
+      implicit none
+
+      real*8 Tref(L_NTREF)
+      real*8 pref(L_PINT)
+      real*8 wrefvar(L_REFVAR)
+
+      integer MT, MP, N, M, NP, NVAR
+      real*8  PW, TW, Qvar, wratio
+      real*8  PWL, LCOEF(4), T, U
+
+C======================================================================C
+ 
+!     Get the upper and lower temperature grid indicies that bound the
+!     requested temperature. If the requested temperature is outside
+!     the T-grid, set up to extrapolate from the appropriate end.
+
+
+      IF(TW.LE.TREF(1)) THEN
+        MT = 1
+      ELSE
+        do n=1,L_NTREF-1
+          if(tw.gt.Tref(n) .and. TW.LE.TREF(N+1)) then
+            MT = n
+            goto 10
+          end if
+        end do
+
+        MT = L_NTREF-1
+      
+   10   continue
+      END IF
+
+      U = (TW-TREF(MT))/(TREF(MT+1)-TREF(MT))
+
+!     Get the upper and lower pressure grid indicies that bound the
+!     requested pressure. If the requested pressure is outside
+!     the P-grid, set up to extrapolate from the appropriate end.
+
+      pwl = log10(pw)
+
+      do n=2,L_PINT-1
+        if(pwl.le.Pref(n)) then
+          MP = n-1
+          goto 20
+        end if
+      end do
+
+      MP = L_PINT-1
+
+   20 continue
+
+      T = (PWL-PREF(MP))/(PREF(MP+1)-PREF(MP))
+
+!  Fill in the interpolation coefficients
+      LCOEF(1) = (1.0-T)*(1.0-U)
+      LCOEF(2) = T*(1.0-U)
+      LCOEF(3) = T*U
+      LCOEF(4) = (1.0-T)*U
+
+!  Get the indicies for abundance of the varying species. There are 10 sets of 
+!  k-coefficients with differing amounts of variable vs. constant gas.
+
+      IF(QVAR.le.WREFVAR(1)) then
+        NVAR   = 1
+        WRATIO = 0.0D0
+      ELSEIF(QVAR.ge.WREFVAR(L_REFVAR)) then
+        NVAR   = L_REFVAR
+        WRATIO = 0.0D0
+      ELSE
+        DO N=2,L_REFVAR
+          IF(QVAR.GE.WREFVAR(N-1) .and. QVAR.lt.WREFVAR(N)) then
+            NVAR   = N-1
+            WRATIO = (QVAR - WREFVAR(N-1))/(WREFVAR(N) - WREFVAR(N-1))
+            GOTO 30
+          END IF
+        END DO
+      END IF
+
+   30 CONTINUE
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tracer_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tracer_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/tracer_h.F90	(revision 222)
@@ -0,0 +1,51 @@
+
+       module tracer_h
+
+       implicit none
+
+       character*20, DIMENSION(:), ALLOCATABLE :: noms   ! name of the tracer
+       real, DIMENSION(:), ALLOCATABLE :: mmol     ! mole mass of tracer (g/mol-1) 
+       real, DIMENSION(:), ALLOCATABLE :: radius   ! dust and ice particle radius (m)
+       real, DIMENSION(:), ALLOCATABLE :: rho_q    ! tracer densities (kg.m-3)
+       real, DIMENSION(:), ALLOCATABLE :: qext     ! Single Scat. Extinction coeff at 0.67 um
+       real, DIMENSION(:), ALLOCATABLE :: alpha_lift  ! saltation vertical flux/horiz flux ratio (m-1)
+       real, DIMENSION(:), ALLOCATABLE :: alpha_devil ! lifting coeeficient by dust devil
+       real, DIMENSION(:), ALLOCATABLE :: qextrhor ! Intermediate for computing opt. depth from q
+
+      real varian      ! Characteristic variance of log-normal distribution
+      real r3n_q     ! used to compute r0 from number and mass mixing ratio
+      real rho_dust     ! Mars dust density (kg.m-3)
+      real rho_ice     ! Water ice density (kg.m-3)
+      real rho_co2     ! CO2 ice density (kg.m-3)
+      real ref_r0        ! for computing reff=ref_r0*r0 (in log.n. distribution)
+
+! tracer indexes: these are initialized in initracer and should be 0 if the
+!                 corresponding tracer does not exist
+      ! dust
+      integer, DIMENSION(:), ALLOCATABLE :: igcm_dustbin ! for dustbin 'dust' tracers
+      ! dust, special doubleq case
+      integer :: igcm_dust_mass   ! dust mass mixing ratio (for transported dust)
+      integer :: igcm_dust_number ! dust number mixing ratio (transported dust)
+      ! water
+      integer :: igcm_h2o_vap ! water vapour
+      integer :: igcm_h2o_ice ! water ice
+      ! chemistry:
+      integer :: igcm_co2
+      integer :: igcm_co
+      integer :: igcm_o
+      integer :: igcm_o1d
+      integer :: igcm_o2
+      integer :: igcm_o3
+      integer :: igcm_h
+      integer :: igcm_h2
+      integer :: igcm_oh
+      integer :: igcm_ho2
+      integer :: igcm_h2o2
+      integer :: igcm_n2
+      integer :: igcm_ar
+      ! other tracers
+      integer :: igcm_ar_n2 ! for simulations using co2 +neutral gaz
+      integer :: igcm_co2_ice ! CO2 ice 
+
+       end module tracer_h
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/turbdiff.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/turbdiff.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/turbdiff.F90	(revision 222)
@@ -0,0 +1,739 @@
+      subroutine turbdiff(ngrid,nlay,nq,rnat,          &
+          ptimestep,pcapcal,lecrit,                    &   
+          pplay,pplev,pzlay,pzlev,pz0,                 &
+          pu,pv,pt,ppopsk,pq,ptsrf,pemis,pqsurf,       &
+          pdufi,pdvfi,pdtfi,pdqfi,pfluxsrf,            &
+          Pdudif,pdvdif,pdtdif,pdtsrf,sensibFlux,pq2,  &
+          pdqdif,pdqevap,pdqsdif,flux_u,flux_v,lastcall)
+
+      use watercommon_h, only : RLVTT, T_h2O_ice_liq, RCPD, mx_eau_sol,Psat_water
+      use radcommon_h, only : sigma, glat
+      use surfdat_h, only: dryness
+      use tracer_h, only: igcm_h2o_vap, igcm_h2o_ice
+
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Turbulent diffusion (mixing) for pot. T, U, V and tracers
+!     
+!     Implicit scheme
+!     We start by adding to variables x the physical tendencies
+!     already computed. We resolve the equation:
+!
+!     x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
+!     
+!     Authors
+!     ------- 
+!     F. Hourdin, F. Forget, R. Fournier (199X)
+!     R. Wordsworth, B. Charnay (2010)
+!     J. Leconte (2012): To f90
+!         - Rewritten the diffusion scheme to conserve total enthalpy
+!               by accounting for dissipation of turbulent kinetic energy.
+!         - Accounting for lost mean flow kinetic energy should come soon.
+!     
+!==================================================================
+
+!-----------------------------------------------------------------------
+!     declarations
+!     ------------
+
+      include "dimensions.h"
+      include "dimphys.h"
+      include "comcstfi.h"
+      include "callkeys.h"
+
+!     arguments
+!     ---------
+      INTEGER,INTENT(IN) :: ngrid,nlay
+      REAL,INTENT(IN) :: ptimestep
+      REAL,INTENT(IN) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      REAL,INTENT(IN) :: pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
+      REAL,INTENT(IN) :: pu(ngrid,nlay),pv(ngrid,nlay)
+      REAL,INTENT(IN) :: pt(ngrid,nlay),ppopsk(ngrid,nlay)
+      REAL,INTENT(IN) :: ptsrf(ngrid) ! surface temperature (K)
+      REAL,INTENT(IN) :: pemis(ngrid)
+      REAL,INTENT(IN) :: pdufi(ngrid,nlay),pdvfi(ngrid,nlay)
+      REAL,INTENT(IN) :: pdtfi(ngrid,nlay)
+      REAL,INTENT(IN) :: pfluxsrf(ngrid)
+      REAL,INTENT(OUT) :: pdudif(ngrid,nlay),pdvdif(ngrid,nlay)
+      REAL,INTENT(OUT) :: pdtdif(ngrid,nlay)
+      REAL,INTENT(OUT) :: pdtsrf(ngrid) ! tendency (K/s) on surface temperature
+      REAL,INTENT(OUT) :: sensibFlux(ngrid)
+      REAL,INTENT(IN) :: pcapcal(ngrid)
+      REAL,INTENT(INOUT) :: pq2(ngrid,nlay+1)
+      REAL,INTENT(OUT) :: flux_u(ngrid),flux_v(ngrid)
+      REAL,INTENT(IN) :: rnat(ngrid)      
+      LOGICAL,INTENT(IN) :: lastcall ! not used
+
+!     Arguments added for condensation
+      logical,intent(in) :: lecrit ! not used.
+      REAL,INTENT(IN) :: pz0
+
+!     Tracers
+!     --------
+      integer,intent(in) :: nq 
+      real,intent(in) :: pqsurf(ngrid,nq)
+      real,intent(in) :: pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
+      real,intent(out) :: pdqdif(ngrid,nlay,nq) 
+      real,intent(out) :: pdqsdif(ngrid,nq) 
+      
+!     local
+!     -----
+      integer ilev,ig,ilay,nlev
+
+      REAL z4st,zdplanck(ngrid)
+      REAL zkv(ngrid,nlayermx+1),zkh(ngrid,nlayermx+1)
+      REAL zcdv(ngrid),zcdh(ngrid)
+      REAL zcdv_true(ngrid),zcdh_true(ngrid)
+      REAL zu(ngrid,nlayermx),zv(ngrid,nlayermx)
+      REAL zh(ngrid,nlayermx),zt(ngrid,nlayermx)
+      REAL ztsrf(ngrid)
+      REAL z1(ngrid),z2(ngrid)
+      REAL zmass(ngrid,nlayermx)
+      REAL zfluxv(ngrid,nlayermx),zfluxt(ngrid,nlayermx),zfluxq(ngrid,nlayermx)
+      REAL zb0(ngrid,nlayermx)
+      REAL zExner(ngrid,nlayermx),zovExner(ngrid,nlayermx)
+      REAL zcv(ngrid,nlayermx),zdv(ngrid,nlayermx)  !inversion coefficient for winds
+      REAL zct(ngrid,nlayermx),zdt(ngrid,nlayermx)  !inversion coefficient for temperature
+      REAL zcq(ngrid,nlayermx),zdq(ngrid,nlayermx)  !inversion coefficient for tracers
+      REAL zcst1
+      REAL zu2!, a
+      REAL zcq0(ngrid),zdq0(ngrid)
+      REAL zx_alf1(ngrid),zx_alf2(ngrid)
+
+      LOGICAL,SAVE :: firstcall=.true.
+      
+!     Tracers
+!     -------
+      INTEGER iq
+      REAL zq(ngrid,nlayermx,nq)
+      REAL zqnoevap(ngrid,nlayermx) !special for water case to compute where evaporated water goes.
+      REAL pdqevap(ngrid,nlayermx) !special for water case to compute where evaporated water goes.
+      REAL zdmassevap(ngrid)
+      REAL rho(ngrid)         ! near-surface air density
+      REAL qsat(ngrid),psat(ngrid)
+      REAL kmixmin
+
+!     Variables added for implicit latent heat inclusion
+!     --------------------------------------------------
+      real dqsat(ngrid), qsat_temp1, qsat_temp2,psat_temp
+
+      integer, save :: ivap, iliq, iliq_surf,iice_surf ! also make liq for clarity on surface...
+
+      real, parameter :: karman=0.4
+      real cd0, roughratio
+
+      real dqsdif_total(ngrid) 
+      real zq0(ngrid) 
+
+
+!     Coherence test
+!     --------------
+
+      IF (firstcall) THEN
+
+         if(water)then
+             ivap=igcm_h2o_vap
+             iliq=igcm_h2o_ice
+             iliq_surf=igcm_h2o_vap
+	     iice_surf=igcm_h2o_ice ! simply to make the code legible               
+                                  ! to be generalised
+	 else
+             ivap=0
+             iliq=0
+             iliq_surf=0
+	     iice_surf=0 ! simply to make the code legible               	  
+         endif
+         sensibFlux(:)=0.
+
+         firstcall=.false.
+      ENDIF
+
+!-----------------------------------------------------------------------
+!     1. Initialisation
+!     -----------------
+
+      nlev=nlay+1
+
+!     Calculate rho*dz, (P/Ps)**(R/cp) and dt*rho/dz=dt*rho**2 g/dp
+!     with rho=p/RT=p/ (R Theta) (p/ps)**kappa
+!     ---------------------------------------------
+
+      DO ilay=1,nlay
+         DO ig=1,ngrid
+            zmass(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/glat(ig)
+	    zExner(ig,ilay)=(pplev(ig,ilay)/pplev(ig,1))**rcp
+	    zovExner(ig,ilay)=1./ppopsk(ig,ilay)
+         ENDDO
+      ENDDO
+
+      zcst1=4.*g*ptimestep/(R*R)
+      DO ilev=2,nlev-1
+         DO ig=1,ngrid
+            zb0(ig,ilev)=pplev(ig,ilev)/(pt(ig,ilev-1)+pt(ig,ilev))
+            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/(pplay(ig,ilev-1)-pplay(ig,ilev))
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+         zb0(ig,1)=ptimestep*pplev(ig,1)/(R*ptsrf(ig))
+      ENDDO
+      dqsdif_total(:)=0.0
+
+!-----------------------------------------------------------------------
+!     2. Add the physical tendencies computed so far
+!     ----------------------------------------------
+
+      DO ilev=1,nlay
+         DO ig=1,ngrid
+            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
+            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
+            zt(ig,ilev)=pt(ig,ilev)+pdtfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=pt(ig,ilev)*zovExner(ig,ilev) !for call vdif_kc, but could be moved and computed there
+        ENDDO
+      ENDDO
+      if(tracer) then
+         DO iq =1, nq
+            DO ilev=1,nlay
+               DO ig=1,ngrid
+                  zq(ig,ilev,iq)=pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep
+               ENDDO
+            ENDDO
+         ENDDO
+         if (water) then
+            DO ilev=1,nlay
+               DO ig=1,ngrid
+                  zqnoevap(ig,ilev)=pq(ig,ilev,ivap) + pdqfi(ig,ilev,ivap)*ptimestep
+               ENDDO
+            ENDDO
+         Endif
+      end if
+
+!-----------------------------------------------------------------------
+!     3. Turbulence scheme
+!     --------------------
+!
+!     Source of turbulent kinetic energy at the surface
+!     ------------------------------------------------- 
+!     Formula is Cd_0 = (karman / log[1+z1/z0])^2
+
+      DO ig=1,ngrid
+         roughratio = 1. + pzlay(ig,1)/pz0
+         cd0 = karman/log(roughratio)
+         cd0 = cd0*cd0
+         zcdv_true(ig) = cd0
+         zcdh_true(ig) = cd0
+       if(nosurf)then
+         zcdv_true(ig)=0.D+0 !JL12 disable atm/surface momentum flux
+         zcdh_true(ig)=0.D+0 !JL12 disable sensible heat flux 
+       endif
+      ENDDO
+
+      DO ig=1,ngrid
+         zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
+         zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+         zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+      ENDDO
+
+!     Turbulent diffusion coefficients in the boundary layer
+!     ------------------------------------------------------ 
+
+      call vdif_kc(ngrid,ptimestep,g,pzlev,pzlay,pu,pv,zh,zcdv_true,pq2,zkv,zkh) !JL12 why not call vdif_kc with updated winds and temperature 
+      
+!     Adding eddy mixing to mimic 3D general circulation in 1D
+!     R. Wordsworth & F. Forget (2010)
+      if ((ngrid.eq.1)) then
+         kmixmin = 1.0e-2       ! minimum eddy mix coeff in 1D
+         do ilev=1,nlay
+            do ig=1,ngrid
+               zkh(ig,ilev) = max(kmixmin,zkh(ig,ilev))
+               zkv(ig,ilev) = max(kmixmin,zkv(ig,ilev)) 
+            end do
+         end do
+      end if
+
+!JL12 change zkv at the surface by zcdv to calculate the surface momentum flux properly
+      DO ig=1,ngrid
+         zkv(ig,1)=zcdv(ig)
+      ENDDO
+!we treat only winds, energy and tracers coefficients will be computed with upadted winds
+ 
+!JL12 calculate the flux coefficients (tables multiplied elements by elements)
+      zfluxv(1:ngrid,1:nlayermx)=zkv(1:ngrid,1:nlayermx)*zb0(1:ngrid,1:nlayermx)
+      
+!-----------------------------------------------------------------------
+!     4. Implicit inversion of u
+!     --------------------------
+
+!     u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
+!     avec
+!     /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
+!     et
+!     dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
+!     donc les entrees sont /zcdv/ pour la condition a la limite sol
+!     et /zkv/ = Ku
+
+      DO ig=1,ngrid
+         z1(ig)=1./(zmass(ig,nlay)+zfluxv(ig,nlay))
+         zcv(ig,nlay)=zmass(ig,nlay)*zu(ig,nlay)*z1(ig)
+         zdv(ig,nlay)=zfluxv(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(zmass(ig,ilay)+zfluxv(ig,ilay) + zfluxv(ig,ilay+1)*(1.-zdv(ig,ilay+1)))
+            zcv(ig,ilay)=(zmass(ig,ilay)*zu(ig,ilay)+zfluxv(ig,ilay+1)*zcv(ig,ilay+1))*z1(ig)
+            zdv(ig,ilay)=zfluxv(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zu(ig,1)=zcv(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zu(ig,ilay)=zcv(ig,ilay)+zdv(ig,ilay)*zu(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+!-----------------------------------------------------------------------
+!     5. Implicit inversion of v
+!     --------------------------
+
+!     v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
+!     avec
+!     /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
+!     et
+!     dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
+!     donc les entrees sont /zcdv/ pour la condition a la limite sol
+!     et /zkv/ = Kv
+
+      DO ig=1,ngrid
+         z1(ig)=1./(zmass(ig,nlay)+zfluxv(ig,nlay)) 
+         zcv(ig,nlay)=zmass(ig,nlay)*zv(ig,nlay)*z1(ig)
+         zdv(ig,nlay)=zfluxv(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(zmass(ig,ilay)+zfluxv(ig,ilay)+zfluxv(ig,ilay+1)*(1.-zdv(ig,ilay+1)))
+            zcv(ig,ilay)=(zmass(ig,ilay)*zv(ig,ilay)+zfluxv(ig,ilay+1)*zcv(ig,ilay+1))*z1(ig)
+            zdv(ig,ilay)=zfluxv(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zv(ig,1)=zcv(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zv(ig,ilay)=zcv(ig,ilay)+zdv(ig,ilay)*zv(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+!     Calcul of wind stress
+
+      DO ig=1,ngrid
+         flux_u(ig) = zfluxv(ig,1)/ptimestep*zu(ig,1)
+         flux_v(ig) = zfluxv(ig,1)/ptimestep*zv(ig,1)
+      ENDDO
+
+
+!----------------------------------------------------------------------------
+!     6. Implicit inversion of h, not forgetting the coupling with the ground
+
+!     h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
+!     avec
+!     /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
+!     et
+!     dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
+!     donc les entrees sont /zcdh/ pour la condition de raccord au sol
+!     et /zkh/ = Kh
+
+!     Using the wind modified by friction for lifting and sublimation
+!     ---------------------------------------------------------------
+      DO ig=1,ngrid
+         zu2      = zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
+         zcdv(ig) = zcdv_true(ig)*sqrt(zu2)
+         zcdh(ig) = zcdh_true(ig)*sqrt(zu2)
+         zkh(ig,1)= zcdh(ig)
+      ENDDO
+
+!     JL12 calculate the flux coefficients (tables multiplied elements by elements)
+!     ---------------------------------------------------------------
+      zfluxq(1:ngrid,1:nlayermx)=zkh(1:ngrid,1:nlayermx)*zb0(1:ngrid,1:nlayermx) !JL12 we save zfluxq which doesn't need the Exner factor
+      zfluxt(1:ngrid,1:nlayermx)=zfluxq(1:ngrid,1:nlayermx)*zExner(1:ngrid,1:nlayermx)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(zmass(ig,nlay)+zfluxt(ig,nlay)*zovExner(ig,nlay))
+         zct(ig,nlay)=zmass(ig,nlay)*zt(ig,nlay)*z1(ig)
+         zdt(ig,nlay)=zfluxt(ig,nlay)*zovExner(ig,nlay-1)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,2,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(zmass(ig,ilay)+zfluxt(ig,ilay)*zovExner(ig,ilay)+   &
+            zfluxt(ig,ilay+1)*(zovExner(ig,ilay)-zdt(ig,ilay+1)*zovExner(ig,ilay+1)))
+            zct(ig,ilay)=(zmass(ig,ilay)*zt(ig,ilay)+zfluxt(ig,ilay+1)*zct(ig,ilay+1)*zovExner(ig,ilay+1))*z1(ig)
+            zdt(ig,ilay)=zfluxt(ig,ilay)*z1(ig)*zovExner(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+!JL12 we treat last point afterward because zovExner(ig,ilay-1) does not exist there
+      DO ig=1,ngrid
+         z1(ig)=1./(zmass(ig,1)+zfluxt(ig,1)*zovExner(ig,1)+  &
+             zfluxt(ig,2)*(zovExner(ig,1)-zdt(ig,2)*zovExner(ig,2)))
+         zct(ig,1)=(zmass(ig,1)*zt(ig,1)+zfluxt(ig,2)*zct(ig,2)*zovExner(ig,2))*z1(ig)
+         zdt(ig,1)=zfluxt(ig,1)*z1(ig)
+      ENDDO
+
+
+!     Calculate (d Planck / dT) at the interface temperature
+!     ------------------------------------------------------
+
+      z4st=4.0*sigma*ptimestep
+      DO ig=1,ngrid
+         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
+      ENDDO
+
+!     Calculate temperature tendency at the interface (dry case)
+!     ----------------------------------------------------------
+!     Sum of fluxes at interface at time t + \delta t gives change in T:
+!       radiative fluxes
+!       turbulent convective (sensible) heat flux
+!       flux (if any) from subsurface
+
+      if(.not.water) then
+
+         DO ig=1,ngrid
+            z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zfluxt(ig,1)*zct(ig,1)*zovExner(ig,1) &
+                + pfluxsrf(ig)*ptimestep + zdplanck(ig)*ptsrf(ig) 
+            z2(ig) = pcapcal(ig)+zdplanck(ig)+cpp*zfluxt(ig,1)*(1.-zovExner(ig,1)*zdt(ig,1)) 
+            ztsrf(ig) = z1(ig) / z2(ig)
+            pdtsrf(ig) = (ztsrf(ig) - ptsrf(ig))/ptimestep
+            zt(ig,1)   = zct(ig,1) + zdt(ig,1)*ztsrf(ig)
+         ENDDO
+! JL12 note that the black body radiative flux emitted by the surface has been updated by the implicit scheme 
+
+
+!     Recalculate temperature to top of atmosphere, starting from ground
+!     ------------------------------------------------------------------
+
+         DO ilay=2,nlay
+            DO ig=1,ngrid
+               zt(ig,ilay)=zct(ig,ilay)+zdt(ig,ilay)*zt(ig,ilay-1)
+            ENDDO
+         ENDDO
+
+      endif                     ! not water
+
+!-----------------------------------------------------------------------
+!     TRACERS (no vapour)
+!     -------
+
+      if(tracer) then
+
+!     Calculate vertical flux from the bottom to the first layer (dust)
+!     -----------------------------------------------------------------
+         do ig=1,ngrid
+            rho(ig) = zb0(ig,1) /ptimestep
+         end do
+
+         pdqsdif(:,:)=0.
+
+!     Implicit inversion of q
+!     -----------------------
+         do iq=1,nq 
+
+            if (iq.ne.ivap) then
+
+               DO ig=1,ngrid
+                  z1(ig)=1./(zmass(ig,nlay)+zfluxq(ig,nlay))
+                  zcq(ig,nlay)=zmass(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+                  zdq(ig,nlay)=zfluxq(ig,nlay)*z1(ig)
+               ENDDO 
+            
+               DO ilay=nlay-1,2,-1
+                  DO ig=1,ngrid
+                     z1(ig)=1./(zmass(ig,ilay)+zfluxq(ig,ilay)+zfluxq(ig,ilay+1)*(1.-zdq(ig,ilay+1)))
+                     zcq(ig,ilay)=(zmass(ig,ilay)*zq(ig,ilay,iq)+zfluxq(ig,ilay+1)*zcq(ig,ilay+1))*z1(ig)
+                     zdq(ig,ilay)=zfluxq(ig,ilay)*z1(ig)
+                  ENDDO
+               ENDDO
+
+               if ((water).and.(iq.eq.iliq)) then
+                  ! special case for condensed water tracer: do not include
+                  ! h2o ice tracer from surface (which is set when handling
+                  ! h2o vapour case (see further down).
+                  ! zb(ig,1)=0 if iq ne ivap
+                  DO ig=1,ngrid
+                     z1(ig)=1./(zmass(ig,1)+zfluxq(ig,2)*(1.-zdq(ig,2)))
+                     zcq(ig,1)=(zmass(ig,1)*zq(ig,1,iq)+zfluxq(ig,2)*zcq(ig,2))*z1(ig)
+                  ENDDO
+               else             ! general case
+                  do ig=1,ngrid
+                     z1(ig)=1./(zmass(ig,1)+zfluxq(ig,2)*(1.-zdq(ig,2)))
+                     zcq(ig,1)=(zmass(ig,1)*zq(ig,1,iq)+zfluxq(ig,2)*zcq(ig,2)+(-pdqsdif(ig,iq))*ptimestep)*z1(ig)
+                          ! tracer flux from surface
+                          ! currently pdqsdif always zero here,
+                          ! so last line is superfluous
+                  enddo
+               endif            ! of if (water.and.(iq.eq.igcm_h2o_ice))
+
+
+!     Starting upward calculations for simple tracer mixing (e.g., dust)
+               do ig=1,ngrid
+                  zq(ig,1,iq)=zcq(ig,1)
+               end do
+
+               do ilay=2,nlay
+                  do ig=1,ngrid
+                     zq(ig,ilay,iq)=zcq(ig,ilay)+zdq(ig,ilay)*zq(ig,ilay-1,iq)
+                  end do
+               end do
+
+            endif               ! if (iq.ne.ivap)
+
+!     Calculate temperature tendency including latent heat term
+!     and assuming an infinite source of water on the ground
+!     ------------------------------------------------------------------
+
+            if (water.and.(iq.eq.ivap)) then 
+            
+               ! compute evaporation efficiency
+               do ig=1,ngrid
+                  if(nint(rnat(ig)).eq.1)then
+                     dryness(ig)=pqsurf(ig,iliq_surf)+pqsurf(ig,iice_surf) 
+                     dryness(ig)=MIN(1.,2*dryness(ig)/mx_eau_sol)
+                     dryness(ig)=MAX(0.,dryness(ig))
+                  endif
+               enddo
+
+               do ig=1,ngrid
+                ! Calculate the value of qsat at the surface (water)
+                call Psat_water(ptsrf(ig),pplev(ig,1),psat(ig),qsat(ig))
+                call Psat_water(ptsrf(ig)-0.0001,pplev(ig,1),psat_temp,qsat_temp1)
+                call Psat_water(ptsrf(ig)+0.0001,pplev(ig,1),psat_temp,qsat_temp2)
+                dqsat(ig)=(qsat_temp2-qsat_temp1)/0.0002
+                ! calculate dQsat / dT by finite differences
+                ! we cannot use the updated temperature value yet...
+	       enddo
+
+! coefficients for q
+
+               do ig=1,ngrid
+                  z1(ig)=1./(zmass(ig,nlay)+zfluxq(ig,nlay))
+                  zcq(ig,nlay)=zmass(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+                  zdq(ig,nlay)=zfluxq(ig,nlay)*z1(ig)
+               enddo 
+          
+               do ilay=nlay-1,2,-1
+                  do ig=1,ngrid
+                     z1(ig)=1./(zmass(ig,ilay)+zfluxq(ig,ilay)+zfluxq(ig,ilay+1)*(1.-zdq(ig,ilay+1)))
+                     zcq(ig,ilay)=(zmass(ig,ilay)*zq(ig,ilay,iq)+zfluxq(ig,ilay+1)*zcq(ig,ilay+1))*z1(ig)
+                     zdq(ig,ilay)=zfluxq(ig,ilay)*z1(ig)
+                  enddo
+               enddo
+
+               do ig=1,ngrid
+                  z1(ig)=1./(zmass(ig,1)+zfluxq(ig,1)*dryness(ig)+zfluxq(ig,2)*(1.-zdq(ig,2)))
+                  zcq(ig,1)=(zmass(ig,1)*zq(ig,1,iq)+zfluxq(ig,2)*zcq(ig,2))*z1(ig)
+                  zdq(ig,1)=dryness(ig)*zfluxq(ig,1)*z1(ig)
+               enddo
+
+              do ig=1,ngrid
+!calculation of surface temperature
+                  zdq0(ig) = dqsat(ig)
+                  zcq0(ig) = qsat(ig)-dqsat(ig)*ptsrf(ig)
+
+                  z1(ig) = pcapcal(ig)*ptsrf(ig) +cpp*zfluxt(ig,1)*zct(ig,1)*zovExner(ig,1)   &
+		      + zdplanck(ig)*ptsrf(ig) + pfluxsrf(ig)*ptimestep                       &
+                      + zfluxq(ig,1)*dryness(ig)*RLVTT*((zdq(ig,1)-1.0)*zcq0(ig)+zcq(ig,1))
+
+                  z2(ig) = pcapcal(ig) + cpp*zfluxt(ig,1)*(1.-zovExner(ig,1)*zdt(ig,1))       &
+                      + zdplanck(ig)+zfluxq(ig,1)*dryness(ig)*RLVTT*zdq0(ig)*(1.0-zdq(ig,1))
+
+                  ztsrf(ig) = z1(ig) / z2(ig)
+
+! calculation of qs and q1
+                  zq0(ig)     = zcq0(ig)+zdq0(ig)*ztsrf(ig)
+                  zq(ig,1,iq) = zcq(ig,1)+zdq(ig,1)*zq0(ig)
+
+! calculation of evaporation              
+                  dqsdif_total(ig)=zfluxq(ig,1)*dryness(ig)*(zq(ig,1,ivap)-zq0(ig))
+
+!     --------------------------------------------------------
+!     Now check if we've taken too much water from the surface
+!     This can only occur on the continent 
+!     If we do, we recompute Tsurf, T1 and q1 accordingly
+                  if((-dqsdif_total(ig).gt.(pqsurf(ig,iice_surf)+pqsurf(ig,iliq_surf))).and.rnat(ig).eq.1)then
+                      !water flux * ptimestep
+	              dqsdif_total(ig)=-(pqsurf(ig,iice_surf)+pqsurf(ig,iliq_surf))
+
+                      !recompute surface temperature  
+                      z1(ig) = pcapcal(ig)*ptsrf(ig) +cpp*zfluxq(ig,1)*zct(ig,1)*zovExner(ig,1)   &
+		        + zdplanck(ig)*ptsrf(ig) + pfluxsrf(ig)*ptimestep                       &
+                        + RLVTT*dqsdif_total(ig)
+                      z2(ig) = pcapcal(ig) + cpp*zfluxq(ig,1)*(1.-zovExner(ig,1)*zdt(ig,1))       &
+                        + zdplanck(ig)
+                      ztsrf(ig) = z1(ig) / z2(ig)
+
+                      !recompute q1 with new water flux from surface  
+                      zq(ig,1,iq) = (zmass(ig,1)*(pq(ig,1,iq)+ptimestep*pdqfi(ig,1,iq))  &
+		                            +zfluxq(ig,2)*zcq(ig,2)-dqsdif_total(ig))     &
+                                 / (zmass(ig,1)+(1.-zdq(ig,2))*zfluxq(ig,2))		     
+                  end if
+		  
+! calculation surface T tendency  and T(1)           
+		  pdtsrf(ig) = (ztsrf(ig) - ptsrf(ig))/ptimestep
+                  zt(ig,1)   = zct(ig,1) + zdt(ig,1)*ztsrf(ig)		      
+               enddo
+
+
+! recalculate temperature and q(vap) to top of atmosphere, starting from ground
+               do ilay=2,nlay
+                  do ig=1,ngrid
+                     zq(ig,ilay,iq)=zcq(ig,ilay)+zdq(ig,ilay)*zq(ig,ilay-1,iq)
+                     zt(ig,ilay)=zct(ig,ilay)+zdt(ig,ilay)*zt(ig,ilay-1)
+                  end do
+               end do
+
+
+               do ig=1,ngrid
+!     --------------------------------------------------------------------------
+!     On the ocean, if T > 0 C then the vapour tendency must replace the ice one
+!     The surface vapour tracer is actually liquid. To make things difficult.
+
+                  if (nint(rnat(ig)).eq.0) then ! unfrozen ocean
+                     
+                     pdqsdif(ig,iliq_surf)=dqsdif_total(ig)/ptimestep
+                     pdqsdif(ig,iice_surf)=0.0
+
+                  elseif (nint(rnat(ig)).eq.1) then ! (continent)
+!     If water is evaporating / subliming, we take it from ice before liquid
+!     -- is this valid??
+                     if(dqsdif_total(ig).lt.0)then
+                        if (-dqsdif_total(ig).gt.pqsurf(ig,iice_surf))then
+                           pdqsdif(ig,iice_surf) = -pqsurf(ig,iice_surf)/ptimestep ! removes all the ice!
+                           pdqsdif(ig,iliq_surf) = dqsdif_total(ig)/ptimestep- pdqsdif(ig,iice_surf) ! take the remainder from the liquid instead
+			else               
+                           pdqsdif(ig,iice_surf)=dqsdif_total(ig)/ptimestep
+			   pdqsdif(ig,iliq_surf)=0.
+			end if
+	             else !dqsdif_total(ig).ge.0
+                        !If water vapour is condensing, we must decide whether it forms ice or liquid.
+                        if(ztsrf(ig).gt.T_h2O_ice_liq)then
+                           pdqsdif(ig,iice_surf)=0.0
+                           pdqsdif(ig,iliq_surf)=dqsdif_total(ig)/ptimestep
+                        else
+                           pdqsdif(ig,iice_surf)=dqsdif_total(ig)/ptimestep
+                           pdqsdif(ig,iliq_surf)=0.0
+                        endif               
+                     endif
+
+                  elseif (nint(rnat(ig)).eq.2) then ! (continental glaciers)
+		     pdqsdif(ig,iliq_surf)=0.0
+                     pdqsdif(ig,iice_surf)=dqsdif_total(ig)/ptimestep
+
+		  endif !rnat
+               end do            ! of DO ig=1,ngrid
+
+           endif                ! if (water et iq=ivap)
+        end do                  ! of do iq=1,nq
+
+        if (water) then  ! special case where we recompute water mixing without any evaporation.
+	                 !    The difference with the first calculation then tells us where evaporated water has gone
+
+            DO ig=1,ngrid
+               z1(ig)=1./(zmass(ig,nlay)+zfluxq(ig,nlay))
+               zcq(ig,nlay)=zmass(ig,nlay)*zqnoevap(ig,nlay)*z1(ig)
+               zdq(ig,nlay)=zfluxq(ig,nlay)*z1(ig)
+            ENDDO 
+            
+            DO ilay=nlay-1,2,-1
+               DO ig=1,ngrid
+                  z1(ig)=1./(zmass(ig,ilay)+zfluxq(ig,ilay)+zfluxq(ig,ilay+1)*(1.-zdq(ig,ilay+1)))
+                  zcq(ig,ilay)=(zmass(ig,ilay)*zqnoevap(ig,ilay)+zfluxq(ig,ilay+1)*zcq(ig,ilay+1))*z1(ig)
+                  zdq(ig,ilay)=zfluxq(ig,ilay)*z1(ig)
+               ENDDO
+            ENDDO
+
+            do ig=1,ngrid
+               z1(ig)=1./(zmass(ig,1)+zfluxq(ig,2)*(1.-zdq(ig,2)))
+               zcq(ig,1)=(zmass(ig,1)*zqnoevap(ig,1)+zfluxq(ig,2)*zcq(ig,2))*z1(ig)
+            enddo
+
+!     Starting upward calculations for simple tracer mixing (e.g., dust)
+            do ig=1,ngrid
+               zqnoevap(ig,1)=zcq(ig,1)
+            end do
+
+            do ilay=2,nlay
+               do ig=1,ngrid
+                  zqnoevap(ig,ilay)=zcq(ig,ilay)+zdq(ig,ilay)*zqnoevap(ig,ilay-1)
+               end do
+            end do
+
+         endif               ! if water
+	
+	
+      endif                     ! tracer
+
+
+!-----------------------------------------------------------------------
+!     8. Final calculation of the vertical diffusion tendencies
+!     -----------------------------------------------------------------
+
+      do ilev = 1, nlay
+         do ig=1,ngrid
+            pdudif(ig,ilev)=(zu(ig,ilev)-(pu(ig,ilev)+pdufi(ig,ilev)*ptimestep))/ptimestep
+            pdvdif(ig,ilev)=(zv(ig,ilev)-(pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep))/ptimestep
+            pdtdif(ig,ilev)=( zt(ig,ilev)- pt(ig,ilev))/ptimestep-pdtfi(ig,ilev)
+         enddo
+      enddo
+      
+      DO ig=1,ngrid ! computing sensible heat flux (atm => surface)
+	 sensibFlux(ig)=cpp*zfluxt(ig,1)/ptimestep*(zt(ig,1)*zovExner(ig,1)-ztsrf(ig))
+      ENDDO
+
+      if (tracer) then
+         do iq = 1, nq
+            do ilev = 1, nlay
+               do ig=1,ngrid
+                  pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-(pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
+               enddo
+            enddo
+         enddo
+	 if (water) then
+            do ilev = 1, nlay
+               do ig=1,ngrid
+                  pdqevap(ig,ilev)=(zq(ig,ilev,ivap)-zqnoevap(ig,ilev))/ptimestep
+               enddo
+            enddo
+            do ig=1,ngrid
+	       zdmassevap(ig)=SUM(pdqevap(ig,:)*zmass(ig,:))*ptimestep
+	    end do	    
+	 endif
+      endif 
+
+      if(water)then
+         call writediagfi(ngrid,'beta','Dryness coefficient',' ',2,dryness)
+         if (tracer) then
+            call writediagfi(ngrid,'dqevap','evaporated water vapor specific concentration','s-1',3,pdqevap)
+	 endif
+      endif
+
+!      if(lastcall)then
+!        if(ngrid.eq.1)then
+!           print*,'Saving k.out...'
+!           OPEN(12,file='k.out',form='formatted')
+!           DO ilay=1,nlay
+!              write(12,*) zkh(1,ilay), pplay(1,ilay)
+!           ENDDO
+!           CLOSE(12)
+!         endif
+!      endif
+
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdif_cd.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdif_cd.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdif_cd.F	(revision 222)
@@ -0,0 +1,75 @@
+      SUBROUTINE vdif_cd( ngrid,nlay,pz0,pg,pz,pu,pv,pts,ph,pcdv,pcdh)
+      IMPLICIT NONE
+c=======================================================================
+c
+c   Subject: computation of the surface drag coefficient using the
+c   -------  approch developed by Loui for ECMWF.
+c
+c   Author: Frederic Hourdin  15 /10 /93
+c   -------
+c
+c   Arguments:
+c   ----------
+c
+c   inputs:
+c   ------
+c     ngrid            size of the horizontal grid
+c     pg               gravity (m s -2)
+c     pz(ngrid)        height of the first atmospheric layer
+c     pu(ngrid)        u component of the wind in that layer
+c     pv(ngrid)        v component of the wind in that layer
+c     pts(ngrid)       surfacte temperature
+c     ph(ngrid)        potential temperature T*(p/ps)^kappa
+c
+c   outputs:
+c   --------
+c     pcdv(ngrid)      Cd for the wind
+c     pcdh(ngrid)      Cd for potential temperature
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+c   Arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL pz0
+      REAL pg,pz(ngrid,nlay)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay)
+      REAL pts(ngrid,nlay),ph(ngrid,nlay)
+      REAL pcdv(ngrid),pcdh(ngrid)
+
+c   Local:
+c   ------
+
+      INTEGER ig
+
+      REAL zu2,z1,zri,zcd0,zz
+
+      REAL karman,b,c,d,c2b,c3bc,c3b,umin2
+      LOGICAL firstcal
+      DATA karman,b,c,d,umin2/.4,5.,5.,5.,1.e-12/
+      DATA firstcal/.true./
+      SAVE b,c,d,karman,c2b,c3bc,c3b,firstcal,umin2
+
+c-----------------------------------------------------------------------
+c   couche de surface:
+c   ------------------
+
+! simplified calculation
+
+      DO ig=1,ngrid
+         z1=1.E+0 + pz(ig,1)/pz0
+         zcd0=karman/log(z1)
+         zcd0=zcd0*zcd0
+         pcdv(ig)=zcd0
+         pcdh(ig)=zcd0
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdif_kc.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdif_kc.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdif_kc.F	(revision 222)
@@ -0,0 +1,534 @@
+      SUBROUTINE vdif_kc(ngrid,dt,g,zlev,zlay,u,v,teta,cd,q2,km,kn)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphys.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c 
+c.......................................................................
+      INTEGER,INTENT(IN) :: ngrid
+      REAL,INTENT(IN) :: dt,g
+      REAL,INTENT(IN) :: zlev(ngrid,nlayermx+1)
+      REAL,INTENT(IN) :: zlay(ngrid,nlayermx)
+      REAL,INTENT(IN) :: u(ngrid,nlayermx)
+      REAL,INTENT(IN) :: v(ngrid,nlayermx)
+      REAL,INTENT(IN) :: teta(ngrid,nlayermx)
+      REAL,INTENT(IN) :: cd(ngrid)
+      REAL,INTENT(INOUT) :: q2(ngrid,nlayermx+1)
+      REAL,INTENT(OUT) :: km(ngrid,nlayermx+1)
+      REAL,INTENT(OUT) :: kn(ngrid,nlayermx+1)
+c.......................................................................
+c
+c nlay : nombre de couches        
+c nlev : nombre de niveaux
+c ngrid : nombre de points de grille       
+c unsdz : 1 sur l'epaisseur de couche
+c unsdzdec : 1 sur la distance entre le centre de la couche et le
+c            centre de la couche inferieure
+c q : echelle de vitesse au bas de chaque couche
+c     (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      INTEGER,PARAMETER :: nlay=nlayermx
+      INTEGER,PARAMETER :: nlev=nlayermx+1
+      REAL unsdz(ngrid,nlayermx)
+      REAL unsdzdec(ngrid,nlayermx+1)
+      REAL q(ngrid,nlayermx+1)
+c.......................................................................
+c
+c kmpre : km au debut du pas de temps
+c qcstat : q : solution stationnaire du probleme couple
+c          (valeur a la fin du pas de temps)
+c q2cstat : q2 : solution stationnaire du probleme couple
+c           (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL kmpre(ngrid,nlayermx+1)
+      REAL qcstat
+      REAL q2cstat
+c.......................................................................
+c
+c long : longueur de melange calculee selon Blackadar
+c
+c.......................................................................
+      REAL long(ngrid,nlayermx+1)
+c.......................................................................
+c
+c kmq3 : terme en q^3 dans le developpement de km
+c        (valeur au debut du pas de temps)
+c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c knq3 : terme en q^3 dans le developpement de kn
+c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
+c          (valeur a la fin du pas de temps)
+c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c m : valeur a la fin du pas de temps
+c mpre : valeur au debut du pas de temps
+c m2 : valeur a la fin du pas de temps
+c n2 : valeur a la fin du pas de temps
+c 
+c.......................................................................
+      REAL kmq3
+      REAL kmcstat
+      REAL knq3
+      REAL mcstat
+      REAL m2cstat
+      REAL m(ngrid,nlayermx+1)
+      REAL mpre(ngrid,nlayermx+1)
+      REAL m2(ngrid,nlayermx+1)
+      REAL n2(ngrid,nlayermx+1)
+c.......................................................................
+c
+c gn : intermediaire pour les coefficients de stabilite
+c gnmin : borne inferieure de gn (-0.23 ou -0.28)
+c gnmax : borne superieure de gn (0.0233)
+c gninf : vrai si gn est en dessous de sa borne inferieure
+c gnsup : vrai si gn est en dessus de sa borne superieure
+c gm : drole d'objet bien utile
+c ri : nombre de Richardson
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c sm : coefficient de stabilite pour m
+c smq2 : premier terme du developement limite de sm en q2
+c
+c.......................................................................
+      REAL gn
+      REAL,PARAMETER :: gnmin=-10.E+0
+      REAL,PARAMETER :: gnmax=0.0233E+0
+      LOGICAL gninf
+      LOGICAL gnsup
+      REAL gm
+c      REAL ri(ngrid,nlayermx+1)
+      REAL sn(ngrid,nlayermx+1)
+      REAL snq2(ngrid,nlayermx+1)
+      REAL sm(ngrid,nlayermx+1)
+      REAL smq2(ngrid,nlayermx+1)
+c.......................................................................
+c
+c kappa : consatnte de Von Karman (0.4)
+c long0 : longueur de reference pour le calcul de long (160)
+c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
+c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
+c cn1,cn2 : constantes pour sn
+c cm1,cm2,cm3,cm4 : constantes pour sm
+c
+c.......................................................................
+      REAL,PARAMETER :: kappa=0.4E+0
+      REAL,PARAMETER :: long0=160.E+0
+      REAL,PARAMETER :: a1=0.92E+0,a2=0.74E+0
+      REAL,PARAMETER :: b1=16.6E+0,b2=10.1E+0,c1=0.08E+0
+      REAL,PARAMETER :: cn1=a2*(1.E+0 -6.E+0 *a1/b1)
+      REAL,PARAMETER :: cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
+      REAL,PARAMETER :: cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
+      REAL,PARAMETER :: cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*
+     &          (1.E+0 -6.E+0 *a1/b1)-3.E+0 *c1*(b2+6.E+0 *a1)))
+      REAL,PARAMETER :: cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
+      REAL,PARAMETER :: cm4=-9.E+0 *a1*a2
+c.......................................................................
+c
+c termq : termes en $q$ dans l'equation de q2
+c termq3 : termes en $q^3$ dans l'equation de q2
+c termqm2 : termes en $q*m^2$ dans l'equation de q2
+c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
+c
+c.......................................................................
+      REAL termq
+      REAL termq3
+      REAL termqm2
+      REAL termq3m2
+c.......................................................................
+c
+c q2min : borne inferieure de q2
+c q2max : borne superieure de q2
+c
+c.......................................................................
+      REAL,PARAMETER :: q2min=1.E-3
+      REAL,PARAMETER :: q2max=1.E+2
+c.......................................................................
+c knmin : borne inferieure de kn
+c kmmin : borne inferieure de km
+c.......................................................................
+      REAL,PARAMETER :: knmin=1.E-5
+      REAL,PARAMETER :: kmmin=1.E-5
+c.......................................................................
+      INTEGER ilay,ilev,igrid
+      REAL tmp1,tmp2
+c.......................................................................
+c
+
+! initialization of local variables:
+      long(:,:)=0.
+      n2(:,:)=0.
+      sn(:,:)=0.
+      snq2(:,:)=0.
+      sm(:,:)=0.
+      smq2(:,:)=0.
+
+c.......................................................................
+c  traitment des valeur de q2 en entree
+c.......................................................................
+c
+      DO ilev=1,nlev
+       DO igrid=1,ngrid 
+        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
+        q(igrid,ilev)=sqrt(q2(igrid,ilev))
+       ENDDO
+      ENDDO
+c
+      DO igrid=1,ngrid
+        tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
+        q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
+        q2(igrid,1)=amax1(q2(igrid,1),q2min)
+        q(igrid,1)=sqrt(q2(igrid,1))
+      ENDDO
+c
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+c                                                     DO igrid=1,ngrid 
+c           zlev(igrid,nlev)=zlay(igrid,nlay)
+c    &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
+c                                                     ENDDO            
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO ilay=1,nlay
+       DO igrid=1,ngrid
+        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
+       ENDDO
+      ENDDO
+
+      DO igrid=1,ngrid
+        unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
+      ENDDO
+
+      DO ilay=2,nlay
+        DO igrid=1,ngrid
+          unsdzdec(igrid,ilay)=1.E+0/
+     &                          (zlay(igrid,ilay)-zlay(igrid,ilay-1))
+        ENDDO
+      ENDDO
+      
+      DO igrid=1,ngrid
+        unsdzdec(igrid,nlay+1)=1.E+0/
+     &                          (zlev(igrid,nlay+1)-zlay(igrid,nlay))
+      ENDDO
+c
+c.......................................................................
+c  le cisaillement et le gradient de temperature
+c.......................................................................
+c
+      DO igrid=1,ngrid
+        m2(igrid,1)=(unsdzdec(igrid,1)
+     &                   *u(igrid,1))**2
+     &                 +(unsdzdec(igrid,1)
+     &                   *v(igrid,1))**2
+        m(igrid,1)=sqrt(m2(igrid,1))
+        mpre(igrid,1)=m(igrid,1)
+      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+       DO igrid=1,ngrid
+c-----------------------------------------------------------------------
+c
+        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
+     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
+     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
+c
+c --->
+c       on ne sais traiter que les cas stratifies. et l'ajustement
+c       convectif est cense faire en sorte que seul des configurations
+c       stratifiees soient rencontrees en entree de cette routine.
+c       mais, bon ... on sait jamais (meme on sait que n2 prends
+c       quelques valeurs negatives ... parfois) alors : 
+c<---
+c
+        IF (n2(igrid,ilev).lt.0.E+0) THEN
+          n2(igrid,ilev)=0.E+0
+        ENDIF
+c
+        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
+     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
+     &                   +(unsdzdec(igrid,ilev)
+     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
+        m(igrid,ilev)=sqrt(m2(igrid,ilev))
+        mpre(igrid,ilev)=m(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+       ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+      DO igrid=1,ngrid
+        m2(igrid,nlev)=m2(igrid,nlev-1)
+        m(igrid,nlev)=m(igrid,nlev-1)
+        mpre(igrid,nlev)=m(igrid,nlev)
+      ENDDO
+      
+c
+c.......................................................................
+c  calcul des fonctions de stabilite
+c.......................................................................
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+       DO igrid=1,ngrid
+c-----------------------------------------------------------------------
+c
+        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
+        long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0)
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * m2(igrid,ilev)
+c
+        gninf=.false.
+        gnsup=.false.
+        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev)
+c
+        IF (gn.lt.gnmin) THEN
+          gninf=.true.
+          gn=gnmin
+        ENDIF
+c
+        IF (gn.gt.gnmax) THEN
+          gnsup=.true.
+          gn=gnmax
+        ENDIF
+c
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)
+     &     *(1.E+0 +cm4*gn) )
+c
+        IF ((gninf).or.(gnsup)) THEN
+          snq2(igrid,ilev)=0.E+0
+          smq2(igrid,ilev)=0.E+0
+        ELSE
+          snq2(igrid,ilev)=
+     &     -gn
+     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
+          smq2(igrid,ilev)=
+     &     -gn
+     &     *( cm2*(1.E+0 +cm3*gn)
+     &           *(1.E+0 +cm4*gn)
+     &       -( cm3*(1.E+0 +cm4*gn)
+     &         +cm4*(1.E+0 +cm3*gn) )
+     &       *(cm1+cm2*gn)            )
+     &     /( (1.E+0 +cm3*gn)
+     &       *(1.E+0 +cm4*gn) )**2
+        ENDIF
+c
+c --->
+c       la decomposition de Taylor en q2 n'a de sens que
+c       dans les cas stratifies ou sn et sm sont quasi
+c       proportionnels a q2. ailleurs on laisse le meme
+c       algorithme car l'ajustement convectif fait le travail.
+c       mais c'est delirant quand sn et snq2 n'ont pas le meme
+c       signe : dans ces cas, on ne fait pas la decomposition.
+c<---
+c
+        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
+     &      snq2(igrid,ilev)=0.E+0
+        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
+     &      smq2(igrid,ilev)=0.E+0
+c
+c-----------------------------------------------------------------------
+       ENDDO ! of DO igrid=1,ngrid
+      ENDDO ! of DO ilev=2,nlev-1
+c-----------------------------------------------------------------------
+c
+c.......................................................................
+c  calcul de km et kn au debut du pas de temps
+c.......................................................................
+c
+      DO igrid=1,ngrid
+        kn(igrid,1)=knmin
+        km(igrid,1)=kmmin
+        kmpre(igrid,1)=km(igrid,1)
+      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+       DO igrid=1,ngrid
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sm(igrid,ilev)
+        kmpre(igrid,ilev)=km(igrid,ilev)
+       ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+      DO igrid=1,ngrid
+        kn(igrid,nlev)=kn(igrid,nlev-1)
+        km(igrid,nlev)=km(igrid,nlev-1)
+        kmpre(igrid,nlev)=km(igrid,nlev)
+      ENDDO
+c
+c.......................................................................
+c  boucle sur les niveaux 2 a nlev-1
+c.......................................................................
+c
+c---->
+      DO 10001 ilev=2,nlev-1
+c---->
+      DO 10002 igrid=1,ngrid
+c
+c.......................................................................
+c
+c  calcul des termes sources et puits de l'equation de q2
+c  ------------------------------------------------------
+c
+        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
+     &                                    /sn(igrid,ilev)
+        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
+     &                                    /sm(igrid,ilev)
+c
+        termq=0.E+0
+        termq3=0.E+0
+        termqm2=0.E+0
+        termq3m2=0.E+0
+c
+        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termqm2=termqm2
+     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termq3m2=termq3m2
+     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
+c 
+        termq=termq
+     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
+     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
+        termq3=termq3
+     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
+c
+        termq3=termq3
+     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
+c
+c.......................................................................
+c
+c  resolution stationnaire couplee avec le gradient de vitesse local
+c  -----------------------------------------------------------------
+c
+c  -----{on cherche le cisaillement qui annule l'equation de q^2
+c        supposee en q3}
+c
+        tmp1=termq+termq3
+        tmp2=termqm2+termq3m2
+        m2cstat=m2(igrid,ilev)
+     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
+        mcstat=sqrt(m2cstat)
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (ilev.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)
+     &              *cd(igrid)
+     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
+     &                -mcstat/unsdzdec(igrid,ilev)
+     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
+     &                          *mpre(igrid,ilev-1) )
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ENDIF
+        tmp2=kmcstat
+     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
+     &      /long(igrid,ilev)
+        qcstat=tmp2**(1.E+0/3.E+0)
+        q2cstat=qcstat**2
+c
+c.......................................................................
+c
+c  choix de la solution finale
+c  ---------------------------
+c
+          q(igrid,ilev)=qcstat
+          q2(igrid,ilev)=q2cstat
+          m(igrid,ilev)=mcstat
+          m2(igrid,ilev)=m2cstat
+c
+c --->
+c       pour des raisons simples q2 est minore 
+c<---
+c
+        IF (q2(igrid,ilev).lt.q2min) THEN
+          q2(igrid,ilev)=q2min
+          q(igrid,ilev)=sqrt(q2min)
+        ENDIF
+c
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sm(igrid,ilev)
+c
+c.......................................................................
+c
+10002 CONTINUE
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+c
+      DO igrid=1,ngrid
+        kn(igrid,1)=knmin
+        km(igrid,1)=kmmin
+        q2(igrid,nlev)=q2(igrid,nlev-1)
+        q(igrid,nlev)=q(igrid,nlev-1)
+        kn(igrid,nlev)=kn(igrid,nlev-1)
+        km(igrid,nlev)=km(igrid,nlev-1)
+      ENDDO
+
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdifc.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdifc.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vdifc.F	(revision 222)
@@ -0,0 +1,729 @@
+      subroutine vdifc(ngrid,nlay,nq,rnat,ppopsk,         
+     &     ptimestep,pcapcal,lecrit,                        
+     &     pplay,pplev,pzlay,pzlev,pz0,
+     &     pu,pv,ph,pq,ptsrf,pemis,pqsurf,
+     &     pdufi,pdvfi,pdhfi,pdqfi,pfluxsrf,
+     &     pdudif,pdvdif,pdhdif,pdtsrf,sensibFlux,pq2,
+     &     pdqdif,pdqsdif,lastcall)
+
+      use watercommon_h, only : RLVTT, T_h2O_ice_liq, RCPD, mx_eau_sol
+      use radcommon_h, only : sigma
+      USE surfdat_h
+      USE comgeomfi_h
+      USE tracer_h
+
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Turbulent diffusion (mixing) for pot. T, U, V and tracers
+!     
+!     Implicit scheme
+!     We start by adding to variables x the physical tendencies
+!     already computed. We resolve the equation:
+!
+!     x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
+!     
+!     Authors
+!     ------- 
+!     F. Hourdin, F. Forget, R. Fournier (199X)
+!     R. Wordsworth, B. Charnay (2010)
+!     
+!==================================================================
+
+!-----------------------------------------------------------------------
+!     declarations
+!     ------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+
+!     arguments
+!     ---------
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
+      REAL ptsrf(ngrid),pemis(ngrid)
+      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
+      REAL pfluxsrf(ngrid)
+      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
+      REAL pdtsrf(ngrid),sensibFlux(ngrid),pcapcal(ngrid)
+      REAL pq2(ngrid,nlay+1)
+      
+      real rnat(ngrid)      
+
+!     Arguments added for condensation
+      REAL ppopsk(ngrid,nlay)
+      logical lecrit
+      REAL pz0
+
+!     Tracers
+!     --------
+      integer nq 
+      real pqsurf(ngrid,nq)
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
+      real pdqdif(ngrid,nlay,nq) 
+      real pdqsdif(ngrid,nq) 
+      
+!     local
+!     -----
+      integer ilev,ig,ilay,nlev
+
+      REAL z4st,zdplanck(ngrid)
+      REAL zkv(ngrid,nlayermx+1),zkh(ngrid,nlayermx+1)
+      REAL zcdv(ngrid),zcdh(ngrid)
+      REAL zcdv_true(ngrid),zcdh_true(ngrid)
+      REAL zu(ngrid,nlayermx),zv(ngrid,nlayermx)
+      REAL zh(ngrid,nlayermx)
+      REAL ztsrf2(ngrid)
+      REAL z1(ngrid),z2(ngrid)
+      REAL za(ngrid,nlayermx),zb(ngrid,nlayermx)
+      REAL zb0(ngrid,nlayermx)
+      REAL zc(ngrid,nlayermx),zd(ngrid,nlayermx)
+      REAL zcst1
+      REAL zu2!, a
+      REAL zcq(ngrid,nlayermx),zdq(ngrid,nlayermx)
+      REAL evap(ngrid)
+      REAL zcq0(ngrid),zdq0(ngrid)
+      REAL zx_alf1(ngrid),zx_alf2(ngrid)
+
+      LOGICAL firstcall
+      SAVE firstcall
+      
+      LOGICAL lastcall
+
+!     variables added for CO2 condensation
+!     ------------------------------------
+      REAL hh                   !, zhcond(ngrid,nlayermx)
+!     REAL latcond,tcond1mb
+!     REAL acond,bcond
+!     SAVE acond,bcond
+!     DATA latcond,tcond1mb/5.9e5,136.27/
+
+!     Tracers
+!     -------
+      INTEGER iq
+      REAL zq(ngrid,nlayermx,nq)
+      REAL zq1temp(ngrid)
+      REAL rho(ngrid)         ! near-surface air density
+      REAL qsat(ngrid)
+      DATA firstcall/.true./
+      REAL kmixmin
+
+!     Variables added for implicit latent heat inclusion
+!     --------------------------------------------------
+      real latconst, dqsat(ngrid), qsat_temp1, qsat_temp2
+      real z1_Tdry(ngrid), z2_Tdry(ngrid)
+      real z1_T(ngrid), z2_T(ngrid)
+      real zb_T(ngrid)
+      real zc_T(ngrid,nlayermx)
+      real zd_T(ngrid,nlayermx)
+      real lat1(ngrid), lat2(ngrid)
+      real surfh2otot
+      logical surffluxdiag
+      integer isub ! sub-loop for precision
+
+      integer ivap, iice ! also make liq for clarity on surface...
+      save ivap, iice
+
+      real, parameter :: karman=0.4
+      real cd0, roughratio
+
+      logical forceWC
+      real masse, Wtot, Wdiff
+
+      real dqsdif_total(ngrid) 
+      real zq0(ngrid) 
+
+      forceWC=.true.
+!      forceWC=.false.
+
+
+!     Coherence test
+!     --------------
+
+      IF (firstcall) THEN
+!     To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal)
+!     bcond=1./tcond1mb
+!     acond=r/latcond
+!     PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+!     PRINT*,'          acond,bcond',acond,bcond
+
+         if(water)then
+!                iliq=igcm_h2o_vap
+                ivap=igcm_h2o_vap
+                iice=igcm_h2o_ice ! simply to make the code legible               
+                                  ! to be generalised later
+         endif
+
+         firstcall=.false.
+      ENDIF
+
+!-----------------------------------------------------------------------
+!     1. Initialisation
+!     -----------------
+
+      nlev=nlay+1
+
+!     Calculate rho*dz and dt*rho/dz=dt*rho**2 g/dp
+!     with rho=p/RT=p/ (R Theta) (p/ps)**kappa
+!     ---------------------------------------------
+
+      DO ilay=1,nlay
+         DO ig=1,ngrid
+            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
+         ENDDO
+      ENDDO
+
+      zcst1=4.*g*ptimestep/(R*R)
+      DO ilev=2,nlev-1
+         DO ig=1,ngrid
+            zb0(ig,ilev)=pplev(ig,ilev)*
+     s           (pplev(ig,1)/pplev(ig,ilev))**rcp /
+     s           (ph(ig,ilev-1)+ph(ig,ilev))
+            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
+     s           (pplay(ig,ilev-1)-pplay(ig,ilev))
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+         zb0(ig,1)=ptimestep*pplev(ig,1)/(R*ptsrf(ig))
+      ENDDO
+
+      dqsdif_total(:)=0.0
+
+!-----------------------------------------------------------------------
+!     2. Add the physical tendencies computed so far
+!     ----------------------------------------------
+
+      DO ilev=1,nlay
+         DO ig=1,ngrid
+            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
+            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
+         ENDDO
+      ENDDO
+      if(tracer) then
+         DO iq =1, nq
+            DO ilev=1,nlay
+               DO ig=1,ngrid
+                  zq(ig,ilev,iq)=pq(ig,ilev,iq) + 
+     &                 pdqfi(ig,ilev,iq)*ptimestep
+               ENDDO
+            ENDDO
+         ENDDO
+      end if
+
+!-----------------------------------------------------------------------
+!     3. Turbulence scheme
+!     --------------------
+!
+!     Source of turbulent kinetic energy at the surface
+!     ------------------------------------------------- 
+!     Formula is Cd_0 = (karman / log[1+z1/z0])^2
+
+      DO ig=1,ngrid
+         roughratio = 1.E+0 + pzlay(ig,1)/pz0
+         cd0 = karman/log(roughratio)
+         cd0 = cd0*cd0
+         zcdv_true(ig) = cd0
+         zcdh_true(ig) = cd0
+         if (nosurf) then
+             zcdv_true(ig) = 0.   !! disable sensible momentum flux
+             zcdh_true(ig) = 0.   !! disable sensible heat flux
+         endif
+      ENDDO
+
+      DO ig=1,ngrid
+         zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
+         zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+         zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+      ENDDO
+
+!     Turbulent diffusion coefficients in the boundary layer
+!     ------------------------------------------------------ 
+
+      call vdif_kc(ngrid,ptimestep,g,pzlev,pzlay
+     &     ,pu,pv,ph,zcdv_true
+     &     ,pq2,zkv,zkh)
+
+!     Adding eddy mixing to mimic 3D general circulation in 1D
+!     R. Wordsworth & F. Forget (2010)
+      if ((ngrid.eq.1)) then
+         kmixmin = 1.0e-2       ! minimum eddy mix coeff in 1D
+         do ilev=1,nlay
+            do ig=1,ngrid
+               !zkh(ig,ilev) = 1.0
+               zkh(ig,ilev) = max(kmixmin,zkh(ig,ilev))
+               zkv(ig,ilev) = max(kmixmin,zkv(ig,ilev))
+            end do
+         end do
+      end if
+
+!-----------------------------------------------------------------------
+!     4. Implicit inversion of u
+!     --------------------------
+
+!     u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
+!     avec
+!     /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
+!     et
+!     dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
+!     donc les entrees sont /zcdv/ pour la condition a la limite sol
+!     et /zkv/ = Ku
+      
+      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdv,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
+     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zu(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+!-----------------------------------------------------------------------
+!     5. Implicit inversion of v
+!     --------------------------
+
+!     v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
+!     avec
+!     /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
+!     et
+!     dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
+!     donc les entrees sont /zcdv/ pour la condition a la limite sol
+!     et /zkv/ = Kv
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
+     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zv(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+!----------------------------------------------------------------------------
+!     6. Implicit inversion of h, not forgetting the coupling with the ground
+
+!     h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
+!     avec
+!     /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
+!     et
+!     dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
+!     donc les entrees sont /zcdh/ pour la condition de raccord au sol
+!     et /zkh/ = Kh
+
+!     Using the wind modified by friction for lifting and sublimation
+!     ---------------------------------------------------------------
+         DO ig=1,ngrid
+            zu2      = zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
+            zcdv(ig) = zcdv_true(ig)*sqrt(zu2)
+            zcdh(ig) = zcdh_true(ig)*sqrt(zu2)
+         ENDDO
+
+      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdh,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,2,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     &           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
+     &           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     &        zb(ig,2)*(1.-zd(ig,2)))
+         zc(ig,1)=(za(ig,1)*zh(ig,1)+
+     &        zb(ig,2)*zc(ig,2))*z1(ig)
+         zd(ig,1)=zb(ig,1)*z1(ig)
+      ENDDO
+
+!     Calculate (d Planck / dT) at the interface temperature
+!     ------------------------------------------------------
+
+      z4st=4.0*sigma*ptimestep
+      DO ig=1,ngrid
+         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
+      ENDDO
+
+!     Calculate temperature tendency at the interface (dry case)
+!     ----------------------------------------------------------
+!     Sum of fluxes at interface at time t + \delta t gives change in T:
+!       radiative fluxes
+!       turbulent convective (sensible) heat flux
+!       flux (if any) from subsurface
+
+      if(.not.water) then
+
+         DO ig=1,ngrid
+
+            z1(ig) = pcapcal(ig)*ptsrf(ig) + cpp*zb(ig,1)*zc(ig,1)
+     &           + zdplanck(ig)*ptsrf(ig) + pfluxsrf(ig)*ptimestep
+            z2(ig) = pcapcal(ig) + cpp*zb(ig,1)*(1.-zd(ig,1)) 
+     &           +zdplanck(ig)
+            ztsrf2(ig) = z1(ig) / z2(ig)
+            pdtsrf(ig) = (ztsrf2(ig) - ptsrf(ig))/ptimestep
+            zh(ig,1)   = zc(ig,1) + zd(ig,1)*ztsrf2(ig)
+         ENDDO
+
+!     Recalculate temperature to top of atmosphere, starting from ground
+!     ------------------------------------------------------------------
+
+         DO ilay=2,nlay
+            DO ig=1,ngrid
+               hh = zh(ig,ilay-1)
+               zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
+            ENDDO
+         ENDDO
+
+      endif                     ! not water
+
+!-----------------------------------------------------------------------
+!     TRACERS (no vapour)
+!     -------
+
+      if(tracer) then
+
+!     Calculate vertical flux from the bottom to the first layer (dust)
+!     -----------------------------------------------------------------
+         do ig=1,ngrid  
+            rho(ig) = zb0(ig,1) /ptimestep
+         end do
+
+         call zerophys(ngrid*nq,pdqsdif)
+
+!     Implicit inversion of q
+!     -----------------------
+         do iq=1,nq 
+
+            if (iq.ne.igcm_h2o_vap) then
+
+               DO ig=1,ngrid
+                  z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+                  zcq(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+                  zdq(ig,nlay)=zb(ig,nlay)*z1(ig)
+               ENDDO 
+            
+               DO ilay=nlay-1,2,-1
+                  DO ig=1,ngrid
+                     z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     &                    zb(ig,ilay+1)*(1.-zdq(ig,ilay+1)))
+                     zcq(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
+     &                    zb(ig,ilay+1)*zcq(ig,ilay+1))*z1(ig)
+                     zdq(ig,ilay)=zb(ig,ilay)*z1(ig)
+                  ENDDO
+               ENDDO
+
+               if ((water).and.(iq.eq.iice)) then
+                  ! special case for water ice tracer: do not include
+                  ! h2o ice tracer from surface (which is set when handling
+                  ! h2o vapour case (see further down).
+                  ! zb(ig,1)=0 if iq ne ivap
+                  DO ig=1,ngrid
+                     z1(ig)=1./(za(ig,1)+
+     &                    zb(ig,2)*(1.-zdq(ig,2)))
+                     zcq(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     &                    zb(ig,2)*zcq(ig,2))*z1(ig)
+                  ENDDO
+               else             ! general case
+                  DO ig=1,ngrid
+                     z1(ig)=1./(za(ig,1)+
+     &                    zb(ig,2)*(1.-zdq(ig,2)))
+                     zcq(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     &                    zb(ig,2)*zcq(ig,2)
+     &                    +(-pdqsdif(ig,iq))*ptimestep)*z1(ig)
+                          ! tracer flux from surface
+                          ! currently pdqsdif always zero here,
+                          ! so last line is superfluous
+                  enddo
+               endif            ! of if (water.and.(iq.eq.igcm_h2o_ice))
+
+
+!     Starting upward calculations for simple tracer mixing (e.g., dust)
+               do ig=1,ngrid
+                  zq(ig,1,iq)=zcq(ig,1)
+               end do
+
+               do ilay=2,nlay
+                  do ig=1,ngrid
+                     zq(ig,ilay,iq)=zcq(ig,ilay)+
+     $                    zdq(ig,ilay)*zq(ig,ilay-1,iq)
+                  end do
+               end do
+
+            endif               ! if (iq.ne.igcm_h2o_vap)
+
+!     Calculate temperature tendency including latent heat term
+!     and assuming an infinite source of water on the ground
+!     ------------------------------------------------------------------
+
+            if (water.and.(iq.eq.igcm_h2o_vap)) then 
+            
+               ! compute evaporation efficiency
+               do ig = 1, ngrid
+                  if(nint(rnat(ig)).eq.1)then
+                     dryness(ig)=pqsurf(ig,ivap)+pqsurf(ig,iice) 
+                     dryness(ig)=MIN(1.,2*dryness(ig)/mx_eau_sol)
+                     dryness(ig)=MAX(0.,dryness(ig))
+                  endif
+               enddo
+
+               do ig=1,ngrid
+
+                ! Calculate the value of qsat at the surface (water)
+                call watersat(ptsrf(ig),pplev(ig,1),qsat(ig))
+                call watersat(ptsrf(ig)-0.0001,pplev(ig,1),qsat_temp1)
+                call watersat(ptsrf(ig)+0.0001,pplev(ig,1),qsat_temp2)
+                dqsat(ig)=(qsat_temp2-qsat_temp1)/0.0002
+                ! calculate dQsat / dT by finite differences
+                ! we cannot use the updated temperature value yet...
+ 
+               enddo
+
+! coefficients for q
+
+               do ig=1,ngrid
+                  z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+                  zcq(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+                  zdq(ig,nlay)=zb(ig,nlay)*z1(ig)
+               enddo 
+            
+               do ilay=nlay-1,2,-1
+                  do ig=1,ngrid
+                     z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $                    zb(ig,ilay+1)*(1.-zdq(ig,ilay+1)))
+                     zcq(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
+     $                    zb(ig,ilay+1)*zcq(ig,ilay+1))*z1(ig)
+                     zdq(ig,ilay)=zb(ig,ilay)*z1(ig)
+                  enddo
+               enddo
+
+               do ig=1,ngrid
+                  z1(ig)=1./(za(ig,1)+zb(ig,1)*dryness(ig)+
+     $                 zb(ig,2)*(1.-zdq(ig,2)))
+                  zcq(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $                 zb(ig,2)*zcq(ig,2))*z1(ig)
+                  zdq(ig,1)=dryness(ig)*zb(ig,1)*z1(ig)
+               enddo
+
+! calculation of h0 and h1
+               do ig=1,ngrid
+                  zdq0(ig) = dqsat(ig)
+                  zcq0(ig) = qsat(ig)-dqsat(ig)*ptsrf(ig)
+
+                  z1(ig) = pcapcal(ig)*ptsrf(ig) +cpp*zb(ig,1)*zc(ig,1)
+     &                 + zdplanck(ig)*ptsrf(ig) + pfluxsrf(ig)*ptimestep 
+     &                 +  zb(ig,1)*dryness(ig)*RLVTT*
+     &                 ((zdq(ig,1)-1.0)*zcq0(ig)+zcq(ig,1))
+
+                  z2(ig) = pcapcal(ig) + cpp*zb(ig,1)*(1.-zd(ig,1))
+     &                 +zdplanck(ig)
+     &                 +zb(ig,1)*dryness(ig)*RLVTT*zdq0(ig)*
+     &                 (1.0-zdq(ig,1))
+
+                  ztsrf2(ig) = z1(ig) / z2(ig)
+                  pdtsrf(ig) = (ztsrf2(ig) - ptsrf(ig))/ptimestep
+                  zh(ig,1)   = zc(ig,1) + zd(ig,1)*ztsrf2(ig)
+               enddo
+
+! calculation of qs and q1
+               do ig=1,ngrid
+                  zq0(ig)     = zcq0(ig)+zdq0(ig)*ztsrf2(ig)
+                  zq(ig,1,iq) = zcq(ig,1)+zdq(ig,1)*zq0(ig)
+               enddo
+
+! calculation of evaporation              
+               do ig=1,ngrid 
+                  evap(ig)= zb(ig,1)*dryness(ig)*(zq(ig,1,ivap)-zq0(ig))
+                  dqsdif_total(ig)=evap(ig)
+               enddo
+
+! recalculate temperature and q(vap) to top of atmosphere, starting from ground
+               do ilay=2,nlay
+                  do ig=1,ngrid
+                     zq(ig,ilay,iq)=zcq(ig,ilay)
+     &                    +zdq(ig,ilay)*zq(ig,ilay-1,iq)
+                     zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zh(ig,ilay-1)
+                  end do
+               end do
+
+               do ig=1,ngrid
+
+!     --------------------------------------------------------------------------
+!     On the ocean, if T > 0 C then the vapour tendency must replace the ice one
+!     The surface vapour tracer is actually liquid. To make things difficult.
+
+                  if (nint(rnat(ig)).eq.0) then ! unfrozen ocean
+                     
+                     pdqsdif(ig,ivap)=dqsdif_total(ig)/ptimestep
+                     pdqsdif(ig,iice)=0.0
+
+
+                  elseif (nint(rnat(ig)).eq.1) then ! (continent)
+
+!     --------------------------------------------------------
+!     Now check if we've taken too much water from the surface
+!     This can only occur on the continent 
+
+!     If water is evaporating / subliming, we take it from ice before liquid
+!     -- is this valid??
+                     if(dqsdif_total(ig).lt.0)then
+                        pdqsdif(ig,iice)=dqsdif_total(ig)/ptimestep
+                        pdqsdif(ig,iice)=max(-pqsurf(ig,iice)/ptimestep
+     &                       ,pdqsdif(ig,iice))
+                     endif
+                     ! sublimation only greater than qsurf(ice)
+                     ! ----------------------------------------
+                     ! we just convert some liquid to vapour too
+                     ! if latent heats are the same, no big deal
+                     if (-dqsdif_total(ig).gt.pqsurf(ig,iice))then            
+                       pdqsdif(ig,iice) = -pqsurf(ig,iice)/ptimestep ! removes all the ice!
+                       pdqsdif(ig,ivap) = dqsdif_total(ig)/ptimestep
+     &                       - pdqsdif(ig,iice) ! take the remainder from the liquid instead
+                       pdqsdif(ig,ivap) = max(-pqsurf(ig,ivap)/ptimestep
+     &                       ,pdqsdif(ig,ivap))
+                    endif
+
+                 endif          ! if (rnat.ne.1)
+
+!     If water vapour is condensing, we must decide whether it forms ice or liquid.
+                 if(dqsdif_total(ig).gt.0)then ! a bug was here!
+                    if(ztsrf2(ig).gt.T_h2O_ice_liq)then
+                       pdqsdif(ig,iice)=0.0
+                       pdqsdif(ig,ivap)=dqsdif_total(ig)/ptimestep
+                    else
+                       pdqsdif(ig,iice)=dqsdif_total(ig)/ptimestep
+                       pdqsdif(ig,ivap)=0.0
+                    endif
+                 endif
+
+              end do            ! of DO ig=1,ngrid
+           endif                ! if (water et iq=ivap)
+        end do                  ! of do iq=1,nq
+      endif                     ! traceur
+
+
+!-----------------------------------------------------------------------
+!     8. Final calculation of the vertical diffusion tendencies
+!     -----------------------------------------------------------------
+
+      do ilev = 1, nlay
+         do ig=1,ngrid
+            pdudif(ig,ilev)=(zu(ig,ilev)-
+     &           (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep))/ptimestep
+            pdvdif(ig,ilev)=(zv(ig,ilev)-
+     &           (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep))/ptimestep
+            hh = ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep 
+
+            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
+         enddo
+      enddo
+
+      DO ig=1,ngrid  ! computing sensible heat flux (atm => surface)
+	 sensibFlux(ig)=cpp*zb(ig,1)/ptimestep*(zh(ig,1)-ztsrf2(ig))
+      ENDDO      
+
+      if (tracer) then
+         do iq = 1, nq
+            do ilev = 1, nlay
+               do ig=1,ngrid
+                  pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-
+     &           (pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep))/
+     &           ptimestep
+               enddo
+            enddo
+         enddo
+
+         if(water.and.forceWC)then ! force water conservation in model
+                                   ! we calculate the difference and add it to the ground
+                                   ! this is ugly and should be improved in the future
+            do ig=1,ngrid
+               Wtot=0.0
+               do ilay=1,nlay
+                  masse = (pplev(ig,ilay) - pplev(ig,ilay+1))/g
+!                  Wtot=Wtot+masse*(zq(ig,ilay,iice)-
+!     &                 (pq(ig,ilay,iice)+pdqfi(ig,ilay,iice)*ptimestep))
+                  Wtot=Wtot+masse*(zq(ig,ilay,ivap)-
+     &                 (pq(ig,ilay,ivap)+pdqfi(ig,ilay,ivap)*ptimestep))
+               enddo
+               Wdiff=Wtot/ptimestep+pdqsdif(ig,ivap)+pdqsdif(ig,iice)
+
+               if(ztsrf2(ig).gt.T_h2O_ice_liq)then
+                  pdqsdif(ig,ivap)=pdqsdif(ig,ivap)-Wdiff
+               else
+                  pdqsdif(ig,iice)=pdqsdif(ig,iice)-Wdiff
+               endif
+            enddo
+
+         endif
+
+      endif 
+
+      if(water)then
+      call writediagfi(ngrid,'beta','Dryness coefficient',' ',2,dryness)
+      endif
+
+!      if(lastcall)then
+!        if(ngrid.eq.1)then
+!           print*,'Saving k.out...'
+!           OPEN(12,file='k.out',form='formatted')
+!           DO ilay=1,nlay
+!              write(12,*) zkh(1,ilay), pplay(1,ilay)
+!           ENDDO
+!           CLOSE(12)
+!         endif
+!      endif
+
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vlz_fi.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vlz_fi.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/vlz_fi.F	(revision 222)
@@ -0,0 +1,195 @@
+      SUBROUTINE vlz_fi(ngrid,q,pente_max,masse,w,wq)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " dans la verticale
+c    pour appel dans la physique (sedimentation)
+c    ********************************************************************
+c    q rapport de melange (kg/kg)...
+c    masse : masse de la couche Dp/g
+c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
+c    pente_max = 2 conseillee
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "dimphys.h"
+
+c
+c
+c   Arguments:
+c   ----------
+      integer ngrid
+      real masse(ngrid,llm),pente_max
+      REAL q(ngrid,llm)
+      REAL w(ngrid,llm)
+      REAL wq(ngrid,llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+
+      real dzq(ngrid,llm),dzqw(ngrid,llm),adzqw(ngrid,llm),dzqmax
+      real newmasse
+      real sigw, Mtot, MQtot
+      integer m
+
+      REAL      SSUM,CVMGP,CVMGT
+      integer ismax,ismin
+
+
+c    On oriente tout dans le sens de la pression c'est a dire dans le
+c    sens de W
+
+      do l=2,llm
+         do ij=1,ngrid
+            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
+            adzqw(ij,l)=abs(dzqw(ij,l))
+         enddo
+      enddo
+
+      do l=2,llm-1
+         do ij=1,ngrid
+#ifdef CRAY
+            dzq(ij,l)=0.5*
+     ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
+#else
+            if(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) then
+                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
+            else
+                dzq(ij,l)=0.
+            endif
+#endif
+            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
+            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
+         enddo
+      enddo
+
+      do ij=1,ngrid
+         dzq(ij,1)=0.
+         dzq(ij,llm)=0.
+      enddo
+c ---------------------------------------------------------------
+c   .... calcul des termes d'advection verticale  .......
+c ---------------------------------------------------------------
+
+c calcul de  - d( q   * w )/ d(sigma)    qu'on ajoute a  dq pour calculer dq
+c
+c      No flux at the model top:
+       do ij=1,ngrid
+          wq(ij,llm+1)=0.
+       enddo
+
+c      1) Compute wq where w > 0 (down) (ALWAYS FOR SEDIMENTATION)     
+c      ===============================
+
+       do l = 1,llm          ! loop different than when w<0
+        do ij=1,ngrid
+
+         if(w(ij,l).gt.0.)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(w(ij,l).le.masse(ij,l))then
+            sigw=w(ij,l)/masse(ij,l)
+            wq(ij,l)=w(ij,l)*(q(ij,l)+0.5*(1.-sigw)*dzq(ij,l))
+            
+
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+            m=l
+            Mtot = masse(ij,m)
+            MQtot = masse(ij,m)*q(ij,m)
+            if(m.ge.llm)goto 88
+            do while(w(ij,l).gt.(Mtot+masse(ij,m+1)))
+                m=m+1
+                Mtot = Mtot + masse(ij,m)
+                MQtot = MQtot + masse(ij,m)*q(ij,m)
+                if(m.ge.llm)goto 88
+            end do
+ 88         continue
+            if (m.lt.llm) then
+                sigw=(w(ij,l)-Mtot)/masse(ij,m+1)
+                wq(ij,l)=(MQtot + (w(ij,l)-Mtot)*
+     &          (q(ij,m+1)+0.5*(1.-sigw)*dzq(ij,m+1)) )
+            else
+                w(ij,l) = Mtot
+                wq(ij,l) = Mqtot 
+            end if
+          end if
+         end if
+        enddo
+       enddo
+
+c      2) Compute wq where w < 0 (up) (NOT USEFUL FOR SEDIMENTATION)     
+c      ===============================
+       goto 99 ! SKIPPING THIS PART FOR SEDIMENTATION 
+
+c      Surface flux up:
+       do ij=1,ngrid
+         if(w(ij,1).lt.0.) wq(ij,1)=0. ! warning : not always valid
+       end do
+
+       do l = 1,llm-1  ! loop different than when w>0
+        do ij=1,ngrid
+         if(w(ij,l+1).le.0)then
+
+c         Regular scheme (transfered mass < 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(-w(ij,l+1).le.masse(ij,l))then
+            sigw=w(ij,l+1)/masse(ij,l)
+            wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
+c         Extended scheme (transfered mass > 1 layer)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else 
+             m = l-1
+             Mtot = masse(ij,m+1)
+             MQtot = masse(ij,m+1)*q(ij,m+1)
+             if (m.le.0)goto 77
+             do while(-w(ij,l+1).gt.(Mtot+masse(ij,m)))
+                m=m-1
+                Mtot = Mtot + masse(ij,m+1)
+                MQtot = MQtot + masse(ij,m+1)*q(ij,m+1)
+                if (m.le.0)goto 77
+             end do
+ 77          continue
+
+             if (m.gt.0) then
+                sigw=(w(ij,l+1)+Mtot)/masse(ij,m)
+                wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*
+     &          (q(ij,m)-0.5*(1.+sigw)*dzq(ij,m))  )
+             else
+c               wq(ij,l+1)= (MQtot + (-w(ij,l+1)-Mtot)*qm(ij,1))
+                write(*,*) 'a rather weird situation in vlz_fi !'
+                stop
+             end if
+          endif
+         endif
+        enddo
+       enddo
+ 99    continue
+
+      do l=1,llm
+         do ij=1,ngrid
+
+cccccccc lines below not used for sedimentation (No real flux)
+ccccc       newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l) 
+ccccc       q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l))
+ccccc&         /newmasse
+ccccc       masse(ij,l)=newmasse
+
+            q(ij,l)=q(ij,l) +  (wq(ij,l+1)-wq(ij,l))/masse(ij,l)
+
+         enddo
+      enddo
+
+
+
+      return
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watercommon_h.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watercommon_h.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watercommon_h.F90	(revision 222)
@@ -0,0 +1,288 @@
+module watercommon_h
+
+      implicit none
+
+      real, parameter :: T_coup = 234.0
+      real, parameter :: T_h2O_ice_liq = 273.16
+      real, parameter :: T_h2O_ice_clouds = T_h2O_ice_liq-15. 
+      real, parameter :: mH2O = 18.01528   
+
+      ! benjamin additions
+      real, parameter :: RLVTT = 2.257E+6 ! Latent heat of vaporization (J kg-1) 
+      real, parameter :: RLSTT = 2.257E+6 ! 2.591E+6 in reality ! Latent heat of sublimation (J kg-1)
+
+      real, parameter :: RLFTT = 3.334E+5 ! Latent heat of fusion (J kg-1) ! entails an energy sink but better description of albedo
+      real, parameter :: rhowater = 1.0E+3 ! mass of water (kg/m^3)
+      real, parameter :: rhowaterice = 9.2E+2 ! mass of water (kg/m^3)
+      real, parameter :: capcal_h2o_liq = 4181.3 ! specific heat capacity of liquid water J/kg/K
+      real, parameter :: mx_eau_sol = 150 ! mass of water (kg/m^2)
+
+      real, save :: epsi, RCPD, RCPV, RV, RVTMP2
+      
+      contains
+
+      
+!==================================================================
+      subroutine Psat_water(T,p,psat,qsat)
+
+         implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the saturation vapor pressure and mass mixing ratio at saturation (kg/kg)
+!     for a given pressure (Pa) and temperature (K)
+!     Based on the Tetens formula from L.Li physical parametrization manual
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+
+!        input
+         real, intent(in) :: T, p
+  
+!        output
+         real psat,qsat
+
+! JL12 variables for tetens formula
+         real,parameter :: Pref_solid_liquid=611.14
+         real,parameter :: Trefvaporization=35.86
+         real,parameter :: Trefsublimation=7.66
+         real,parameter :: Tmin=8.
+         real,parameter :: r3vaporization=17.269
+         real,parameter :: r3sublimation=21.875
+
+! checked vs. old watersat data 14/05/2012 by JL.
+
+         if (T.gt.T_h2O_ice_liq) then 
+            psat = Pref_solid_liquid*Exp(r3vaporization*(T-T_h2O_ice_liq)/(T-Trefvaporization)) ! liquid / vapour
+         else if (T.lt.Tmin) then
+	    print*, "careful, T<Tmin in psat water"
+          !  psat = Pref_solid_liquid*Exp(r3sublimation*(Tmin-T_h2O_ice_liq)/(Tmin-Trefsublimation)) ! min psat  
+         ! Ehouarn: gfortran says: Error: Result of EXP underflows its kind,
+         !          so set psat to the smallest possible value instead
+            psat=tiny(psat)
+         else                 
+            psat = Pref_solid_liquid*Exp(r3sublimation*(T-T_h2O_ice_liq)/(T-Trefsublimation)) ! solid / vapour
+         endif
+         if(psat.gt.p) then
+            qsat=1.
+         else
+            qsat=epsi*psat/(p-(1.-epsi)*psat)
+         endif
+         return
+      end subroutine Psat_water
+
+
+
+
+!==================================================================
+      subroutine Lcpdqsat_water(T,p,psat,qsat,dqsat,dlnpsat)
+
+         implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute dqsat=L/cp*d (q_sat)/d T and dlnpsat=L/cp d(ln Psat)/d T
+!     for a given temperature (K)! 
+!     Based on the Tetens formula from L.Li physical parametrization manual
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+
+!        input
+         real T, p, psat, qsat
+  
+!        output
+         real dqsat,dlnpsat
+
+! JL12 variables for tetens formula
+         real,parameter :: Pref_solid_liquid=611.14
+         real,parameter :: Trefvaporization=35.86
+         real,parameter :: Tmin=8.
+         real,parameter :: Trefsublimation=7.66
+         real,parameter :: r3vaporization=17.269
+         real,parameter :: r3sublimation=21.875
+
+         real :: dummy
+
+         if (psat.gt.p) then
+	    dqsat=0.
+	    return
+	 endif
+
+         if (T.gt.T_h2O_ice_liq) then
+            dummy = r3vaporization*(T_h2O_ice_liq-Trefvaporization)/(T-Trefvaporization)**2  ! liquid / vapour
+         else if (T.lt.Tmin) then
+	    print*, "careful, T<Tmin in Lcp psat water"
+            dummy = r3sublimation*(T_h2O_ice_liq-Trefsublimation)/(Tmin-Trefsublimation)**2  ! solid / vapour
+         else               
+            dummy = r3sublimation*(T_h2O_ice_liq-Trefsublimation)/(T-Trefsublimation)**2  ! solid / vapour
+         endif
+
+         dqsat=RLVTT/RCPD*qsat*(p/(p-(1.-epsi)*psat))*dummy
+	 dlnpsat=RLVTT/RCPD*dummy
+         return
+      end subroutine Lcpdqsat_water
+
+
+
+
+!==================================================================
+      subroutine Tsat_water(p,Tsat)
+
+         implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the saturation temperature
+!     for a given pressure (Pa) 
+!     Based on the Tetens formula from L.Li physical parametrization manual
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+
+!        input
+         real p
+  
+!        output
+         real Tsat
+
+! JL12 variables for tetens formula
+         real,parameter :: Pref_solid_liquid=611.14
+         real,parameter :: Trefvaporization=35.86
+         real,parameter :: Trefsublimation=7.66
+         real,parameter :: r3vaporization=17.269
+         real,parameter :: r3sublimation=21.875
+
+         if (p.lt.Pref_solid_liquid) then ! solid / vapour
+            Tsat =(T_h2O_ice_liq*r3sublimation- Trefsublimation*Log(p/Pref_solid_liquid))/(r3sublimation-Log(p/Pref_solid_liquid))
+         else                 ! liquid / vapour
+            Tsat =(T_h2O_ice_liq*r3vaporization- Trefvaporization*Log(p/Pref_solid_liquid))/(r3vaporization-Log(p/Pref_solid_liquid))
+         endif
+
+         return
+      end subroutine Tsat_water
+
+!==================================================================
+      subroutine Psat_waterDP(T,p,psat,qsat)
+
+         implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the saturation vapor pressure and mass mixing ratio at saturation (kg/kg)
+!     for a given pressure (Pa) and temperature (K)
+!     DOUBLE PRECISION
+!     Based on the Tetens formula from L.Li physical parametrization manual
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+
+!        input
+         double precision, intent(in) :: T, p
+  
+!        output
+         double precision psat,qsat
+
+! JL12 variables for tetens formula
+         double precision,parameter :: Pref_solid_liquid=611.14d0
+         double precision,parameter :: Trefvaporization=35.86D0
+         double precision,parameter :: Trefsublimation=7.66d0
+         double precision,parameter :: Tmin=8.d0
+         double precision,parameter :: r3vaporization=17.269d0
+         double precision,parameter :: r3sublimation=21.875d0
+
+! checked vs. old watersat data 14/05/2012 by JL.
+
+         if (T.gt.T_h2O_ice_liq) then 
+            psat = Pref_solid_liquid*Exp(r3vaporization*(T-T_h2O_ice_liq)/(T-Trefvaporization)) ! liquid / vapour
+         else if (T.lt.Tmin) then
+	    print*, "careful, T<Tmin in psat water"
+         !   psat = Pref_solid_liquid*Exp(r3sublimation*(Tmin-T_h2O_ice_liq)/(Tmin-Trefsublimation)) ! min psat  
+         ! Ehouarn: gfortran says: Error: Result of EXP underflows its kind,
+         !          so set psat to the smallest possible value instead
+            psat=tiny(psat)
+         else                 
+            psat = Pref_solid_liquid*Exp(r3sublimation*(T-T_h2O_ice_liq)/(T-Trefsublimation)) ! solid / vapour
+         endif
+         if(psat.gt.p) then
+            qsat=1.d0
+         else
+            qsat=epsi*psat/(p-(1.d0-epsi)*psat)
+         endif
+         return
+      end subroutine Psat_waterDP
+
+
+
+
+!==================================================================
+      subroutine Lcpdqsat_waterDP(T,p,psat,qsat,dqsat,dlnpsat)
+
+         implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute dqsat=L/cp*d (q_sat)/d T and dlnpsat=L/cp d(ln Psat)/d T
+!     for a given temperature (K)! 
+!     Based on the Tetens formula from L.Li physical parametrization manual
+!
+!     Authors
+!     -------
+!     Jeremy Leconte (2012)
+!
+!==================================================================
+
+!        input
+         double precision T, p, psat, qsat
+  
+!        output
+         double precision dqsat,dlnpsat
+
+! JL12 variables for tetens formula
+         double precision,parameter :: Pref_solid_liquid=611.14d0
+         double precision,parameter :: Trefvaporization=35.86d0
+         double precision,parameter :: Tmin=8.d0
+         double precision,parameter :: Trefsublimation=7.66d0
+         double precision,parameter :: r3vaporization=17.269d0
+         double precision,parameter :: r3sublimation=21.875d0
+
+         double precision :: dummy
+
+         if (psat.gt.p) then
+	    dqsat=0.d0
+	    return
+	 endif
+
+         if (T.gt.T_h2O_ice_liq) then
+            dummy = r3vaporization*(T_h2O_ice_liq-Trefvaporization)/(T-Trefvaporization)**2  ! liquid / vapour
+         else if (T.lt.Tmin) then
+	    print*, "careful, T<Tmin in Lcp psat water"
+            dummy = r3sublimation*(T_h2O_ice_liq-Trefsublimation)/(Tmin-Trefsublimation)**2  ! solid / vapour
+         else               
+            dummy = r3sublimation*(T_h2O_ice_liq-Trefsublimation)/(T-Trefsublimation)**2  ! solid / vapour
+         endif
+
+         dqsat=RLVTT/RCPD*qsat*(p/(p-(1.d0-epsi)*psat))*dummy
+	 dlnpsat=RLVTT/RCPD*dummy
+         return
+      end subroutine Lcpdqsat_waterDP
+
+
+end module watercommon_h
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watersat.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watersat.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watersat.F90	(revision 222)
@@ -0,0 +1,45 @@
+subroutine watersat(T,p,qsat)
+
+  use watercommon_h, only: T_h2O_ice_liq, epsi
+  implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the water mass mixing ratio at saturation (kg/kg)
+!     for a given pressure (Pa) and temperature (K)
+!     A replacement for the old watersat.F in the Martian GCM.
+!     Based on FCTTRE.h in the LMDTERRE model.
+!
+!     Authors
+!     -------
+!     Robin Wordsworth (2010)
+!
+!==================================================================
+
+!   input
+  real T, p
+  
+!   output
+  real qsat
+
+! checked vs. NIST data 22/06/2010 by RW.
+! / by p gives partial pressure
+! x by epsi converts to mass mixing ratio
+
+  if (T.lt.T_h2O_ice_liq) then ! solid / vapour
+     qsat = 100.0 * 10**(2.07023 - 0.00320991             &
+          * T - 2484.896 / T + 3.56654 * alog10(T))
+  else                 ! liquid / vapour
+     qsat = 100.0 * 10**(23.8319 - 2948.964 / T - 5.028  &
+          * alog10(T) - 29810.16 * exp( -0.0699382 * T)  &
+          + 25.21935 * exp(-2999.924/T))
+  endif
+!  qsat=epsi*qsat/p
+  if(qsat.gt.p) then
+     qsat=1.
+  else
+     qsat=epsi*qsat/(p-(1.-epsi)*qsat)
+  endif
+  return
+end subroutine watersat
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watersat_grad.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watersat_grad.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/watersat_grad.F90	(revision 222)
@@ -0,0 +1,38 @@
+subroutine watersat_grad(T,qsat,dqsat)
+
+  use watercommon_h, only: T_h2O_ice_liq, RLVTT, RCPD,T_coup
+  implicit none
+
+!==================================================================
+!     Purpose
+!     -------
+!     Compute the L/cp*d (q_sat)/d T
+!     for a given temperature (K)
+!
+!     Authors
+!     -------
+!     Robin Wordsworth (2010)
+!
+!==================================================================
+
+!   input
+  real T,qsat
+  
+!   output
+  real dqsat
+
+!  if (T.lt.T_coup) then ! solid / vapour !why use T_coup?????????? JL12
+  if (T.lt.T_h2O_ice_liq) then ! solid / vapour
+     dqsat = RLVTT/RCPD*qsat*(3.56654/T             &
+          +2484.896*LOG(10.)/T**2                   &
+          -0.00320991*LOG(10.))
+  else                 ! liquid / vapour
+     dqsat = RLVTT/RCPD*qsat*LOG(10.)*              &
+          (2948.964/T**2-5.028/LOG(10.)/T           &
+          +25.21935*2999.924/T**2*EXP(-2999.924/T)  &
+          +29810.16*0.0699382*EXP(-0.0699382*T))
+  end if
+
+  return
+end subroutine watersat_grad
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/write_archive.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/write_archive.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/write_archive.F	(revision 222)
@@ -0,0 +1,250 @@
+c=======================================================================
+      subroutine write_archive(nid,ntime,nom,titre,unite,dim,px)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
+c   -----    dans un fichier DRS nomme "start_archive"
+c
+c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
+c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
+c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
+c    (ex: la longitude solaire)
+c
+c
+c   Arguments: 
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c		  nid      Unite logique du fichier "start_archive"
+c         nom      nom du champ a ecrire dans le fichier "start_archive"
+c         titre    titre de la variable dans le fichier DRS "start_archive"
+c         unite    unite de la variable ....
+c         dim      dimension de la variable a ecrire
+c         px       tableau contenant la variable a ecrire
+c
+c
+c=======================================================================
+
+      use comsoil_h, only: nsoilmx
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c	Declarations   
+c-----------------------------------------------------------------------
+
+c Arguments:
+
+      INTEGER nid
+      integer ntime ! time index
+      integer dim 
+      REAL px(iip1,jjp1,llm) 
+
+      CHARACTER*(*) nom, titre, unite
+
+      integer ierr
+
+
+c local
+      integer, dimension(4) :: edges,corner,id
+      integer :: varid,i,j,l
+c-----------------------------------------------------------------------
+c      Ecriture du champs dans le fichier            (3 cas)      
+c-----------------------------------------------------------------------
+
+! For an atmospheric 3D Variable
+!--------------------------------
+        if (dim.eq.3) then
+
+!         Ecriture du champs
+
+! nom de la variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif
+
+! mars s'arranger pour qu'il n'y ai plus besoin de ca
+
+c          do l=1,llm
+c             do j=1,jjp1
+c                do i=1,iip1
+c                   pxbis(i,j,l)=px(i,j,llm-l+1)
+c                enddo
+c             enddo
+c          enddo
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+! For a subterranean 3D Variable
+!-------------------------------
+
+        else if (dim.eq.-3) then
+	! get variables' ID, if it exists
+	ierr=NF_INQ_VARID(nid,nom,varid)
+	
+	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
+	  ! build related coordinates
+	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
+	  if (ierr.ne.NF_NOERR) then
+	   write(*,*)"write_archive: dimension <subsurface_layers>",
+     &               " is missing !!!"
+	   call abort
+	  endif
+          ierr=NF_INQ_DIMID(nid,"Time",id(4))
+	  
+	  ! define the variable
+	  write(*,*)"====================="
+	  write(*,*)"defining ",nom
+	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+	  
+	 endif
+
+        ! build cedges and corners
+        corner(1)=1
+        corner(2)=1
+        corner(3)=1
+        corner(4)=ntime
+
+        edges(1)=iip1
+        edges(2)=jjp1
+        edges(3)=nsoilmx
+        edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+
+! For a surface 2D Variable
+!--------------------------
+
+        else if (dim.eq.2) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+!Cas Variable 0D (scalaire dependant du temps)
+!---------------------------------------------
+
+        else if (dim.eq.0) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"Time",id(1))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+        else
+	  write(*,*) "write_archive: dim=",dim," ?!?"
+	  call abort
+        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
+
+      return
+      end
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagfi.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagfi.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagfi.F	(revision 222)
@@ -0,0 +1,541 @@
+      subroutine writediagfi(ngrid,nom,titre,unite,dim,px)
+
+!  Ecriture de variables diagnostiques au choix dans la physique 
+!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
+!  3d (ex : temperature), 2d (ex : temperature de surface), ou
+!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+!  solaire)
+!  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
+!  La periode d'ecriture est donnee par 
+!  "ecritphy " regle dans le fichier de controle de run :  run.def
+!
+!    writediagfi peut etre appele de n'importe quelle subroutine
+!    de la physique, plusieurs fois. L'initialisation et la creation du
+!    fichier se fait au tout premier appel.
+!
+! WARNING : les variables dynamique (u,v,t,q,ps)
+!  sauvees par writediagfi avec une
+! date donnee sont legerement differentes que dans le fichier histoire car 
+! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
+! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
+! avant l'ecriture dans diagfi (cf. physiq.F)
+!  
+! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
+!         Oct 2011 Francois: enable having a 'diagfi.def' file to select
+!                            at runtime, which variables to put in file
+!
+!  parametres (input) :
+!  ----------
+!      ngrid : nombres de point ou est calcule la physique
+!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
+!                 (= nlon ou klon dans la physique terrestre)
+!      
+!      unit : unite logique du fichier de sortie (toujours la meme)
+!      nom  : nom de la variable a sortir (chaine de caracteres)
+!      titre: titre de la variable (chaine de caracteres)
+!      unite : unite de la variable (chaine de caracteres)
+!      px : variable a sortir (real 0, 1, 2, ou 3d)
+!      dim : dimension de px : 0, 1, 2, ou 3 dimensions
+!
+!=================================================================
+      use surfdat_h, only: phisfi
+      use control_mod, only: ecritphy, day_step, iphysiq
+      USE mod_phys_lmdz_para, only : is_parallel, is_mpi_root,
+     &                               is_master, gather
+      USE mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
+      implicit none
+
+! Commons
+      include "dimensions.h"
+      include "paramet.h"
+      include "comvert.h"
+      include "comgeom.h"
+      include "netcdf.inc"
+      include "temps.h"
+
+! Arguments on input:
+      integer,intent(in) :: ngrid
+      character (len=*),intent(in) :: nom,titre,unite
+      integer,intent(in) :: dim
+      real,intent(in) :: px(ngrid,llm)
+
+! Local variables:
+
+      real*4 dx3(iip1,jjp1,llm) ! to store a 3D data set
+      real*4 dx2(iip1,jjp1)     ! to store a 2D (surface) data set
+      real*4 dx1(llm)           ! to store a 1D (column) data set
+      real*4 dx0
+
+      real*4,save :: date
+
+      REAL phis(ip1jmp1)
+
+      integer irythme
+      integer ierr,ierr2
+      integer iq
+      integer i,j,l,zmax , ig0
+
+      integer,save :: zitau=0
+      character(len=20),save :: firstnom='1234567890'
+
+! Ajouts
+      integer, save :: ntime=0
+      integer :: idim,varid
+      integer :: nid
+      character(len=*),parameter :: fichnom="diagfi.nc"
+      integer, dimension(4) :: id
+      integer, dimension(4) :: edges,corner
+
+! Added to use diagfi.def to select output variable
+      logical,save :: diagfi_def
+      logical :: getout
+      integer,save :: n_nom_def
+      integer :: n
+      integer,parameter :: n_nom_def_max=199
+      character(len=120),save :: nom_def(n_nom_def_max)
+      logical,save :: firstcall=.true.
+      
+#ifndef MESOSCALE
+
+#ifdef CPP_PARA
+! Added to work in parallel mode
+      real dx3_glop(klon_glo,llm)
+      real dx3_glo(iim,jjp1,llm) ! to store a global 3D data set
+      real dx2_glop(klon_glo)
+      real dx2_glo(iim,jjp1)     ! to store a global 2D (surface) data set
+      real px2(ngrid)
+!      real dx1_glo(llm)          ! to store a 1D (column) data set
+!      real dx0_glo
+      real phisfi_glo(klon_glo) ! surface geopotential on global physics grid
+#else
+      real phisfi_glo(ngrid) ! surface geopotential on global physics grid
+#endif
+
+!***************************************************************
+!Sortie des variables au rythme voulu
+
+      irythme = ecritphy ! sortie au rythme de ecritphy
+!     irythme = iconser  ! sortie au rythme des variables de controle
+!     irythme = iphysiq  ! sortie a tous les pas physique
+!     irythme = iecri*day_step ! sortie au rythme des fichiers histoires
+!     irythme = periodav*day_step ! sortie au rythme des fichiers histmoy
+
+!***************************************************************
+
+! At very first call, check if there is a "diagfi.def" to use and read it
+! -----------------------------------------------------------------------
+      IF (firstcall) THEN
+         firstcall=.false.
+
+  !      Open diagfi.def definition file if there is one:
+         open(99,file="diagfi.def",status='old',form='formatted',
+     s   iostat=ierr2)
+
+         if(ierr2.eq.0) then
+            diagfi_def=.true.
+            write(*,*) "******************"
+            write(*,*) "Reading diagfi.def"
+            write(*,*) "******************"
+            do n=1,n_nom_def_max
+              read(99,fmt='(a)',end=88) nom_def(n)
+              write(*,*) 'Output in diagfi: ', trim(nom_def(n))
+            end do 
+ 88         continue
+            if (n.ge.n_nom_def_max) then
+               write(*,*)"n_nom_def_max too small in writediagfi.F:",n
+               stop
+            end if 
+            n_nom_def=n-1
+            close(99)
+         else
+            diagfi_def=.false.
+         endif
+      END IF ! of IF (firstcall)
+
+! Get out of write_diagfi if there is diagfi.def AND variable not listed
+!  ---------------------------------------------------------------------
+      if (diagfi_def) then
+          getout=.true.
+          do n=1,n_nom_def
+             if(trim(nom_def(n)).eq.nom) getout=.false.
+          end do
+          if (getout) return
+      end if
+
+! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
+! ------------------------------------------------------------------------
+! (at very first call to the subroutine, in accordance with diagfi.def)
+
+      if (firstnom.eq.'1234567890') then ! .true. for the very first valid
+      !   call to this subroutine; now set 'firstnom'
+         firstnom = nom
+         ! just to be sure, check that firstnom is large enough to hold nom
+         if (len_trim(firstnom).lt.len_trim(nom)) then
+           write(*,*) "writediagfi: Error !!!"
+           write(*,*) "   firstnom string not long enough!!"
+           write(*,*) "   increase its size to at least ",len_trim(nom)
+           stop
+         endif
+         
+         zitau = -1 ! initialize zitau
+
+#ifdef CPP_PARA
+          ! Gather phisfi() geopotential on physics grid
+          call Gather(phisfi,phisfi_glo)
+#else
+         phisfi_glo(:)=phisfi(:)
+#endif
+
+         !! parallel: we cannot use the usual writediagfi method
+!!         call iophys_ini
+         if (is_master) then
+         ! only the master is required to do this
+
+         ! Create the NetCDF file
+         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+         ! Define the 'Time' dimension
+         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+         ! Define the 'Time' variable
+!#ifdef NC_DOUBLE
+!         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+!#else
+         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+!#endif
+         ! Add a long_name attribute
+         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+     .          4,"Time")
+         ! Add a units attribute
+         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
+     .          "days since 0000-00-0 00:00:00")
+         ! Switch out of NetCDF Define mode
+         ierr = NF_ENDDEF(nid)
+
+         ! write "header" of file (longitudes, latitudes, geopotential, ...)
+         call gr_fi_dyn(1,size(phisfi_glo),iip1,jjp1,phisfi_glo,phis)
+         call iniwrite(nid,day_ini,phis)
+
+         endif ! of if (is_master)
+
+      else
+
+         if (is_master) then
+           ! only the master is required to do this
+
+           ! Open the NetCDF file
+           ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+         endif ! of if (is_master)
+
+      endif ! if (firstnom.eq.'1234567890')
+
+      if (ngrid.eq.1) then
+        ! in testphys1d, for the 1d version of the GCM, iphysiq and irythme
+        ! are undefined; so set them to 1
+        iphysiq=1 
+        irythme=1
+        ! NB: 
+      endif
+
+! Increment time index 'zitau' if it is the "fist call" (at given time level)
+! to writediagfi
+!------------------------------------------------------------------------
+      if (nom.eq.firstnom) then
+          zitau = zitau + iphysiq
+      end if
+
+!--------------------------------------------------------
+! Write the variables to output file if it's time to do so
+!--------------------------------------------------------
+
+      if ( MOD(zitau+1,irythme) .eq.0.) then
+
+! Compute/write/extend 'Time' coordinate (date given in days)
+! (done every "first call" (at given time level) to writediagfi)
+! Note: date is incremented as 1 step ahead of physics time
+!--------------------------------------------------------
+
+        if (is_master) then
+           ! only the master is required to do this
+        if (nom.eq.firstnom) then
+        ! We have identified a "first call" (at given date)
+           ntime=ntime+1 ! increment # of stored time steps
+           ! compute corresponding date (in days and fractions thereof)
+           date= float (zitau +1)/float (day_step)
+           ! Get NetCDF ID of 'Time' variable
+           ierr= NF_INQ_VARID(nid,"Time",varid)
+           ! Write (append) the new date to the 'Time' array
+!#ifdef NC_DOUBLE
+!           ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+!#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+!#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
+              write(*,*) "***** with time"
+              write(*,*) 'ierr=', ierr   
+c             call abort
+           endif
+
+           write(6,*)'WRITEDIAGFI: date= ', date
+        end if ! of if (nom.eq.firstnom)
+
+        endif ! of if (is_master)
+
+!Case of a 3D variable
+!---------------------
+        if (dim.eq.3) then
+
+#ifdef CPP_PARA
+          ! Gather field on a "global" (without redundant longitude) array
+          call Gather(px,dx3_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(dx3_glop,dx3_glo)
+            ! copy dx3_glo() to dx3(:) and add redundant longitude
+            dx3(1:iim,:,:)=dx3_glo(1:iim,:,:)
+            dx3(iip1,:,:)=dx3(1,:,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
+!         Passage variable physique -->  variable dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+           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
+#endif
+!         Ecriture du champs
+
+          if (is_master) then
+           ! only the master writes to output
+! name of the variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif 
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+!#ifdef NC_DOUBLE
+!           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+!#else
+!           write(*,*)"test:  nid=",nid," varid=",varid
+!           write(*,*)"       corner()=",corner
+!           write(*,*)"       edges()=",edges
+!           write(*,*)"       dx3()=",dx3
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+!#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR problem in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
+c             call abort
+           endif 
+
+          endif !of if (is_master)
+
+!Case of a 2D variable
+!---------------------
+
+        else if (dim.eq.2) then
+
+#ifdef CPP_PARA
+          ! Gather field on a "global" (without redundant longitude) array
+          px2(:)=px(:,1)
+          call Gather(px2,dx2_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(dx2_glop,dx2_glo)
+            ! copy dx2_glo() to dx2(:) and add redundant longitude
+            dx2(1:iim,:)=dx2_glo(1:iim,:)
+            dx2(iip1,:)=dx2(1,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
+
+!         Passage variable physique -->  physique dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+
+             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
+#endif
+
+          if (is_master) then
+           ! only the master writes to output
+!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
+!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+!#ifdef NC_DOUBLE
+!           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) 
+!#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
+!#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
+c             call abort
+           endif 
+
+          endif !of if (is_master)
+
+!Case of a 1D variable (ie: a column)
+!---------------------------------------------------
+
+       else if (dim.eq.1) then
+         if (is_parallel) then
+           write(*,*) "writediagfi error: dim=1 not implemented ",
+     &                 "in parallel mode"
+           stop
+         endif
+!         Passage variable physique -->  physique dynamique
+!         recast (copy) variable from physics grid to dynamics grid
+          do l=1,llm
+            dx1(l)=px(1,l)
+          enddo
+          
+          ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"altitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"Time",id(2))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,2,id,varid,ierr)
+              
+           endif
+           
+           corner(1)=1
+           corner(2)=ntime
+           
+           edges(1)=llm
+           edges(2)=1
+!#ifdef NC_DOUBLE
+!           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx1)
+!#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx1)
+!#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR problem in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
+c             call abort
+           endif 
+
+!Case of a 0D variable (ie: a time-dependent scalar)
+!---------------------------------------------------
+
+        else if (dim.eq.0) then
+
+           dx0 = px (1,1)
+
+          if (is_master) then
+           ! only the master writes to output
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"Time",id(1))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGFI: creating variable ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+!#ifdef NC_DOUBLE
+!           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0)  
+!#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
+!#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagfi"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
+c             call abort
+           endif 
+
+          endif !of if (is_master)
+
+        endif ! of if (dim.eq.3) elseif(dim.eq.2)...
+
+      endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
+
+      if (is_master) then
+        ierr= NF_CLOSE(nid)
+      endif
+
+#endif
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagsoil.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagsoil.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagsoil.F90	(revision 222)
@@ -0,0 +1,329 @@
+subroutine writediagsoil(ngrid,name,title,units,dimpx,px)
+
+! Write variable 'name' to NetCDF file 'diagsoil.nc'.
+! The variable may be 3D (lon,lat,depth) subterranean field,
+! a 2D (lon,lat) surface field, or a simple scalar (0D variable).
+!
+! Calls to 'writediagsoil' can originate from anywhere in the program;
+! An initialisation of variable 'name' is done if it is the first time
+! that this routine is called with given 'name'; otherwise data is appended
+! (yielding the sought time series of the variable)
+
+! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
+
+use comsoil_h, only: nsoilmx
+use control_mod, only: ecritphy, day_step, iphysiq
+use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather
+use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
+
+implicit none
+
+#include"dimensions.h"
+#include"paramet.h"
+#include"netcdf.inc"
+
+! Arguments:
+integer,intent(in) :: ngrid ! number of (horizontal) points of physics grid
+! i.e. ngrid = 2+(jjm-1)*iim - 1/jjm
+character(len=*),intent(in) :: name ! 'name' of the variable
+character(len=*),intent(in) :: title ! 'long_name' attribute of the variable
+character(len=*),intent(in) :: units ! 'units' attribute of the variable
+integer,intent(in) :: dimpx ! dimension of the variable (3,2 or 0)
+real,dimension(ngrid,nsoilmx),intent(in) :: px ! variable
+! Note: nsoilmx is a parameter set in 'comsoil_h'
+
+! Local variables:
+real*4,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
+! Note iip1,jjp1 known from paramet.h; nsoilmx known from comsoil_h
+real*4,dimension(iip1,jjp1) :: data2 ! to store 2D data
+real*4 :: data0 ! to store 0D data
+integer :: i,j,l ! for loops
+integer :: ig0
+
+real*4,save :: date ! time counter (in elapsed days)
+integer,save :: isample ! sample rate at which data is to be written to output
+integer,save :: ntime=0 ! counter to internally store time steps
+character(len=20),save :: firstname="1234567890"
+integer,save :: zitau=0
+
+character(len=30) :: filename="diagsoil.nc"
+
+! NetCDF stuff:
+integer :: nid ! NetCDF output file ID
+integer :: varid ! NetCDF ID of a variable
+integer :: ierr ! NetCDF routines return code
+integer,dimension(4) :: id ! NetCDF IDs of the dimensions of the variable
+integer,dimension(4) :: edges,corners
+
+#ifdef CPP_PARA
+! Added to work in parallel mode
+real dx3_glop(klon_glo,nsoilmx)
+real dx3_glo(iim,jjp1,nsoilmx) ! to store a global 3D data set
+real dx2_glop(klon_glo)
+real dx2_glo(iim,jjp1)     ! to store a global 2D (surface) data set
+real px2(ngrid)
+#endif
+
+! 1. Initialization step
+if (firstname.eq."1234567890") then
+  ! Store 'name' as 'firstname'
+  firstname=name
+  ! From now on, if 'name'.eq.'firstname', then it is a new time cycle
+
+  ! just to be sure, check that firstnom is large enough to hold nom
+  if (len_trim(firstname).lt.len_trim(name)) then
+    write(*,*) "writediagsoil: Error !!!"
+    write(*,*) "   firstname string not long enough!!"
+    write(*,*) "   increase its size to at least ",len_trim(name)
+    stop
+  endif
+  
+  ! Set output sample rate
+  isample=ecritphy ! same as for diagfi outputs
+  ! Note ecritphy is known from control.h
+  
+  ! Create output NetCDF file
+  if (is_master) then
+   ierr=NF_CREATE(filename,NF_CLOBBER,nid)
+   if (ierr.ne.NF_NOERR) then
+    write(*,*)'writediagsoil: Error, failed creating file '//trim(filename)
+    stop
+   endif
+  endif ! of if (is_master)
+
+  ! Define dimensions and axis attributes
+  call iniwritesoil(nid,ngrid)
+  
+  ! set zitau to -1 to be compatible with zitau incrementation step below
+  zitau=-1
+  
+else
+  ! If not an initialization call, simply open the NetCDF file
+  if (is_master) then
+   ierr=NF_OPEN(filename,NF_WRITE,nid)
+  endif
+endif ! of if (firstname.eq."1234567890")
+
+! 2. Increment local time counter, if necessary
+if (name.eq.firstname) then
+  ! if we run across 'firstname', then it is a new time step
+  zitau=zitau+iphysiq
+  ! Note iphysiq is known from control.h
+endif
+
+! 3. Write data, if the time index matches the sample rate
+if (mod(zitau+1,isample).eq.0) then
+
+! 3.1 If first call at this date, update 'time' variable
+  if (name.eq.firstname) then
+    ntime=ntime+1
+    date=float(zitau+1)/float(day_step)
+    ! Note: day_step is known from control.h
+    
+    if (is_master) then
+     ! Get NetCDF ID for "time"
+     ierr=NF_INQ_VARID(nid,"time",varid)
+     ! Add the current value of date to the "time" array
+!#ifdef NC_DOUBLE
+!     ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+!#else
+     ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+!#endif
+     if (ierr.ne.NF_NOERR) then
+      write(*,*)"writediagsoil: Failed writing date to time variable"
+      stop 
+     endif
+    endif ! of if (is_master)
+  endif ! of if (name.eq.firstname)
+
+! 3.2 Write the variable to the NetCDF file
+if (dimpx.eq.3) then ! Case of a 3D variable
+  ! A. Recast data along 'dynamics' grid
+#ifdef CPP_PARA
+  ! gather field on a "global" (without redundant longitude) array
+  call Gather(px,dx3_glop)
+!$OMP MASTER
+  if (is_mpi_root) then
+    call Grid1Dto2D_glo(dx3_glop,dx3_glo)
+    ! copy dx3_glo() to dx3(:) and add redundant longitude
+    data3(1:iim,:,:)=dx3_glo(1:iim,:,:)
+    data3(iip1,:,:)=data3(1,:,:)
+  endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
+  do l=1,nsoilmx
+    ! handle the poles
+    do i=1,iip1
+      data3(i,1,l)=px(1,l)
+      data3(i,jjp1,l)=px(ngrid,l)
+    enddo
+    ! rest of the grid
+    do j=2,jjm
+      ig0=1+(j-2)*iim
+      do i=1,iim
+        data3(i,j,l)=px(ig0+i,l)
+      enddo
+      data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
+    enddo
+  enddo
+#endif
+  
+  ! B. Write (append) the variable to the NetCDF file
+  if (is_master) then
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+    ierr=NF_INQ_DIMID(nid,"depth",id(3))
+    ierr=NF_INQ_DIMID(nid,"time",id(4))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,4,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+  
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=1
+  corners(2)=1
+  corners(3)=1
+  corners(4)=ntime
+  
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=nsoilmx
+  edges(4)=1
+  
+  ! B.3. Write the slab of data
+!#ifdef NC_DOUBLE
+!  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
+!#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
+!#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+  endif ! of if (is_master)
+
+elseif (dimpx.eq.2) then ! Case of a 2D variable
+
+  ! A. Recast data along 'dynamics' grid
+#ifdef CPP_PARA
+  ! gather field on a "global" (without redundant longitude) array
+  px2(:)=px(:,1)
+  call Gather(px2,dx2_glop)
+!$OMP MASTER
+  if (is_mpi_root) then
+    call Grid1Dto2D_glo(dx2_glop,dx2_glo)
+    ! copy dx3_glo() to dx3(:) and add redundant longitude
+    data2(1:iim,:)=dx2_glo(1:iim,:)
+    data2(iip1,:)=data2(1,:)
+  endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
+  ! handle the poles
+  do i=1,iip1
+    data2(i,1)=px(1,1)
+    data2(i,jjp1)=px(ngrid,1)
+  enddo
+  ! rest of the grid
+  do j=2,jjm
+    ig0=1+(j-2)*iim
+    do i=1,iim
+      data2(i,j)=px(ig0+i,1)
+    enddo
+    data2(iip1,j)=data2(1,j) ! extra (modulo) longitude
+  enddo
+#endif
+
+  ! B. Write (append) the variable to the NetCDF file
+  if (is_master) then
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+    ierr=NF_INQ_DIMID(nid,"time",id(3))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,3,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=1
+  corners(2)=1
+  corners(3)=ntime
+  
+  edges(1)=iip1
+  edges(2)=jjp1
+  edges(3)=1
+  
+  ! B.3. Write the slab of data
+!#ifdef NC_DOUBLE
+!  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
+!#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
+!#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+  endif ! of if (is_master)
+
+elseif (dimpx.eq.0) then ! Case of a 0D variable
+#ifdef CPP_PARA
+  write(*,*) "writediagsoil: dimps==0 case not implemented in // mode!!"
+  stop
+#endif
+  ! A. Copy data value
+  data0=px(1,1)
+
+  ! B. Write (append) the variable to the NetCDF file
+  ! B.1. Get the ID of the variable
+  ierr=NF_INQ_VARID(nid,name,varid)
+  if (ierr.ne.NF_NOERR) then
+    ! If we failed geting the variable's ID, we assume it is because
+    ! the variable doesn't exist yet and must be created.
+    ! Start by obtaining corresponding dimensions IDs
+    ierr=NF_INQ_DIMID(nid,"time",id(1))
+    ! Tell the world about it
+    write(*,*) "====================="
+    write(*,*) "writediagsoil: creating variable "//trim(name)
+    call def_var(nid,name,title,units,1,id,varid,ierr)
+  endif ! of if (ierr.ne.NF_NOERR)
+
+  ! B.2. Prepare things to be able to write/append the variable
+  corners(1)=ntime
+  
+  edges(1)=1
+
+  ! B.3. Write the data
+!#ifdef NC_DOUBLE
+!  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0)
+!#else
+  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0)
+!#endif
+  if (ierr.ne.NF_NOERR) then
+    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
+               " to file "//trim(filename)//" at time",date
+  endif
+
+endif ! of if (dimpx.eq.3) elseif (dimpx.eq.2) ...
+endif ! of if (mod(zitau+1,isample).eq.0)
+
+! 4. Close the NetCDF file
+if (is_master) then
+  ierr=NF_CLOSE(nid)
+endif
+
+end subroutine writediagsoil
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagspecIR.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagspecIR.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagspecIR.F	(revision 222)
@@ -0,0 +1,309 @@
+      subroutine writediagspecIR(ngrid,nom,titre,unite,dimpx,px)
+
+!  Ecriture de variables diagnostiques au choix dans la physique 
+!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
+!  3d (ex : temperature), 2d (ex : temperature de surface), ou
+!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+!  solaire)
+!  Dans la version 2000, la periode d'ecriture est celle de 
+!  "ecritphy " regle dans le fichier de controle de run :  run.def
+!
+!    writediagfi peut etre appele de n'importe quelle subroutine
+!    de la physique, plusieurs fois. L'initialisation et la creation du
+!    fichier se fait au tout premier appel.
+!
+! WARNING : les variables dynamique (u,v,t,q,ps)
+!  sauvees par writediagfi avec une
+! date donnee sont legerement differentes que dans le fichier histoire car 
+! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
+! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
+! avant l'ecriture dans diagfi (cf. physiq.F)
+!  
+!
+!  parametres (input) :
+!  ----------
+!      ngrid : nombres de point ou est calcule la physique
+!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
+!                 (= nlon ou klon dans la physique terrestre)
+!      
+!      unit : unite logique du fichier de sortie (toujours la meme)
+!      nom  : nom de la variable a sortir (chaine de caracteres)
+!      titre: titre de la variable (chaine de caracteres)
+!      unite : unite de la variable (chaine de caracteres)
+!      px : variable a sortir (real 0, 2, ou 3d)
+!      dimpx : dimension de px : 0, 2, ou 3 dimensions
+!
+!=================================================================
+!
+!      This is a modified version that accepts spectrally varying input
+!      RW (2010)
+!
+!=================================================================
+ 
+! Addition by RW (2010) to allow OLR to be saved in .nc format
+      use radinc_h, only : L_NSPECTI
+!      USE surfdat_h, only : phisfi
+#ifdef CPP_PARA
+      use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather
+      use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
+#endif
+      use control_mod, only: ecritphy, iphysiq, day_step
+
+      implicit none
+
+! Commons
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+!#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "netcdf.inc"
+#include "temps.h"
+#include "callkeys.h"
+
+! Arguments on input:
+      integer,intent(in) :: ngrid
+      character (len=*),intent(in) :: nom,titre,unite
+      integer,intent(in) :: dimpx
+      real,intent(in) :: px(ngrid,L_NSPECTI)
+
+! Local variables:
+
+!      real dx3(iip1,jjp1,llm) ! to store a 3D data set
+!      real dx2(iip1,jjp1)     ! to store a 2D (surface) data set
+!      real dx0
+
+      real date
+
+!      REAL phis(ip1jmp1)
+
+      integer irythme
+      integer ierr
+      integer iq
+      integer i,j,l,zmax , ig0
+
+      integer zitau
+      character firstnom*20
+      SAVE firstnom
+      SAVE zitau
+      SAVE date
+      data firstnom /'1234567890'/
+      data zitau /0/
+
+! Ajouts
+      integer, save :: ntime=0
+      integer :: idim,varid
+      integer :: nid
+      character (len =50):: fichnom
+      integer, dimension(4) :: id
+      integer, dimension(4) :: edges,corner
+
+! added by RDW for OLR output
+       real dx3(iip1,jjp1,L_NSPECTI) ! to store the data set
+
+#ifdef CPP_PARA
+! Added to work in parallel mode
+      real dx3_glop(klon_glo,L_NSPECTI)
+      real dx3_glo(iim,jjp1,L_NSPECTI) ! to store a global 3D data set
+#else
+      logical,parameter :: is_master=.true.
+      logical,parameter :: is_mpi_root=.true.
+#endif
+
+!***************************************************************
+!Sortie des variables au rythme voulu
+
+      irythme = ecritphy*iradia ! sortie au rythme de ecritphy*iradia
+!EM+JL if the spetra need to be output more frequently, need to define a ecritSpec...
+!     irythme = iphysiq  ! sortie a tous les pas physique
+
+
+!***************************************************************
+
+! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
+! ------------------------------------------------------------------------
+! (Au tout premier appel de la subroutine durant le run.)
+
+      fichnom="diagspecIR.nc"
+
+      if (firstnom.eq.'1234567890') then ! .true. for the very first call
+      !  to this subroutine; now set 'firstnom'
+         firstnom = nom
+         ! just to be sure, check that firstnom is large enough to hold nom
+         if (len_trim(firstnom).lt.len_trim(nom)) then
+           write(*,*) "writediagspecIR: Error !!!"
+           write(*,*) "   firstnom string not long enough!!"
+           write(*,*) "   increase its size to at least ",len_trim(nom)
+           stop
+         endif
+
+         ! Create the NetCDF file
+         if (is_master) then
+         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+         ! Define the 'Time' dimension
+         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+         ! Define the 'Time' variable
+#ifdef NC_DOUBLE
+         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+#else
+         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+#endif
+         ! Add a long_name attribute
+         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+     .          4,"Time")
+         ! Add a units attribute
+         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
+     .          "days since 0000-00-0 00:00:00")
+         ! Switch out of NetCDF Define mode
+         ierr = NF_ENDDEF(nid)
+
+!         call gr_fi_dyn(1,size(phisfi_glo),iip1,jjp1,phisfi_glo,phis)
+         ! write "header" of file (longitudes, latitudes, area, ...)
+         call iniwrite_specIR(nid,day_ini)
+         endif ! of if (is_master)
+
+         zitau = -1 ! initialize zitau
+      else
+         if (is_master) then
+           ! Open the NetCDF file
+           ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+         endif
+      endif ! if (firstnom.eq.'1234567890')
+
+! Increment time index 'zitau' if it is the "firstcall" (at given time level)
+! to writediagfi
+!------------------------------------------------------------------------
+      if (nom.eq.firstnom) then
+          zitau = zitau + iphysiq
+      end if
+
+!--------------------------------------------------------
+! Write the variables to output file if it's time to do so
+!--------------------------------------------------------
+
+      if ( MOD(zitau+1,irythme) .eq.0.) then
+
+! Compute/write/extend 'Time' coordinate (date given in days)
+! (done every "first call" (at given time level) to writediagfi)
+! Note: date is incremented as 1 step ahead of physics time
+!       (like the 'histoire' outputs)
+!--------------------------------------------------------
+
+        if (nom.eq.firstnom) then
+
+        ! We have identified a "first call" (at given date)
+           ntime=ntime+1 ! increment # of stored time steps
+           ! compute corresponding date (in days and fractions thereof)
+           date= float (zitau +1)/float (day_step)
+
+           if (is_master) then
+             ! Get NetCDF ID of 'Time' variable
+             ierr= NF_INQ_VARID(nid,"Time",varid)
+
+             ! Write (append) the new date to the 'Time' array
+#ifdef NC_DOUBLE
+             ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+             ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+             if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagspec_nc"
+              write(*,*) "***** with time"
+              write(*,*) 'ierr=', ierr   
+c             call abort
+             endif
+
+             write(6,*)'WRITEDIAGSPEC: date= ', date
+           endif ! of if (is_master)
+        end if ! of if (nom.eq.firstnom)
+
+
+ 
+!Case of a 3D variable
+!---------------------
+        if (dimpx.eq.3) then
+
+!         A. Recast (copy) variable from physics grid to dynamics grid
+#ifdef CPP_PARA
+  ! gather field on a "global" (without redundant longitude) array
+          call Gather(px,dx3_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(dx3_glop,dx3_glo)
+            ! copy dx3_glo() to dx3(:) and add redundant longitude
+            dx3(1:iim,:,:)=dx3_glo(1:iim,:,:)
+            dx3(iip1,:,:)=dx3(1,:,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
+           DO l=1,L_NSPECTI
+             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
+#endif
+
+!         B. Write (append) the variable to the NetCDF file
+          if (is_master) then
+
+! name of the variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"IR Wavenumber",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGSPECIR: creating variable ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=L_NSPECTI
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR problem in writediagspec"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+             call abort
+           endif 
+
+          endif ! of if (is_master)
+
+        endif ! of if (dimpx.eq.3)
+
+      endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
+
+      ! Close the NetCDF file
+      if (is_master) then
+        ierr= NF_CLOSE(nid)
+      endif
+
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagspecVI.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagspecVI.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writediagspecVI.F	(revision 222)
@@ -0,0 +1,309 @@
+      subroutine writediagspecVI(ngrid,nom,titre,unite,dimpx,px)
+
+!  Ecriture de variables diagnostiques au choix dans la physique 
+!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
+!  3d (ex : temperature), 2d (ex : temperature de surface), ou
+!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
+!  solaire)
+!  Dans la version 2000, la periode d'ecriture est celle de 
+!  "ecritphy " regle dans le fichier de controle de run :  run.def
+!
+!    writediagfi peut etre appele de n'importe quelle subroutine
+!    de la physique, plusieurs fois. L'initialisation et la creation du
+!    fichier se fait au tout premier appel.
+!
+! WARNING : les variables dynamique (u,v,t,q,ps)
+!  sauvees par writediagfi avec une
+! date donnee sont legerement differentes que dans le fichier histoire car 
+! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
+! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
+! avant l'ecriture dans diagfi (cf. physiq.F)
+!  
+!
+!  parametres (input) :
+!  ----------
+!      ngrid : nombres de point ou est calcule la physique
+!                (ngrid = 2+(jjm-1)*iim - 1/jjm)
+!                 (= nlon ou klon dans la physique terrestre)
+!      
+!      unit : unite logique du fichier de sortie (toujours la meme)
+!      nom  : nom de la variable a sortir (chaine de caracteres)
+!      titre: titre de la variable (chaine de caracteres)
+!      unite : unite de la variable (chaine de caracteres)
+!      px : variable a sortir (real 0, 2, ou 3d)
+!      dimpx : dimension de px : 0, 2, ou 3 dimensions
+!
+!=================================================================
+!
+!      This is a modified version that accepts spectrally varying input
+!      RW (2010)
+!
+!=================================================================
+ 
+! Addition by RW (2010) to allow OSR to be saved in .nc format
+      use radinc_h, only : L_NSPECTV
+!      USE surfdat_h
+#ifdef CPP_PARA
+      use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather
+      use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
+#endif
+      use control_mod, only: ecritphy, iphysiq, day_step
+
+      implicit none
+
+! Commons
+#include "dimensions.h"
+#include "dimphys.h"
+#include "paramet.h"
+!#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "netcdf.inc"
+#include "temps.h"
+#include "callkeys.h"
+
+! Arguments on input:
+      integer ngrid
+      character (len=*) :: nom,titre,unite
+      integer dimpx
+      real px(ngrid,L_NSPECTV)
+
+! Local variables:
+
+!      real dx3(iip1,jjp1,llm) ! to store a 3D data set
+!      real dx2(iip1,jjp1)     ! to store a 2D (surface) data set
+!      real dx0
+
+      real date
+
+!      REAL phis(ip1jmp1)
+
+      integer irythme
+      integer ierr
+      integer iq
+      integer i,j,l,zmax , ig0
+
+      integer zitau
+      character firstnom*20
+      SAVE firstnom
+      SAVE zitau
+      SAVE date
+      data firstnom /'1234567890'/
+      data zitau /0/
+
+! Ajouts
+      integer, save :: ntime=0
+      integer :: idim,varid
+      integer :: nid
+      character (len =50):: fichnom
+      integer, dimension(4) :: id
+      integer, dimension(4) :: edges,corner
+
+! added by RDW for OSR output
+       real dx3(iip1,jjp1,L_NSPECTV) ! to store the data set
+
+#ifdef CPP_PARA
+! Added to work in parallel mode
+      real dx3_glop(klon_glo,L_NSPECTV)
+      real dx3_glo(iim,jjp1,L_NSPECTV) ! to store a global 3D data set
+#else
+      logical,parameter :: is_master=.true.
+      logical,parameter :: is_mpi_root=.true.
+#endif
+
+!***************************************************************
+!Sortie des variables au rythme voulu
+
+      irythme = ecritphy*iradia ! sortie au rythme de ecritphy
+!EM+JL if the spetra need to be output more frequently, need to define a ecritSpec...
+!     irythme = iphysiq  ! sortie a tous les pas physique
+
+!***************************************************************
+
+! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
+! ------------------------------------------------------------------------
+! (Au tout premier appel de la subroutine durant le run.)
+
+      fichnom="diagspecVI.nc"
+
+      if (firstnom.eq.'1234567890') then ! .true. for the very first call
+      !  to this subroutine; now set 'firstnom'
+         firstnom = nom
+         ! just to be sure, check that firstnom is large enough to hold nom
+         if (len_trim(firstnom).lt.len_trim(nom)) then
+           write(*,*) "writediagfi: Error !!!"
+           write(*,*) "   firstnom string not long enough!!"
+           write(*,*) "   increase its size to at least ",len_trim(nom)
+           stop
+         endif
+
+         ! Create the NetCDF file
+         if (is_master) then
+         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+         ! Define the 'Time' dimension
+         ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
+         ! Define the 'Time' variable
+#ifdef NC_DOUBLE
+         ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
+#else
+         ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
+#endif
+         ! Add a long_name attribute
+         ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
+     .          4,"Time")
+         ! Add a units attribute
+         ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
+     .          "days since 0000-00-0 00:00:00")
+         ! Switch out of NetCDF Define mode
+         ierr = NF_ENDDEF(nid)
+
+         ! write "header" of file (longitudes, latitudes, geopotential, ...)
+!         call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis)
+!         call iniwrite(nid,day_ini,phis)
+         call iniwrite_specVI(nid,day_ini)
+         endif ! of if (is_master)
+
+         zitau = -1 ! initialize zitau
+      else
+         if (is_master) then
+           ! Open the NetCDF file
+           ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+         endif
+      endif ! if (firstnom.eq.'1234567890')
+
+! Increment time index 'zitau' if it is the "firstcall" (at given time level)
+! to writediagfi
+!------------------------------------------------------------------------
+      if (nom.eq.firstnom) then
+          zitau = zitau + iphysiq
+      end if
+
+!--------------------------------------------------------
+! Write the variables to output file if it's time to do so
+!--------------------------------------------------------
+
+      if ( MOD(zitau+1,irythme) .eq.0.) then
+
+! Compute/write/extend 'Time' coordinate (date given in days)
+! (done every "first call" (at given time level) to writediagfi)
+! Note: date is incremented as 1 step ahead of physics time
+!       (like the 'histoire' outputs)
+!--------------------------------------------------------
+
+        if (nom.eq.firstnom) then
+
+        ! We have identified a "first call" (at given date)
+           ntime=ntime+1 ! increment # of stored time steps
+           ! compute corresponding date (in days and fractions thereof)
+           date= float (zitau +1)/float (day_step)
+
+           if (is_master) then
+             ! Get NetCDF ID of 'Time' variable
+             ierr= NF_INQ_VARID(nid,"Time",varid)
+
+             ! Write (append) the new date to the 'Time' array
+#ifdef NC_DOUBLE
+             ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+             ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+             if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in writediagspec_nc"
+              write(*,*) "***** with time"
+              write(*,*) 'ierr=', ierr   
+c             call abort
+             endif
+
+             write(6,*)'WRITEDIAGSPEC: date= ', date
+           endif ! of if (is_master)
+        end if ! of if (nom.eq.firstnom)
+
+
+ 
+!Case of a 3D variable
+!---------------------
+        if (dimpx.eq.3) then
+
+!         A. Recast (copy) variable from physics grid to dynamics grid
+#ifdef CPP_PARA
+  ! gather field on a "global" (without redundant longitude) array
+          call Gather(px,dx3_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(dx3_glop,dx3_glo)
+            ! copy dx3_glo() to dx3(:) and add redundant longitude
+            dx3(1:iim,:,:)=dx3_glo(1:iim,:,:)
+            dx3(iip1,:,:)=dx3(1,:,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
+           DO l=1,L_NSPECTV
+             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
+#endif
+
+!         B. Write (append) the variable to the NetCDF file
+          if (is_master) then
+
+! name of the variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! corresponding dimensions
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"VI Wavenumber",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Create the variable if it doesn't exist yet
+
+              write (*,*) "=========================="
+              write (*,*) "DIAGSPEC: creating variable ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=L_NSPECTV
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR problem in writediagspec"
+              write(*,*) "***** with ",nom
+              write(*,*) 'ierr=', ierr
+             call abort
+           endif 
+
+          endif ! of if (is_master)
+
+        endif ! of if (dimpx.eq.3)
+
+      endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
+
+      ! Close the NetCDF file
+      if (is_master) then
+        ierr= NF_CLOSE(nid)
+      endif
+
+      end
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writeg1d.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writeg1d.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/writeg1d.F	(revision 222)
@@ -0,0 +1,220 @@
+      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
+      IMPLICIT NONE
+
+c.......................................................................
+c
+c  ecriture de x pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nx         ---> taille du vecteur a stocker
+c                             "1" pour une variable de surface
+c                             "nlayer" pour une variable de centre de couche
+c                             "nlayer+1" pour une variable d'interface
+c         * x          ---> variable a stocker
+c         * nom        ---> nom "pour grads"
+c         * titre      ---> titre "pour grads"
+c
+c.......................................................................
+c
+#include "comg1d.h"
+
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nx,i
+      REAL*4 xr4(1000)
+      REAL x(nx)
+      CHARACTER*(*) nom,titre
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ilayer,ivar
+      LOGICAL test 
+c
+c  declaration des variables locales
+c.......................................................................
+c  controle 1D
+c
+c     print*,'ngrid=',ngrid
+      IF (ngrid.NE.1) return
+c
+c  controle 1D
+c.......................................................................
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+
+      do i=1,nx
+        xr4(i) = x(i)
+      enddo
+
+c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
+c.......................................................................
+c  ouverture du fichier au premier appel
+
+
+      g1d_nomfich='g1d.dat'
+
+      IF (g1d_premier) THEN
+        OPEN (g1d_unitfich,FILE=g1d_nomfich
+     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
+        g1d_irec=0
+        g1d_nvar=0
+        g1d_premier=.false.
+      ENDIF
+
+c  ouverture du fichier au premier appel
+c.......................................................................
+c  pour l'ecriture du fichier ctl
+
+      test=.true.
+      DO ivar=1,g1d_nvar
+        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
+        IF (nx .GT. 1000) then
+          print*,'ERROR:  nx > 1000 dans writeg1d.F' 
+          print*,'Changer la dimension de xr4'
+          call exit(1)
+        ENDIF
+      ENDDO
+      IF (test) THEN
+        g1d_nvar=g1d_nvar+1
+        g1d_nomvar(g1d_nvar)=nom
+        g1d_titrevar(g1d_nvar)=titre
+        IF (nx.EQ.1) THEN
+           g1d_dimvar(g1d_nvar)=0
+        ELSEIF (nx.EQ.g1d_nlayer) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer
+        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
+           g1d_dimvar(g1d_nvar)=g1d_nlayer+1
+        ELSE
+           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
+           print*,'NX = ',nx
+           print*,'g1d_nlayer = ',g1d_nlayer
+        ENDIF
+      ENDIF
+c
+c  pour l'ecriture du fichier ctl
+c.......................................................................
+c  ecriture
+c
+      IF (nx.EQ.1) THEN
+        g1d_irec=g1d_irec+1
+        WRITE(g1d_unitfich,REC=g1d_irec) xr4(1)
+      ELSE
+        DO ilayer=1,g1d_nlayer
+          g1d_irec=g1d_irec+1
+          WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer)
+        ENDDO
+      ENDIF
+c
+c  ecriture
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
+
+
+
+
+
+c *********************************************************************
+c *********************************************************************
+
+      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
+      IMPLICIT NONE
+c.......................................................................
+c
+c  ecriture du fichier de controle pour GRADS-1D
+c
+c  in :
+c         * ngrid      ---> pour controler que l'on est bien en 1D
+c         * nlayer     ---> nombre de couches
+c         * zlayer     ---> altitude au centre de chaque couche (km)
+c         * ndt        ---> nombre de pas de temps
+c
+c.......................................................................
+c
+#include "comg1d.h"
+#include "comcstfi.h"
+
+
+c
+c.......................................................................
+c  declaration des arguments 
+c
+      INTEGER ngrid,nlayer
+      REAL zlayer(nlayer)
+      INTEGER ndt
+c
+c  declaration des arguments 
+c....................................................................... 
+c  declaration des variables locales
+c
+      INTEGER ivar,ilayer
+c
+
+
+!      integer saveG1D
+
+c  declaration des variables locales
+c.......................................................................
+c  contole 1D
+c
+      IF (ngrid.NE.1) GOTO 10001
+c
+c  contole 1D
+c.......................................................................
+c
+      IF (nlayer.ne.g1d_nlayer) 
+     &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) '
+c
+c.......................................................................
+c
+      CLOSE (g1d_unitfich)
+c
+c.......................................................................
+
+
+      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100)
+      WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich
+      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
+      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
+      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
+      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
+      WRITE (g1d_unitctl,'(5(1x,f13.5))')
+     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
+
+c     Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24)
+!      ivar =min( max(int(1440.*dtphys/daysec +0.5),1) , 99)   
+!      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
+!     &      'TDEF ',ndt,' LINEAR 01JAN2000 ', ivar,'MN '
+
+      ivar =min( max(int(1440.*dtphys*saveG1D/daysec +0.5),1) , 99)
+      ! not sure ivar is right, but it doesnt matter
+      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
+     &      'TDEF ',ndt/saveG1D,' LINEAR 01JAN2000 ', ivar,'MN '
+
+      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
+      DO ivar=1,g1d_nvar
+      WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') 
+     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
+      ENDDO
+      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
+      CLOSE (g1d_unitctl)
+c
+c.......................................................................
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+      RETURN
+      END
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/wstats.F90
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/wstats.F90	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/wstats.F90	(revision 222)
@@ -0,0 +1,429 @@
+subroutine wstats(ngrid,nom,titre,unite,dim,px)
+
+use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather, klon_mpi_begin
+use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
+
+implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comconst.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,intent(in) :: ngrid
+character (len=*),intent(in) :: nom,titre,unite
+integer,intent(in) :: dim
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+real,intent(in) :: px(ngrid,llm)
+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,sizes
+logical, save :: firstcall=.TRUE.
+integer :: l,i,j,ig0
+integer,save :: indx
+
+integer, save :: step=0
+
+! Added to work in parallel mode
+#ifdef CPP_PARA
+real px3_glop(klon_glo,llm) ! to store a 3D data set on global physics grid
+real px3_glo(iim,jjp1,llm) ! to store a global 3D data set on global lonxlat grid
+real px2_glop(klon_glo) ! to store a 2D data set on global physics grid
+real px2_glo(iim,jjp1) ! to store a 2D data set on global lonxlat grid
+real px2(ngrid)
+real px3(ngrid,llm)
+#else
+! When not running in parallel mode:
+real px3_glop(ngrid,llm) ! to store a 3D data set on global physics grid
+real px3_glo(iim,jjp1,llm) ! to store a global 3D data set on global lonxlat grid
+real px2_glop(ngrid) ! to store a 2D data set on global physics grid
+real px2_glo(iim,jjp1) ! to store a 2D data set on global lonxlat grid
+#endif
+
+! 1. Initialization (creation of stats.nc file)
+if (firstcall) then
+   firstcall=.false.
+   firstvar=trim((nom))
+   call inistats(ierr)
+endif
+
+if (firstvar==nom) then ! If we're back to the first variable, increment time counter
+      step = step + 1
+endif
+
+if (mod(step,istats).ne.0) then
+  ! if its not time to write to file, exit
+   RETURN
+endif
+
+! collect fields on a global physics grid
+#ifdef CPP_PARA
+ if (dim.eq.3) then
+  px3(1:ngrid,1:llm)=px(1:ngrid,1:llm)
+  ! Gather fieds on a "global" (without redundant longitude) array
+  call Gather(px3,px3_glop)
+!$OMP MASTER
+  if (is_mpi_root) then
+    call Grid1Dto2D_glo(px3_glop,px3_glo)
+    ! copy dx3_glo() to dx3(:) and add redundant longitude
+    dx3(1:iim,:,:)=px3_glo(1:iim,:,:)
+    dx3(iip1,:,:)=dx3(1,:,:)
+  endif
+!$OMP END MASTER
+!$OMP BARRIER
+ else ! dim.eq.2
+  ! Gather fieds on a "global" (without redundant longitude) array
+  px2(:)=px(:,1)
+  call Gather(px2,px2_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(px2_glop,px2_glo)
+            ! copy px2_glo() to dx2(:) and add redundant longitude
+            dx2(1:iim,:)=px2_glo(1:iim,:)
+            dx2(iip1,:)=dx2(1,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+ endif
+#else
+  if (dim.eq.3) then
+    px3_glop(:,1:llm)=px(:,1:llm)
+!  Passage variable physique -->  variable dynamique
+    DO l=1,llm
+      DO i=1,iim
+         px3_glo(i,1,l)=px(1,l)
+         px3_glo(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            px3_glo(i,j,l)=px(ig0+i,l)
+         ENDDO
+      ENDDO
+    ENDDO
+  else ! dim.eq.2
+    px2_glop(:)=px(:,1)
+!    Passage variable physique -->  physique dynamique
+   DO i=1,iim
+     px2_glo(i,1)=px(1,1)
+     px2_glo(i,jjp1)=px(ngrid,1)
+   ENDDO
+   DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        px2_glo(i,j)=px(ig0+i,1)
+     ENDDO
+   ENDDO
+  endif
+#endif
+
+! 2. Write field to file
+
+if (is_master) then
+! only master needs do this
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+namebis=trim(nom)
+
+! test: check if that variable already exists in file
+ierr= NF_INQ_VARID(nid,namebis,meanid)
+
+if (ierr.ne.NF_NOERR) then
+  ! variable not in file, create/define it
+   if (firstvar==nom) then 
+      indx=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(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+   if (dim.eq.3) then
+     call inivar(nid,meanid,size(px3_glop,1),dim,indx,px3_glop,ierr)
+   else ! dim.eq.2
+     call inivar(nid,meanid,size(px2_glop,1),dim,indx,px2_glop,ierr)
+   endif
+   namebis=trim(nom)//"_sd"
+   call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+   if (dim.eq.3) then
+     call inivar(nid,sdid,size(px3_glop,1),dim,indx,px3_glop,ierr)
+   else ! dim.eq.2
+     call inivar(nid,sdid,size(px2_glop,1),dim,indx,px2_glop,ierr)
+   endif
+
+   ierr= NF_CLOSE(nid)
+   return
+
+else
+   ! variable found in file
+   namebis=trim(nom)//"_sd"
+   ierr= NF_INQ_VARID(nid,namebis,sdid)
+
+endif
+
+if (firstvar==nom) then 
+   count(indx)=count(int(indx))+1
+   indx=indx+1
+   if (indx>istime) then
+      indx=1
+   endif
+endif
+
+if (count(indx)==0) then
+   ! very first time we write the variable to file
+   if (dim.eq.3) then
+      start=(/1,1,1,indx/)
+      sizes=(/iip1,jjp1,llm,1/)
+      mean3d(:,:,:)=0
+      sd3d(:,:,:)=0
+   else if (dim.eq.2) then
+      start=(/1,1,indx,0/)
+      sizes=(/iip1,jjp1,1,0/)
+      mean2d(:,:)=0
+      sd2d(:,:)=0
+   endif
+else
+   ! load values from file
+   if (dim.eq.3) then
+      start=(/1,1,1,indx/)
+      sizes=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean3d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,sizes,sd3d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,sizes,mean3d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,sizes,sd3d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+   else if (dim.eq.2) then
+      start=(/1,1,indx,0/)
+      sizes=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean2d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,sizes,sd2d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,sizes,mean2d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,sizes,sd2d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+   endif
+endif ! of if (count(indx)==0)
+
+
+! 2.1. Build dx* (data on lon-lat grid, with redundant longitude)
+
+if (dim.eq.3) then
+  dx3(1:iim,:,:)=px3_glo(:,:,:)
+  dx3(iip1,:,:)=dx3(1,:,:)
+else ! dim.eq.2
+  dx2(1:iim,:)=px2_glo(:,:)
+  dx2(iip1,:)=dx2(1,:)
+endif
+
+
+! 2.2. Add current values to previously stored sums
+
+if (dim.eq.3) then
+
+   mean3d(:,:,:)=mean3d(:,:,:)+dx3(:,:,:)
+   sd3d(:,:,:)=sd3d(:,:,:)+dx3(:,:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,sizes,mean3d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,sizes,sd3d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,sizes,mean3d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,sizes,sd3d)
+#endif
+
+else if (dim.eq.2) then
+
+   mean2d(:,:)= mean2d(:,:)+dx2(:,:)
+   sd2d(:,:)=sd2d(:,:)+dx2(:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,sizes,mean2d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,sizes,sd2d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,sizes,mean2d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,sizes,sd2d)
+#endif
+
+endif ! of if (dim.eq.3) elseif (dim.eq.2)
+
+  ierr= NF_CLOSE(nid)
+endif ! of if (is_master)
+
+end subroutine wstats
+
+!======================================================
+subroutine inivar(nid,varid,ngrid,dim,indx,px,ierr)
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "netcdf.inc"
+
+integer, intent(in) :: nid,varid,dim,indx,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,sizes
+real, dimension(iip1,jjp1,llm) :: dx3
+real, dimension(iip1,jjp1) :: dx2
+
+if (dim.eq.3) then
+
+   start=(/1,1,1,indx/)
+   sizes=(/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,sizes,dx3)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx3)
+#endif
+
+else if (dim.eq.2) then
+
+      start=(/1,1,indx,0/)
+      sizes=(/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,sizes,dx2)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,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
+
Index: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/zerophys.F
===================================================================
--- codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/zerophys.F	(revision 222)
+++ codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/zerophys.F	(revision 222)
@@ -0,0 +1,11 @@
+      SUBROUTINE zerophys(n,x)
+      IMPLICIT NONE
+      INTEGER n
+      REAL x(n)
+      INTEGER i
+
+      DO i=1,n
+         x(i)=0.
+      ENDDO
+      RETURN
+      END
