Index: /trunk/DOC/chantiers/commit_importants.log
===================================================================
--- /trunk/DOC/chantiers/commit_importants.log	(revision 1548)
+++ /trunk/DOC/chantiers/commit_importants.log	(revision 1549)
@@ -1730,2 +1730,39 @@
 Also added checking in phyetat0 that the longitude/latitude read in the
 restartphy.nc files match the ones provided by the dynamics.
+
+**********************
+**** commit_v1549 ****
+**********************
+Ehouarn: Further adaptations to keep up with changes in LMDZ5 concerning
+physics/dynamics separation (up to rev r2420 of LMDZ5)
+* all physics packages:
+- added module callphysiq_mod.F90 in dynphy_lonlat/phy*** which contains 
+  the routine "call_physiq" which is called by calfis* and calls the 
+  physics. This way different "physiq" routine from different physics 
+  packages may be called: The calfis* routines now exposes all available 
+  fields that might be transmitted to physiq but which is actually send 
+  (ie: expected/needed by physiq) is decided in call_physiq.
+- turned "physiq.F[90]" into module "physiq_mod.F[90]" for better control  
+  of "physiq" arguments. for phyvenus/phytitan, extracted gr_fi_ecrit from
+  physiq.F as gr_fi_ecrit.F90 (note that it can only work in serial).
+
+* misc:
+- updated wxios.F90 to keep up with LMDZ5 modifications.
+
+* dyn3d_common:
+- infotrac.F90 keep up with LMDZ5 modifications (cosmetics)
+
+* dyn3d:
+- gcm.F90: cosmetic cleanup.
+- leapfrog.F90: fix computation of date as function of itau.
+
+* dyn3dpar:
+- gcm.F: cosmetic cleanup.
+- leapfrog_p.F90: fix computation of date as function of itau.
+    NB: physics are given the date corresponding to the end of the
+    physics step.
+
+* dynphy_lonlat:
+- calfis.F : added computation of relative wind vorticity.
+- calfis_p.F: added computation of relative wind vorticity (input required
+  by Earth physics)
Index: /trunk/LMDZ.COMMON/libf/dyn3d/gcm.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d/gcm.F90	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/dyn3d/gcm.F90	(revision 1549)
@@ -85,9 +85,4 @@
   include "iniprint.h"
   include "tracstoke.h"
-#ifdef INCA
-! Only INCA needs these informations (from the Earth's physics)
-!#include "indicesol.h"
-#endif
-
 
   REAL zdtvr
Index: /trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F	(revision 1549)
@@ -298,8 +298,11 @@
    1  CONTINUE ! Matsuno Forward step begins here
 
+c   date: (NB: date remains unchanged for Backward step)
+c   -----
+
       jD_cur = jD_ref + day_ini - day_ref +                             &
-     &          itau/day_step 
+     &          (itau+1)/day_step 
       jH_cur = jH_ref + start_time +                                    &
-     &          mod(itau,day_step)/float(day_step) 
+     &          mod(itau+1,day_step)/float(day_step) 
       jD_cur = jD_cur + int(jH_cur)
       jH_cur = jH_cur - int(jH_cur)
@@ -349,6 +352,15 @@
 c-----------------------------------------------------------------------
 
-c   date:
+c   date: (NB: only leapfrog step requires recomputing date)
 c   -----
+
+      IF (leapf) THEN
+        jD_cur = jD_ref + day_ini - day_ref +
+     &            (itau+1)/day_step
+        jH_cur = jH_ref + start_time +
+     &            mod(itau+1,day_step)/float(day_step) 
+        jD_cur = jD_cur + int(jH_cur)
+        jH_cur = jH_cur - int(jH_cur)
+      ENDIF
 
 
@@ -516,5 +528,5 @@
 
            jD_cur = jD_ref + day_ini - day_ref +                        &
-     &          itau/day_step 
+     &          (itau+1)/day_step 
 
            IF ((planet_type .eq."generic").or.
@@ -525,5 +537,10 @@
 
            jH_cur = jH_ref + start_time +                               &
-     &          mod(itau,day_step)/float(day_step) 
+     &          mod(itau+1,day_step)/float(day_step) 
+           IF ((planet_type .eq."generic").or.
+     &         (planet_type .eq."mars")) THEN
+             jH_cur = jH_ref + start_time +                               &
+     &          mod(itau,day_step)/float(day_step)
+           ENDIF
            jD_cur = jD_cur + int(jH_cur)
            jH_cur = jH_cur - int(jH_cur)
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90	(revision 1549)
@@ -728,12 +728,12 @@
 
     do iq=nqo+1,nqtot
-       write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq)
+!       write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq)
        do phase=1,nqo    
         do ixt= 1,niso_possibles   
          tnom_trac=trim(tnom_0(phase))//'_'
          tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt))
-         write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac      
+!         write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac      
          IF (tnom_0(iq) == tnom_trac) then
-          write(lunout,*) 'Ce traceur est un isotope'
+!          write(lunout,*) 'Ce traceur est un isotope'
           nb_iso(ixt,phase)=nb_iso(ixt,phase)+1   
           nb_isoind(phase)=nb_isoind(phase)+1   
@@ -742,12 +742,12 @@
           indnum_fn_num(ixt)=iso_indnum(iq)
           phase_num(iq)=phase
-          write(lunout,*) 'iso_num(iq)=',iso_num(iq)
-          write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
-          write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
-          write(lunout,*) 'phase_num(iq)=',phase_num(iq)
+!          write(lunout,*) 'iso_num(iq)=',iso_num(iq)
+!          write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
+!          write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
+!          write(lunout,*) 'phase_num(iq)=',phase_num(iq)
           goto 20
          else if (iqpere(iq).gt.0) then          
           if (tnom_0(iqpere(iq)) == tnom_trac) then
-           write(lunout,*) 'Ce traceur est le fils d''un isotope'
+!           write(lunout,*) 'Ce traceur est le fils d''un isotope'
            ! c'est un traceur d'isotope
            nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1
@@ -756,7 +756,7 @@
            zone_num(iq)=nb_traciso(ixt,phase)
            phase_num(iq)=phase
-           write(lunout,*) 'iso_num(iq)=',iso_num(iq)
-           write(lunout,*) 'phase_num(iq)=',phase_num(iq)
-           write(lunout,*) 'zone_num(iq)=',zone_num(iq)
+!           write(lunout,*) 'iso_num(iq)=',iso_num(iq)
+!           write(lunout,*) 'phase_num(iq)=',phase_num(iq)
+!           write(lunout,*) 'zone_num(iq)=',zone_num(iq)
            goto 20
           endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
@@ -767,9 +767,9 @@
       enddo !do iq=1,nqtot
 
-      write(lunout,*) 'iso_num=',iso_num
-      write(lunout,*) 'iso_indnum=',iso_indnum
-      write(lunout,*) 'zone_num=',zone_num  
-      write(lunout,*) 'phase_num=',phase_num
-      write(lunout,*) 'indnum_fn_num=',indnum_fn_num
+!      write(lunout,*) 'iso_num=',iso_num
+!      write(lunout,*) 'iso_indnum=',iso_indnum
+!      write(lunout,*) 'zone_num=',zone_num  
+!      write(lunout,*) 'phase_num=',phase_num
+!      write(lunout,*) 'indnum_fn_num=',indnum_fn_num
 
       do ixt= 1,niso_possibles  
@@ -824,6 +824,6 @@
     ! dimensions isotopique:
     ntraciso=niso*(ntraceurs_zone+1)
-    WRITE(lunout,*) 'niso=',niso
-    WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso    
+!    WRITE(lunout,*) 'niso=',niso
+!    WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso    
  
     ! flags isotopiques:
@@ -833,5 +833,5 @@
         ok_isotopes=.false.
     endif 
-    WRITE(lunout,*) 'ok_isotopes=',ok_isotopes
+!    WRITE(lunout,*) 'ok_isotopes=',ok_isotopes
  
     if (ok_isotopes) then
@@ -843,6 +843,6 @@
         alpha_ideal=(/1.0,1.01,1.006,1.003,1.0/)
     endif !if (ok_isotopes) then  
-    WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif
-    WRITE(lunout,*) 'ok_init_iso=',ok_init_iso
+!    WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif
+!    WRITE(lunout,*) 'ok_init_iso=',ok_init_iso
 
     if (ntraceurs_zone.gt.0) then
@@ -851,5 +851,5 @@
         ok_isotrac=.false.
     endif   
-    WRITE(lunout,*) 'ok_isotrac=',ok_isotrac
+!    WRITE(lunout,*) 'ok_isotrac=',ok_isotrac
 
     ! remplissage du tableau iqiso(ntraciso,phase)
@@ -875,5 +875,5 @@
         index_trac(:,:)=0.0
     endif !if (ok_isotrac) then
-    write(lunout,*) 'index_trac=',index_trac    
+!    write(lunout,*) 'index_trac=',index_trac    
 
 ! Finalize :
Index: /trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F	(revision 1549)
@@ -28,9 +28,4 @@
 
 
-#ifdef INCA
-! Only INCA needs these informations (from the Earth's physics)
-      USE indice_sol_mod
-#endif
-
 ! Ehouarn: the following are needed with (parallel) physics:
 #ifdef CPP_PHYS
@@ -86,8 +81,4 @@
 #include "iniprint.h"
 #include "tracstoke.h"
-#ifdef INCA
-! Only INCA needs these informations (from the Earth's physics)
-#include "indicesol.h"
-#endif
 
 
@@ -258,20 +249,4 @@
       endif
 #endif
-c-----------------------------------------------------------------------
-
-      IF (type_trac == 'inca') THEN
-#ifdef INCA
-         call init_const_lmdz(
-     $        nbtr,anneeref,dayref,
-     $        iphysiq,day_step,nday, 
-     $        nbsrf, is_oce,is_sic,
-     $        is_ter,is_lic, calend)
-
-         call init_inca_para(
-     $        iim,jjm+1,llm,klon_glo,mpi_size,
-     $        distrib_phys,COMM_LMDZ)
-#endif
-      END IF
-
 c-----------------------------------------------------------------------
 c   Initialisation des traceurs
@@ -507,16 +482,4 @@
 
 c-----------------------------------------------------------------------
-c   Initialisation des dimensions d'INCA :
-c   --------------------------------------
-      IF (type_trac == 'inca') THEN
-#ifdef INCA
-!$OMP PARALLEL
-         CALL init_inca_dim(klon_omp,llm,iim,jjm,
-     $        rlonu,rlatu,rlonv,rlatv)
-!$OMP END PARALLEL
-#endif
-      END IF
-
-c-----------------------------------------------------------------------
 c   Initialisation des I/O :
 c   ------------------------
Index: /trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F	(revision 1549)
@@ -313,8 +313,11 @@
    1  CONTINUE ! Matsuno Forward step begins here
 
+c   date: (NB: date remains unchanged for Backward step)
+c   -----
+
       jD_cur = jD_ref + day_ini - day_ref +                             &
-     &          itau/day_step
+     &          (itau+1)/day_step
       jH_cur = jH_ref + start_time +                                    &
-     &         mod(itau,day_step)/float(day_step) 
+     &         mod(itau+1,day_step)/float(day_step) 
       if (jH_cur > 1.0 ) then
         jD_cur = jD_cur +1.
@@ -414,6 +417,17 @@
 c-----------------------------------------------------------------------
 
-c   date:
+c   date:  (NB: only leapfrog step requires recomputing date)
 c   -----
+
+      IF (leapf) THEN
+        jD_cur = jD_ref + day_ini - day_ref +
+     &            (itau+1)/day_step
+        jH_cur = jH_ref + start_time +
+     &           mod(itau+1,day_step)/float(day_step) 
+        if (jH_cur > 1.0 ) then
+          jD_cur = jD_cur +1.
+          jH_cur = jH_cur -1.
+        endif
+      ENDIF
 
 
@@ -858,5 +872,5 @@
 
            jD_cur = jD_ref + day_ini - day_ref
-     $        + itau/day_step
+     $        + (itau+1)/day_step
 
            IF ((planet_type .eq."generic").or.
@@ -867,6 +881,10 @@
 
            jH_cur = jH_ref + start_time +                                &
-     &              mod(itau,day_step)/float(day_step) 
-!         call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
+     &              mod(itau+1,day_step)/float(day_step) 
+           IF ((planet_type .eq."generic").or.
+     &         (planet_type .eq."mars")) THEN
+             jH_cur = jH_ref + start_time +                               &
+     &          mod(itau,day_step)/float(day_step)
+           ENDIF
            if (jH_cur > 1.0 ) then
              jD_cur = jD_cur +1.
Index: /trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis.F	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis.F	(revision 1549)
@@ -33,5 +33,8 @@
       USE write_field
       USE cpdet_mod, only: t2tpot,tpot2t
- 
+#ifdef CPP_PHYS
+      USE callphysiq_mod, ONLY: call_physiq
+#endif 
+
 ! used only for zonal averages
       USE moyzon_mod
@@ -145,5 +148,7 @@
       REAL zphi(ngridmx,llm),zphis(ngridmx)
 
+      REAL zrot(iip1,jjm,llm) ! AdlC May 2014
       REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
+      REAL zrfi(ngridmx,llm) ! relative wind vorticity
       REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
 ! ADAPTATION GCM POUR CP(T)
@@ -572,4 +577,18 @@
 
 
+C  Alvaro de la Camara (May 2014)
+C  46.1 Calcul de la vorticite et passage sur la grille physique
+C  --------------------------------------------------------------
+      DO l=1,llm
+        do i=1,iim
+          do j=1,jjm
+            zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l)
+     $                   + pucov(i,j+1,l) - pucov(i,j,l)) 
+     $                   / (cu(i,j)+cu(i,j+1)) 
+     $                   / (cv(i+1,j)+cv(i,j)) *4
+          enddo
+        enddo
+      ENDDO
+
 c   46.champ v:
 c   -----------
@@ -584,4 +603,10 @@
 c     $         ( pdvcov(i,j-1,l)/cv(i,j-1) + pdvcov(i,j,l)/cv(i,j) )
             ENDDO
+               zrfi(ig0 + 1,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l)
+     &                                +zrot(1,j-1,l)+zrot(1,j,l))
+            DO i=2,iim
+               zrfi(ig0 + i,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l)
+     $                   +zrot(i,j-1,l)+zrot(i,j,l))   !  AdlC MAY 2014
+            ENDDO
          ENDDO
       ENDDO
@@ -613,5 +638,5 @@
          zvfi(1,l)  = SSUM(iim,zsin,1)/pi
 !         pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
-
+         zrfi(1, l) = 0.
       ENDDO
 
@@ -642,5 +667,5 @@
          zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
 !         pcvgv(ngridmx,l) = SSUM(iim,zsinbis,1)/pi
-
+         zrfi(ngridmx, l) = 0.
       ENDDO
 c
@@ -674,114 +699,125 @@
          lafin_split=lafin.and.isplit==nsplit_phys
 
-      if (planet_type.eq."earth") then
-         CALL physiq (ngridmx,
-     .             llm,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev,
-     .             zplay,
-     .             zphi,
-     .             zphis,
-     .             presnivs,
-     .             zufi,
-     .             zvfi,
-     .             ztfi,
-     .             zqfi,
-     .             flxwfi,
-     .             zdufi,
-     .             zdvfi,
-     .             zdtfi,
-     .             zdqfi,
-     .             zdpsrf,
-     .             pducov)
-
-      else if ( planet_type=="generic" ) then
-
-         CALL physiq (ngridmx,     !! ngrid
-     .             llm,            !! nlayer
-     .             nqtot,          !! nq
-     .             tname,          !! tracer names from dynamical core (given in infotrac)
-     .             debut_split,    !! firstcall 
-     .             lafin_split,    !! lastcall
-     .             jD_cur,         !! pday. see leapfrog
-     .             jH_cur_split,   !! ptime "fraction of day"
-     .             zdt_split,      !! ptimestep
-     .             zplev,          !! pplev
-     .             zplay,          !! pplay
-     .             zphi,           !! pphi
-     .             zufi,           !! pu
-     .             zvfi,           !! pv
-     .             ztfi,           !! pt
-     .             zqfi,           !! pq
-     .             flxwfi,         !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
-     .             zdufi,          !! pdu
-     .             zdvfi,          !! pdv
-     .             zdtfi,          !! pdt
-     .             zdqfi,          !! pdq
-     .             zdpsrf,         !! pdpsrf
-     .             tracerdyn)      !! tracerdyn <-- utilite ???
-
-      else if ( planet_type=="mars" ) then
-
-        CALL physiq (ngridmx,    ! ngrid
-     .             llm,          ! nlayer
-     .             nqtot,        ! nq
-     .             debut_split,  ! firstcall
-     .             lafin_split,  ! lastcall
-     .             jD_cur,       ! pday
-     .             jH_cur_split, ! ptime
-     .             zdt_split,    ! ptimestep
-     .             zplev,        ! pplev
-     .             zplay,        ! pplay
-     .             zphi,         ! pphi
-     .             zufi,         ! pu
-     .             zvfi,         ! pv
-     .             ztfi,         ! pt
-     .             zqfi,         ! pq
-     .             flxwfi,       ! pw
-     .             zdufi,        ! pdu
-     .             zdvfi,        ! pdv
-     .             zdtfi,        ! pdt
-     .             zdqfi,        ! pdq
-     .             zdpsrf,       ! pdpsrf
-     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
-
-      else if ((planet_type=="titan").or.(planet_type=="venus")) then
-
-         CALL physiq (ngridmx,
-     .             llm,
-     .             nqtot,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev,
-     .             zplay,
-     .             zpk,
-     .             zphi,
-     .             zphis,
-     .             presnivs,
-     .             zufi,
-     .             zvfi,
-     .             ztfi,
-     .             zqfi,
-     .             flxwfi,
-     .             zdufi,
-     .             zdvfi,
-     .             zdtfi,
-     .             zdqfi,
-     .             zdpsrf)
-
-      else ! unknown "planet_type"
-
-        write(lunout,*) "calfis_p: error, unknown planet_type: ",
-     &                  trim(planet_type)
-        stop
-
-      endif ! planet_type
+        CALL call_physiq(ngridmx,llm,nqtot,tname,
+     &                   debut_split,lafin_split,
+     &                   jD_cur,jH_cur_split,zdt_split,
+     &                   zplev,zplay,
+     &                   zpk,zphi,zphis,
+     &                   presnivs,
+     &                   zufi,zvfi,zrfi,ztfi,zqfi,
+     &                   flxwfi,pducov,
+     &                   zdufi,zdvfi,zdtfi,zdqfi,zdpsrf,
+     &                   tracerdyn)
+
+!      if (planet_type.eq."earth") then
+!         CALL physiq (ngridmx,
+!     .             llm,
+!     .             debut_split,
+!     .             lafin_split,
+!     .             jD_cur,
+!     .             jH_cur_split,
+!     .             zdt_split,
+!     .             zplev,
+!     .             zplay,
+!     .             zphi,
+!     .             zphis,
+!     .             presnivs,
+!     .             zufi,
+!     .             zvfi,
+!     .             ztfi,
+!     .             zqfi,
+!     .             flxwfi,
+!     .             zdufi,
+!     .             zdvfi,
+!     .             zdtfi,
+!     .             zdqfi,
+!     .             zdpsrf,
+!     .             pducov)
+!
+!      else if ( planet_type=="generic" ) then
+!
+!         CALL physiq (ngridmx,     !! ngrid
+!     .             llm,            !! nlayer
+!     .             nqtot,          !! nq
+!     .             tname,          !! tracer names from dynamical core (given in infotrac)
+!     .             debut_split,    !! firstcall 
+!     .             lafin_split,    !! lastcall
+!     .             jD_cur,         !! pday. see leapfrog
+!     .             jH_cur_split,   !! ptime "fraction of day"
+!     .             zdt_split,      !! ptimestep
+!     .             zplev,          !! pplev
+!     .             zplay,          !! pplay
+!     .             zphi,           !! pphi
+!     .             zufi,           !! pu
+!     .             zvfi,           !! pv
+!     .             ztfi,           !! pt
+!     .             zqfi,           !! pq
+!     .             flxwfi,         !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
+!     .             zdufi,          !! pdu
+!     .             zdvfi,          !! pdv
+!     .             zdtfi,          !! pdt
+!     .             zdqfi,          !! pdq
+!     .             zdpsrf,         !! pdpsrf
+!     .             tracerdyn)      !! tracerdyn <-- utilite ???
+!
+!      else if ( planet_type=="mars" ) then
+!
+!        CALL physiq (ngridmx,    ! ngrid
+!     .             llm,          ! nlayer
+!     .             nqtot,        ! nq
+!     .             debut_split,  ! firstcall
+!     .             lafin_split,  ! lastcall
+!     .             jD_cur,       ! pday
+!     .             jH_cur_split, ! ptime
+!     .             zdt_split,    ! ptimestep
+!     .             zplev,        ! pplev
+!     .             zplay,        ! pplay
+!     .             zphi,         ! pphi
+!     .             zufi,         ! pu
+!     .             zvfi,         ! pv
+!     .             ztfi,         ! pt
+!     .             zqfi,         ! pq
+!     .             flxwfi,       ! pw
+!     .             zdufi,        ! pdu
+!     .             zdvfi,        ! pdv
+!     .             zdtfi,        ! pdt
+!     .             zdqfi,        ! pdq
+!     .             zdpsrf,       ! pdpsrf
+!     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
+!
+!      else if ((planet_type=="titan").or.(planet_type=="venus")) then
+!
+!         CALL physiq (ngridmx,
+!     .             llm,
+!     .             nqtot,
+!     .             debut_split,
+!     .             lafin_split,
+!     .             jD_cur,
+!     .             jH_cur_split,
+!     .             zdt_split,
+!     .             zplev,
+!     .             zplay,
+!     .             zpk,
+!     .             zphi,
+!     .             zphis,
+!     .             presnivs,
+!     .             zufi,
+!     .             zvfi,
+!     .             ztfi,
+!     .             zqfi,
+!     .             flxwfi,
+!     .             zdufi,
+!     .             zdvfi,
+!     .             zdtfi,
+!     .             zdqfi,
+!     .             zdpsrf)
+!
+!      else ! unknown "planet_type"
+!
+!        write(lunout,*) "calfis_p: error, unknown planet_type: ",
+!     &                  trim(planet_type)
+!        stop
+!
+!      endif ! planet_type
 
          zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split
Index: /trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis_p.F	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/dynphy_lonlat/calfis_p.F	(revision 1549)
@@ -36,5 +36,7 @@
 #endif
 #ifdef CPP_PARA
-      USE parallel_lmdz, ONLY : omp_chunk, using_mpi, AllGather_Field
+      USE parallel_lmdz, ONLY: omp_chunk, using_mpi, AllGather_Field,
+     &                         jjb_u,jje_u,jjb_v,jje_v,
+     &                         jj_begin_dyn=>jj_begin,jj_end_dyn=>jj_end
       USE Write_Field
       Use Write_field_p
@@ -49,4 +51,7 @@
       USE comconst_mod, ONLY: daysec,dtvr,dtphys,kappa,cpp,g,rad,pi
       USE logic_mod, ONLY: moyzon_ch,moyzon_mu
+#ifdef CPP_PHYS
+      USE callphysiq_mod, ONLY: call_physiq
+#endif 
 
       IMPLICIT NONE
@@ -159,4 +164,6 @@
       REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:)
 
+!      REAL zrot(iip1,jjb_v:jje_v,llm) ! AdlC May 2014
+      REAL :: zrot(iip1,jjm,llm)
       REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:)
       REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
@@ -170,5 +177,5 @@
 !      REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
 c
-      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:), zrfi(:,:)
       REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
       REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
@@ -183,4 +190,5 @@
       REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:) 
       REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zrfi_omp(:,:)
       REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:)
       REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
@@ -216,5 +224,5 @@
 c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zpk_omp,zphi_omp,zphis_omp,
 c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
-c$OMP+                 zqfi_omp,zdufi_omp,zdvfi_omp,
+c$OMP+                 zrfi_omp,zqfi_omp,zdufi_omp,zdvfi_omp,
 c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp,
 c$OMP+                 zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp)       
@@ -244,4 +252,5 @@
       integer :: k,kstart,kend
       INTEGER :: offset  
+      INTEGER :: jjb,jje
 
       LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of
@@ -294,5 +303,5 @@
 !      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
 !      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
-      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
+      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm),zrfi(klon,llm))
       ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
       ALLOCATE(zdpsrf(klon))
@@ -610,5 +619,29 @@
 c$OMP END DO NOWAIT
 
-c   46.champ v:
+c
+C  Alvaro de la Camara (May 2014)
+C  46.1 Calcul de la vorticite et passage sur la grille physique
+C  --------------------------------------------------------------
+
+      jjb=jj_begin_dyn-1
+      jje=jj_end_dyn+1
+      if (is_north_pole) jjb=1
+      if (is_south_pole) jje=jjm
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+
+      DO l=1,llm
+        do i=1,iim
+          do j=jjb,jje
+            zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l)
+     $                   + pucov(i,j+1,l) - pucov(i,j,l))
+     $                   / (cu(i,j)+cu(i,j+1))
+     $                   / (cv(i+1,j)+cv(i,j)) *4
+          enddo
+        enddo
+      ENDDO
+
+
+c   46.2champ v:
 c   -----------
 
@@ -623,4 +656,17 @@
      $                       + pvcov(i,j,l)/cv(i,j) )
     
+          if (j==1 .OR. j==jjp1) then !  AdlC MAY 2014
+            zrfi(ig0,l) = 0 !  AdlC MAY 2014
+          else
+            if(i==1)then
+            zrfi(ig0,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l)
+     $                   +zrot(1,j-1,l)+zrot(1,j,l))   !  AdlC MAY 2014
+            else
+            zrfi(ig0,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l)
+     $                   +zrot(i,j-1,l)+zrot(i,j,l))   !  AdlC MAY 2014
+            endif
+          endif
+
+
          ENDDO
       ENDDO
@@ -648,4 +694,5 @@
            zufi(1,l)  = SSUM(iim,zcos,1)/pi
            zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+           zrfi(1,l)  = 0.
   
         ENDDO
@@ -675,4 +722,5 @@
            zufi(klon,l)  = SSUM(iim,zcos,1)/pi
            zvfi(klon,l)  = SSUM(iim,zsin,1)/pi
+           zrfi(klon,l)  = 0.
         ENDDO
 c$OMP END DO NOWAIT       
@@ -706,4 +754,5 @@
         allocate(zufi_omp(klon,llm))
         allocate(zvfi_omp(klon,llm))
+        allocate(zrfi_omp(klon,llm))  ! LG Ari 2014
         allocate(ztfi_omp(klon,llm))
         allocate(zqfi_omp(klon,llm,nqtot))
@@ -775,4 +824,11 @@
       do l=1,llm
         do i=1,klon
+	  zrfi_omp(i,l)=zrfi(offset+i,l)
+	enddo 
+      enddo
+	
+	
+      do l=1,llm
+        do i=1,klon
 	  ztfi_omp(i,l)=ztfi(offset+i,l)
 	enddo 
@@ -880,115 +936,125 @@
          lafin_split=lafin.and.isplit==nsplit_phys
 
-
-      if (planet_type=="earth") then
-        CALL physiq (klon,
-     .             llm,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev_omp,
-     .             zplay_omp,
-     .             zphi_omp,
-     .             zphis_omp,
-     .             presnivs_omp,
-     .             zufi_omp,
-     .             zvfi_omp,
-     .             ztfi_omp,
-     .             zqfi_omp,
-     .             flxwfi_omp,
-     .             zdufi_omp,
-     .             zdvfi_omp,
-     .             zdtfi_omp,
-     .             zdqfi_omp,
-     .             zdpsrf_omp,
-     .             pducov)
-
-      else if ( planet_type=="generic" ) then
-
-      CALL physiq (klon,     !! ngrid
-     .             llm,            !! nlayer
-     .             nqtot,          !! nq
-     .             tname,          !! tracer names from dynamical core (given in infotrac)
-     .             debut_split,    !! firstcall 
-     .             lafin_split,    !! lastcall
-     .             jD_cur,         !! pday. see leapfrog_p 
-     .             jH_cur_split,   !! ptime "fraction of day"
-     .             zdt_split,      !! ptimestep
-     .             zplev_omp,  !! pplev
-     .             zplay_omp,  !! pplay
-     .             zphi_omp,   !! pphi
-     .             zufi_omp,   !! pu
-     .             zvfi_omp,   !! pv
-     .             ztfi_omp,   !! pt
-     .             zqfi_omp,   !! pq
-     .             flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
-     .             zdufi_omp,  !! pdu
-     .             zdvfi_omp,  !! pdv
-     .             zdtfi_omp,  !! pdt
-     .             zdqfi_omp,  !! pdq
-     .             zdpsrf_omp, !! pdpsrf
-     .             tracerdyn)      !! tracerdyn <-- utilite ???
-
-      else if ( planet_type=="mars" ) then
-
-        CALL physiq (klon,       ! ngrid
-     .             llm,          ! nlayer
-     .             nqtot,        ! nq
-     .             debut_split,  ! firstcall
-     .             lafin_split,  ! lastcall
-     .             jD_cur,       ! pday
-     .             jH_cur_split, ! ptime
-     .             zdt_split,    ! ptimestep
-     .             zplev_omp,    ! pplev
-     .             zplay_omp,    ! pplay
-     .             zphi_omp,     ! pphi
-     .             zufi_omp,     ! pu
-     .             zvfi_omp,     ! pv
-     .             ztfi_omp,     ! pt
-     .             zqfi_omp,     ! pq
-     .             flxwfi_omp,   ! pw
-     .             zdufi_omp,    ! pdu
-     .             zdvfi_omp,    ! pdv
-     .             zdtfi_omp,    ! pdt
-     .             zdqfi_omp,    ! pdq
-     .             zdpsrf_omp,   ! pdpsrf
-     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
-
-      else if ((planet_type=="titan").or.(planet_type=="venus")) then
-
-        CALL physiq (klon,
-     .             llm,
-     .             nqtot,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev_omp,
-     .             zplay_omp,
-     .             zpk_omp,
-     .             zphi_omp,
-     .             zphis_omp,
-     .             presnivs_omp,
-     .             zufi_omp,
-     .             zvfi_omp,
-     .             ztfi_omp,
-     .             zqfi_omp,
-     .             flxwfi_omp,
-     .             zdufi_omp,
-     .             zdvfi_omp,
-     .             zdtfi_omp,
-     .             zdqfi_omp,
-     .             zdpsrf_omp)
-
-      else ! unknown "planet_type"
-
-        write(lunout,*) "calfis_p: error, unknown planet_type: ",
-     &                  trim(planet_type)
-        stop
-
-      endif ! planet_type
+        CALL call_physiq(klon,llm,nqtot,tname,
+     &                   debut_split,lafin_split,
+     &                   jD_cur,jH_cur_split,zdt_split,
+     &                   zplev_omp,zplay_omp,
+     &                   zpk_omp,zphi_omp,zphis_omp,
+     &                   presnivs_omp,
+     &                   zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp,
+     &                   flxwfi_omp,pducov,
+     &                   zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp,
+     &                   zdpsrf_omp,tracerdyn)
+
+!      if (planet_type=="earth") then
+!        CALL physiq (klon,
+!     .             llm,
+!     .             debut_split,
+!     .             lafin_split,
+!     .             jD_cur,
+!     .             jH_cur_split,
+!     .             zdt_split,
+!     .             zplev_omp,
+!     .             zplay_omp,
+!     .             zphi_omp,
+!     .             zphis_omp,
+!     .             presnivs_omp,
+!     .             zufi_omp,
+!     .             zvfi_omp,
+!     .             ztfi_omp,
+!     .             zqfi_omp,
+!     .             flxwfi_omp,
+!     .             zdufi_omp,
+!     .             zdvfi_omp,
+!     .             zdtfi_omp,
+!     .             zdqfi_omp,
+!     .             zdpsrf_omp,
+!     .             pducov)
+!
+!      else if ( planet_type=="generic" ) then
+!
+!      CALL physiq (klon,     !! ngrid
+!     .             llm,            !! nlayer
+!     .             nqtot,          !! nq
+!     .             tname,          !! tracer names from dynamical core (given in infotrac)
+!     .             debut_split,    !! firstcall 
+!     .             lafin_split,    !! lastcall
+!     .             jD_cur,         !! pday. see leapfrog_p 
+!     .             jH_cur_split,   !! ptime "fraction of day"
+!     .             zdt_split,      !! ptimestep
+!     .             zplev_omp,  !! pplev
+!     .             zplay_omp,  !! pplay
+!     .             zphi_omp,   !! pphi
+!     .             zufi_omp,   !! pu
+!     .             zvfi_omp,   !! pv
+!     .             ztfi_omp,   !! pt
+!     .             zqfi_omp,   !! pq
+!     .             flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
+!     .             zdufi_omp,  !! pdu
+!     .             zdvfi_omp,  !! pdv
+!     .             zdtfi_omp,  !! pdt
+!     .             zdqfi_omp,  !! pdq
+!     .             zdpsrf_omp, !! pdpsrf
+!     .             tracerdyn)      !! tracerdyn <-- utilite ???
+!
+!      else if ( planet_type=="mars" ) then
+!
+!        CALL physiq (klon,       ! ngrid
+!     .             llm,          ! nlayer
+!     .             nqtot,        ! nq
+!     .             debut_split,  ! firstcall
+!     .             lafin_split,  ! lastcall
+!     .             jD_cur,       ! pday
+!     .             jH_cur_split, ! ptime
+!     .             zdt_split,    ! ptimestep
+!     .             zplev_omp,    ! pplev
+!     .             zplay_omp,    ! pplay
+!     .             zphi_omp,     ! pphi
+!     .             zufi_omp,     ! pu
+!     .             zvfi_omp,     ! pv
+!     .             ztfi_omp,     ! pt
+!     .             zqfi_omp,     ! pq
+!     .             flxwfi_omp,   ! pw
+!     .             zdufi_omp,    ! pdu
+!     .             zdvfi_omp,    ! pdv
+!     .             zdtfi_omp,    ! pdt
+!     .             zdqfi_omp,    ! pdq
+!     .             zdpsrf_omp,   ! pdpsrf
+!     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
+!
+!      else if ((planet_type=="titan").or.(planet_type=="venus")) then
+!
+!        CALL physiq (klon,
+!     .             llm,
+!     .             nqtot,
+!     .             debut_split,
+!     .             lafin_split,
+!     .             jD_cur,
+!     .             jH_cur_split,
+!     .             zdt_split,
+!     .             zplev_omp,
+!     .             zplay_omp,
+!     .             zpk_omp,
+!     .             zphi_omp,
+!     .             zphis_omp,
+!     .             presnivs_omp,
+!     .             zufi_omp,
+!     .             zvfi_omp,
+!     .             ztfi_omp,
+!     .             zqfi_omp,
+!     .             flxwfi_omp,
+!     .             zdufi_omp,
+!     .             zdvfi_omp,
+!     .             zdtfi_omp,
+!     .             zdqfi_omp,
+!     .             zdpsrf_omp)
+!
+!      else ! unknown "planet_type"
+!
+!        write(lunout,*) "calfis_p: error, unknown planet_type: ",
+!     &                  trim(planet_type)
+!        stop
+!
+!      endif ! planet_type
          zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
          zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
Index: /trunk/LMDZ.COMMON/libf/dynphy_lonlat/phytitan/callphysiq_mod.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynphy_lonlat/phytitan/callphysiq_mod.F90	(revision 1549)
+++ /trunk/LMDZ.COMMON/libf/dynphy_lonlat/phytitan/callphysiq_mod.F90	(revision 1549)
@@ -0,0 +1,99 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE call_physiq(klon,llm,nqtot,tname,                              &
+                       debut_split,lafin_split,                           &
+                       jD_cur,jH_cur_split,zdt_split,                     &
+                       zplev_omp,zplay_omp,                               &
+                       zpk_omp,zphi_omp,zphis_omp,                        &
+                       presnivs_omp,                                      &
+                       zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp,      &
+                       flxwfi_omp,pducov,                                 &
+                       zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp,zdpsrf_omp,&
+                       tracerdyn)
+
+  USE control_mod, ONLY: planet_type
+  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
+  USE physiq_mod, ONLY: physiq
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  CHARACTER(len=*),INTENT(IN) :: tname(nqtot) ! tracer names
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+  REAL,INTENT(IN) :: JD_cur ! Julian day
+  REAL,INTENT(IN) :: JH_cur_split ! Julian hour (fraction of day)
+  REAL,INTENT(IN) :: zdt_split ! time step over which the physics are evaluated
+  REAL,INTENT(IN) :: zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+  REAL,INTENT(IN) :: zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+  REAL,INTENT(IN) :: zpk_omp(klon,llm)
+  REAL,INTENT(IN) :: zphi_omp(klon,llm) ! geopotential at midlayer
+  REAL,INTENT(IN) :: zphis_omp(klon) ! surface geopotential
+  REAL,INTENT(IN) :: presnivs_omp(llm) ! approximate pressure of atm. layers
+  REAL,INTENT(IN) :: zufi_omp(klon,llm) ! zonal wind (m/s)
+  REAL,INTENT(IN) :: zvfi_omp(klon,llm) ! meridional wind (m/s)
+  REAL,INTENT(IN) :: zrfi_omp(klon,llm) ! relative wind vorticity, in s-1
+  REAL,INTENT(IN) :: ztfi_omp(klon,llm) ! temperature (K)
+  REAL,INTENT(IN) :: zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+  REAL,INTENT(IN) :: flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+  REAL,INTENT(IN) :: pducov(nbp_lon+1,nbp_lat,llm) ! dynamical tendency on ucov
+  ! tendencies (in */s) from the physics:
+  REAL,INTENT(OUT) :: zdufi_omp(klon,llm) ! tendency on zonal winds
+  REAL,INTENT(OUT) :: zdvfi_omp(klon,llm) ! tendency on meridional winds
+  REAL,INTENT(OUT) :: zdtfi_omp(klon,llm) ! tendency on temperature
+  REAL,INTENT(OUT) :: zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+  REAL,INTENT(OUT) :: zdpsrf_omp(klon) ! tendency on surface pressure
+  LOGICAL,INTENT(OUT) :: tracerdyn
+
+  ! Local variables
+  CHARACTER(len=11) :: modname="call_physiq"
+  LOGICAL,SAVE :: firstcall=.true.
+!$OMP THREADPRIVATE(firstcall)
+
+! Sanity check on physics package type
+  IF (firstcall) THEN
+    IF (planet_type.ne."titan") THEN
+      CALL abort_gcm(modname,"wrong planet_type for this physics package",1)
+    ENDIF
+    firstcall=.false.
+  ENDIF
+
+
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           &
+              llm,            &
+              nqtot,          &
+              debut_split,    &
+              lafin_split,    &
+              jD_cur,         &
+              jH_cur_split,   &
+              zdt_split,      &
+              zplev_omp,      &
+              zplay_omp,      &
+              zpk_omp,        &
+              zphi_omp,       &
+              zphis_omp,      &
+              presnivs_omp,   &
+              zufi_omp,       &
+              zvfi_omp,       &
+              ztfi_omp,       &
+              zqfi_omp,       &
+              flxwfi_omp,     &
+              zdufi_omp,      &
+              zdvfi_omp,      &
+              zdtfi_omp,      &
+              zdqfi_omp,      &
+              zdpsrf_omp)
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: /trunk/LMDZ.COMMON/libf/dynphy_lonlat/phyvenus/callphysiq_mod.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynphy_lonlat/phyvenus/callphysiq_mod.F90	(revision 1549)
+++ /trunk/LMDZ.COMMON/libf/dynphy_lonlat/phyvenus/callphysiq_mod.F90	(revision 1549)
@@ -0,0 +1,99 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE call_physiq(klon,llm,nqtot,tname,                              &
+                       debut_split,lafin_split,                           &
+                       jD_cur,jH_cur_split,zdt_split,                     &
+                       zplev_omp,zplay_omp,                               &
+                       zpk_omp,zphi_omp,zphis_omp,                        &
+                       presnivs_omp,                                      &
+                       zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp,      &
+                       flxwfi_omp,pducov,                                 &
+                       zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp,zdpsrf_omp,&
+                       tracerdyn)
+
+  USE control_mod, ONLY: planet_type
+  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
+  USE physiq_mod, ONLY: physiq
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  CHARACTER(len=*),INTENT(IN) :: tname(nqtot) ! tracer names
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+  REAL,INTENT(IN) :: JD_cur ! Julian day
+  REAL,INTENT(IN) :: JH_cur_split ! Julian hour (fraction of day)
+  REAL,INTENT(IN) :: zdt_split ! time step over which the physics are evaluated
+  REAL,INTENT(IN) :: zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+  REAL,INTENT(IN) :: zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+  REAL,INTENT(IN) :: zpk_omp(klon,llm)
+  REAL,INTENT(IN) :: zphi_omp(klon,llm) ! geopotential at midlayer
+  REAL,INTENT(IN) :: zphis_omp(klon) ! surface geopotential
+  REAL,INTENT(IN) :: presnivs_omp(llm) ! approximate pressure of atm. layers
+  REAL,INTENT(IN) :: zufi_omp(klon,llm) ! zonal wind (m/s)
+  REAL,INTENT(IN) :: zvfi_omp(klon,llm) ! meridional wind (m/s)
+  REAL,INTENT(IN) :: zrfi_omp(klon,llm) ! relative wind vorticity, in s-1
+  REAL,INTENT(IN) :: ztfi_omp(klon,llm) ! temperature (K)
+  REAL,INTENT(IN) :: zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+  REAL,INTENT(IN) :: flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+  REAL,INTENT(IN) :: pducov(nbp_lon+1,nbp_lat,llm) ! dynamical tendency on ucov
+  ! tendencies (in */s) from the physics:
+  REAL,INTENT(OUT) :: zdufi_omp(klon,llm) ! tendency on zonal winds
+  REAL,INTENT(OUT) :: zdvfi_omp(klon,llm) ! tendency on meridional winds
+  REAL,INTENT(OUT) :: zdtfi_omp(klon,llm) ! tendency on temperature
+  REAL,INTENT(OUT) :: zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+  REAL,INTENT(OUT) :: zdpsrf_omp(klon) ! tendency on surface pressure
+  LOGICAL,INTENT(OUT) :: tracerdyn
+
+  ! Local variables
+  CHARACTER(len=11) :: modname="call_physiq"
+  LOGICAL,SAVE :: firstcall=.true.
+!$OMP THREADPRIVATE(firstcall)
+
+! Sanity check on physics package type
+  IF (firstcall) THEN
+    IF (planet_type.ne."venus") THEN
+      CALL abort_gcm(modname,"wrong planet_type for this physics package",1)
+    ENDIF
+    firstcall=.false.
+  ENDIF
+
+
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           &
+              llm,            &
+              nqtot,          &
+              debut_split,    &
+              lafin_split,    &
+              jD_cur,         &
+              jH_cur_split,   &
+              zdt_split,      &
+              zplev_omp,      &
+              zplay_omp,      &
+              zpk_omp,        &
+              zphi_omp,       &
+              zphis_omp,      &
+              presnivs_omp,   &
+              zufi_omp,       &
+              zvfi_omp,       &
+              ztfi_omp,       &
+              zqfi_omp,       &
+              flxwfi_omp,     &
+              zdufi_omp,      &
+              zdvfi_omp,      &
+              zdtfi_omp,      &
+              zdqfi_omp,      &
+              zdpsrf_omp)
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: /trunk/LMDZ.COMMON/libf/misc/wxios.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/wxios.F90	(revision 1548)
+++ /trunk/LMDZ.COMMON/libf/misc/wxios.F90	(revision 1549)
@@ -191,5 +191,5 @@
                 CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
                 IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
-            CASE('earth_366d')
+            CASE('gregorian')
                 CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
                 IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
Index: /trunk/LMDZ.GENERIC/README
===================================================================
--- /trunk/LMDZ.GENERIC/README	(revision 1548)
+++ /trunk/LMDZ.GENERIC/README	(revision 1549)
@@ -1215,2 +1215,5 @@
   mass flux should be on the physics grid, not the dynamics grid.
   Moreover values at the poles needed to be correctly recomputed.
+
+== 06/05/2016 == EM
+- turn physiq.F90 into module physiq_mod.F90
Index: /trunk/LMDZ.GENERIC/libf/dynphy_lonlat/calfis.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynphy_lonlat/calfis.F	(revision 1548)
+++ /trunk/LMDZ.GENERIC/libf/dynphy_lonlat/calfis.F	(revision 1549)
@@ -9,4 +9,6 @@
       USE comvert_mod, ONLY: preff
       USE comconst_mod, ONLY: dtphys,kappa,cpp,pi
+      USE physiq_mod, ONLY: physiq
+
       IMPLICIT NONE
 c=======================================================================
@@ -130,5 +132,4 @@
       
       EXTERNAL gr_dyn_fi,gr_fi_dyn
-      EXTERNAL physiq,multipl
       REAL SSUM
       EXTERNAL SSUM
Index: /trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/callphysiq_mod.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/callphysiq_mod.F90	(revision 1549)
+++ /trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/callphysiq_mod.F90	(revision 1549)
@@ -0,0 +1,98 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE call_physiq(klon,llm,nqtot,tname,                              &
+                       debut_split,lafin_split,                           &
+                       jD_cur,jH_cur_split,zdt_split,                     &
+                       zplev_omp,zplay_omp,                               &
+                       zpk_omp,zphi_omp,zphis_omp,                        &
+                       presnivs_omp,                                      &
+                       zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp,      &
+                       flxwfi_omp,pducov,                                 &
+                       zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp,zdpsrf_omp,&
+                       tracerdyn)
+
+  USE control_mod, ONLY: planet_type
+  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
+  USE physiq_mod, ONLY: physiq
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  CHARACTER(len=*),INTENT(IN) :: tname(nqtot) ! tracer names
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+  REAL,INTENT(IN) :: JD_cur ! Julian day
+  REAL,INTENT(IN) :: JH_cur_split ! Julian hour (fraction of day)
+  REAL,INTENT(IN) :: zdt_split ! time step over which the physics are evaluated
+  REAL,INTENT(IN) :: zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+  REAL,INTENT(IN) :: zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+  REAL,INTENT(IN) :: zpk_omp(klon,llm)
+  REAL,INTENT(IN) :: zphi_omp(klon,llm) ! geopotential at midlayer
+  REAL,INTENT(IN) :: zphis_omp(klon) ! surface geopotential
+  REAL,INTENT(IN) :: presnivs_omp(llm) ! approximate pressure of atm. layers
+  REAL,INTENT(IN) :: zufi_omp(klon,llm) ! zonal wind (m/s)
+  REAL,INTENT(IN) :: zvfi_omp(klon,llm) ! meridional wind (m/s)
+  REAL,INTENT(IN) :: zrfi_omp(klon,llm) ! relative wind vorticity, in s-1
+  REAL,INTENT(IN) :: ztfi_omp(klon,llm) ! temperature (K)
+  REAL,INTENT(IN) :: zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+  REAL,INTENT(IN) :: flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+  REAL,INTENT(IN) :: pducov(nbp_lon+1,nbp_lat,llm) ! dynamical tendency on ucov
+  ! tendencies (in */s) from the physics:
+  REAL,INTENT(OUT) :: zdufi_omp(klon,llm) ! tendency on zonal winds
+  REAL,INTENT(OUT) :: zdvfi_omp(klon,llm) ! tendency on meridional winds
+  REAL,INTENT(OUT) :: zdtfi_omp(klon,llm) ! tendency on temperature
+  REAL,INTENT(OUT) :: zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+  REAL,INTENT(OUT) :: zdpsrf_omp(klon) ! tendency on surface pressure
+  LOGICAL,INTENT(OUT) :: tracerdyn
+
+  ! Local variables
+  CHARACTER(len=11) :: modname="call_physiq"
+  LOGICAL,SAVE :: firstcall=.true.
+!$OMP THREADPRIVATE(firstcall)
+
+! Sanity check on physics package type
+  IF (firstcall) THEN
+    IF (planet_type.ne."generic") THEN
+      CALL abort_gcm(modname,"wrong planet_type for this physics package",1)
+    ENDIF
+    firstcall=.false.
+  ENDIF
+
+
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           & ! ngrid
+              llm,            & ! nlayer
+              nqtot,          & ! nq
+              tname,          & ! nametrac
+              debut_split,    & ! firstcall
+              lafin_split,    & ! lastcall
+              jD_cur,         & ! pday
+              jH_cur_split,   & ! ptime
+              zdt_split,      & ! ptimestep
+              zplev_omp,      & ! pplev
+              zplay_omp,      & ! pplay
+              zphi_omp,       & ! pphi
+              zufi_omp,       & ! pu
+              zvfi_omp,       & ! pv
+              ztfi_omp,       & ! pt
+              zqfi_omp,       & ! pq
+              flxwfi_omp,     & ! flxw
+              zdufi_omp,      & ! pdu
+              zdvfi_omp,      & ! pdv
+              zdtfi_omp,      & ! pdt
+              zdqfi_omp,      & ! pdq
+              zdpsrf_omp,     & ! pdpsrf
+              tracerdyn)        ! tracerdyn (somewhat obsolete)
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F	(revision 1548)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F	(revision 1549)
@@ -32,4 +32,5 @@
       use mod_interface_dyn_phys, only: init_interface_dyn_phys
       use inifis_mod, only: inifis
+      use physiq_mod, only: physiq
       implicit none
 
@@ -96,5 +97,5 @@
       REAL du(llm),dv(llm),dtemp(llm)
       REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
-      REAL dpsurf    
+      REAL dpsurf(1)    
       REAL,ALLOCATABLE :: dq(:,:)
       REAL,ALLOCATABLE :: dqdyn(:,:)
@@ -949,5 +950,5 @@
 c       ----------------------------------------------------------
 
-           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           psurf=psurf+dtphys*dpsurf(1)   ! evolution de la pression de surface
            DO ilevel=1,nlevel
               plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
Index: unk/LMDZ.GENERIC/libf/phystd/physiq.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/physiq.F90	(revision 1548)
+++ 	(revision )
@@ -1,2133 +1,0 @@
-      subroutine physiq(ngrid,nlayer,nq,   &
-                  nametrac,                & 
-                  firstcall,lastcall,      &
-                  pday,ptime,ptimestep,    &
-                  pplev,pplay,pphi,        &
-                  pu,pv,pt,pq,             &
-                  flxw,                    &
-                  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, glat, grav, BWNV
-      use radii_mod, only: h2o_reffrad, co2_reffrad
-      use aerosol_mod, only: iaero_co2, iaero_h2o
-      use surfdat_h, only: phisfi, zmea, zstd, zsig, zgam, zthe, &
-                           dryness, watercaptag
-      use comdiurn_h, only: coslat, sinlat, coslon, sinlon
-      use comsaison_h, only: mu0, fract, dist_star, declin, right_ascen
-      use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat
-      use geometry_mod, only: latitude, longitude, cell_area
-      USE comgeomfi_h, only: 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 time_phylmdz_mod, only: ecritphy, iphysiq, nday
-      use phyredem, only: physdem0, physdem1
-      use slab_ice_h, only: capcalocean, capcalseaice,capcalsno, &
-                            noceanmx
-      use ocean_slab_mod, only :ocean_slab_init, ocean_slab_ice, &
-                                ini_surf_heat_transp_mod, &
-                                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
-      use planete_mod, only: apoastr, periastr, year_day, peri_day, &
-                            obliquit, nres, z0
-      use comcstfi_mod, only: pi, g, rcp, r, rad, mugaz, cpp
-      use time_phylmdz_mod, only: daysec
-      use callkeys_mod
-      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:
-!
-!      I. Initialization :
-!         I.1 Firstcall initializations.
-!         I.2 Initialization for every call to physiq.
-!
-!      II. Compute radiative transfer tendencies (longwave and shortwave) :
-!         II.a Option 1 : Call correlated-k radiative transfer scheme.
-!         II.b Option 2 : Call Newtonian cooling scheme.
-!         II.c Option 3 : Atmosphere has no radiative effect.
-!
-!      III. Vertical diffusion (turbulent mixing) :
-!
-!      IV. Dry Convective adjustment :
-!
-!      V. Condensation and sublimation of gases (currently just CO2).
-!
-!      VI. Tracers
-!         VI.1. Water and water ice.
-!         VI.2. Aerosols and particles.
-!         VI.3. Updates (pressure variations, surface budget).
-!         VI.4. Slab Ocean.
-!         VI.5. Surface Tracer Update.
-!
-!      VII. Surface and sub-surface soil temperature.
-!
-!      VIII. Perform diagnostics and write output files.
-!
-!
-!   arguments
-!   ---------
-!
-!   INPUT
-!   -----
-!
-!    ngrid                 Size of the horizontal grid.
-!    nlayer                Number of vertical layers.
-!    nq                    Number of advected fields.
-!    nametrac              Name of corresponding 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 (m2.s-2).
-!
-!    pu(ngrid,nlayer)      u, zonal component of the wind (ms-1).
-!    pv(ngrid,nlayer)      v, meridional 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) /
-!    flxw(ngrid,nlayer)      vertical mass flux (kg/s) at layer lower boundary
-!
-!   OUTPUT
-!   ------
-!
-!    pdu(ngrid,nlayer)        \
-!    pdv(ngrid,nlayer)         \  Temporal derivative of the corresponding
-!    pdt(ngrid,nlayer)         /  variables due to physical processes.
-!    pdq(ngrid,nlayer)        /
-!    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)
-!           Purge of the code : M. Turbet (2015)
-!==================================================================
-
-
-!    0.  Declarations :
-!    ------------------
-
-#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) ! Names of the tracers taken 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/kg_of_air).
-      real,intent(in) :: flxw(ngrid,nlayer)    ! Vertical mass flux (ks/s) at lower boundary of layer
-
-!   OUTPUTS:
-!   --------
-
-!     Physical tendencies :
-
-      real,intent(out) :: pdu(ngrid,nlayer)    ! Zonal wind tendencies (m/s/s).
-      real,intent(out) :: pdv(ngrid,nlayer)    ! Meridional wind tendencies (m/s/s).
-      real,intent(out) :: pdt(ngrid,nlayer)    ! Temperature tendencies (K/s).
-      real,intent(out) :: pdq(ngrid,nlayer,nq) ! Tracer tendencies (kg/kg_of_air/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:
-! ----------------------
-
-      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 Spectral albedo. By MT2015.
-      real, dimension(:),allocatable,save :: albedo_equivalent     ! Spectral Mean albedo.
-      real, dimension(:),allocatable,save :: albedo_snow_SPECTV    ! Snow Spectral albedo.
-      real, dimension(:),allocatable,save :: albedo_co2_ice_SPECTV ! CO2 ice Spectral albedo.
-      
-!$OMP THREADPRIVATE(tsurf,tsoil,albedo,albedo_equivalent,albedo_snow_SPECTV,albedo_co2_ice_SPECTV)
-
-      real,dimension(:),allocatable,save :: albedo_bareground ! Bare Ground Albedo. By MT 2015.
-      real,dimension(:),allocatable,save :: rnat              ! Defines the type of the grid (ocean,continent,...). By BC.
-      
-!$OMP THREADPRIVATE(albedo_bareground,rnat)
-
-      real,dimension(:),allocatable,save :: emis        ! Thermal IR surface emissivity.
-      real,dimension(:,:),allocatable,save :: dtrad     ! Net atmospheric radiative heating rate (K.s-1).
-      real,dimension(:),allocatable,save :: fluxrad_sky ! Radiative 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.
-      
-!$OMP THREADPRIVATE(emis,dtrad,fluxrad_sky,fluxrad,capcal,fluxgrd,qsurf,q2)
-
-      save day_ini, icount
-      
-!$OMP THREADPRIVATE(day_ini,icount)
-
-! Local variables :
-! -----------------
-
-!     Aerosol (dust or ice) extinction optical depth  at reference wavelength 
-!     for the "naerkind" optically active aerosols:
-
-      real aerosol(ngrid,nlayer,naerkind) ! Aerosols.
-      real zh(ngrid,nlayer)               ! Potential temperature (K).
-      real pw(ngrid,nlayer)               ! Vertical velocity (m/s). (NOTE : >0 WHEN DOWNWARDS !!)
-
-      integer l,ig,ierr,iq,nw
-      
-      ! FOR DIAGNOSTIC :
-      
-      real,dimension(:),allocatable,save :: fluxsurf_lw     ! Incident Long Wave (IR) surface flux (W.m-2).
-      real,dimension(:),allocatable,save :: fluxsurf_sw     ! Incident Short Wave (stellar) surface flux (W.m-2).
-      real,dimension(:),allocatable,save :: fluxsurfabs_sw  ! Absorbed Short Wave (stellar) flux by the surface (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      ! Incoming SW (stellar) radiation at the top of the atmosphere (W.m-2).
-      real,dimension(:),allocatable,save :: fluxdyn         ! Horizontal heat transport by dynamics (W.m-2).
-      real,dimension(:,:),allocatable,save :: OLR_nu        ! Outgoing LW radiation in each band (Normalized to the band width (W/m2/cm-1)).
-      real,dimension(:,:),allocatable,save :: OSR_nu        ! Outgoing SW radiation in each band (Normalized to the band width (W/m2/cm-1)).
-      real,dimension(:,:),allocatable,save :: zdtlw         ! LW heating tendencies (K/s).
-      real,dimension(:,:),allocatable,save :: zdtsw         ! SW heating tendencies (K/s).
-      real,dimension(:),allocatable,save :: sensibFlux      ! Turbulent flux given by the atmosphere to the surface (W.m-2).
-      
-!$OMP THREADPRIVATE(fluxsurf_lw,fluxsurf_sw,fluxsurfabs_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn,OLR_nu,OSR_nu,&
-        
-        !$OMP zdtlw,zdtsw,sensibFlux)
-
-      real zls                       ! Solar longitude (radians).
-      real zlss                      ! Sub solar point longitude (radians).
-      real zday                      ! Date (time since Ls=0, calculated in sols).
-      real zzlay(ngrid,nlayer)       ! Altitude at the middle of the atmospheric layers.
-      real zzlev(ngrid,nlayer+1)     ! Altitude at the atmospheric layer boundaries.
-
-! TENDENCIES due to various processes :
-
-      ! For Surface Temperature : (K/s)
-      real zdtsurf(ngrid)     ! Cumulated tendencies.
-      real zdtsurfmr(ngrid)   ! Mass_redistribution routine.
-      real zdtsurfc(ngrid)    ! Condense_co2 routine.
-      real zdtsdif(ngrid)     ! Turbdiff/vdifc routines.
-      real zdtsurf_hyd(ngrid) ! Hydrol routine.
-            
-      ! For Atmospheric Temperatures : (K/s)    
-      real dtlscale(ngrid,nlayer)                             ! Largescale routine.
-      real zdtc(ngrid,nlayer)                                 ! Condense_co2 routine.
-      real zdtdif(ngrid,nlayer)                                      ! Turbdiff/vdifc routines.
-      real zdtmr(ngrid,nlayer)                                ! Mass_redistribution routine.
-      real zdtrain(ngrid,nlayer)                              ! Rain routine.
-      real dtmoist(ngrid,nlayer)                              ! Moistadj routine.
-      real dt_ekman(ngrid,noceanmx), dt_hdiff(ngrid,noceanmx) ! Slab_ocean routine.
-      real zdtsw1(ngrid,nlayer), zdtlw1(ngrid,nlayer)         ! Callcorrk routine.
-                              
-      ! For Surface Tracers : (kg/m2/s)
-      real dqsurf(ngrid,nq)                 ! Cumulated tendencies.
-      real zdqsurfc(ngrid)                  ! Condense_co2 routine.
-      real zdqsdif(ngrid,nq)                ! Turbdiff/vdifc routines.
-      real zdqssed(ngrid,nq)                ! Callsedim routine.
-      real zdqsurfmr(ngrid,nq)              ! Mass_redistribution routine.
-      real zdqsrain(ngrid), zdqssnow(ngrid) ! Rain routine.
-      real dqs_hyd(ngrid,nq)                ! Hydrol routine.
-                  
-      ! For Tracers : (kg/kg_of_air/s)
-      real zdqc(ngrid,nlayer,nq)      ! Condense_co2 routine.
-      real zdqadj(ngrid,nlayer,nq)    ! Convadj routine.
-      real zdqdif(ngrid,nlayer,nq)    ! Turbdiff/vdifc routines.
-      real zdqevap(ngrid,nlayer)      ! Turbdiff routine.
-      real zdqsed(ngrid,nlayer,nq)    ! Callsedim routine.
-      real zdqmr(ngrid,nlayer,nq)     ! Mass_redistribution routine.
-      real zdqrain(ngrid,nlayer,nq)   ! Rain routine.
-      real dqmoist(ngrid,nlayer,nq)   ! Moistadj routine.
-      real dqvaplscale(ngrid,nlayer)  ! Largescale routine.
-      real dqcldlscale(ngrid,nlayer)  ! Largescale routine.
-                        
-      ! For Winds : (m/s/s)
-      real zdvadj(ngrid,nlayer),zduadj(ngrid,nlayer) ! Convadj routine.
-      real zdumr(ngrid,nlayer),zdvmr(ngrid,nlayer)   ! Mass_redistribution routine.
-      real zdvdif(ngrid,nlayer),zdudif(ngrid,nlayer) ! Turbdiff/vdifc routines.
-      real zdhdif(ngrid,nlayer)                      ! Turbdiff/vdifc routines.
-      real zdhadj(ngrid,nlayer)                      ! Convadj routine.
-     
-      ! For Pressure and Mass :
-      real zdmassmr(ngrid,nlayer) ! Atmospheric Mass tendency for mass_redistribution (kg_of_air/m2/s).
-      real zdmassmr_col(ngrid)    ! Atmospheric Column Mass tendency for mass_redistribution (kg_of_air/m2/s).
-      real zdpsrfmr(ngrid)        ! Pressure tendency for mass_redistribution routine (Pa/s).
-
-      
-    
-! Local variables for LOCAL CALCULATIONS:
-! ---------------------------------------
-      real zflubid(ngrid)
-      real zplanck(ngrid),zpopsk(ngrid,nlayer)
-      real ztim1,ztim2,ztim3, z1,z2
-      real ztime_fin
-      real zdh(ngrid,nlayer)
-      real gmplanet
-      real taux(ngrid),tauy(ngrid)
-
-
-! local variables for DIAGNOSTICS : (diagfi & stat)
-! -------------------------------------------------
-      real ps(ngrid)                                     ! Surface Pressure.
-      real zt(ngrid,nlayer)                              ! Atmospheric Temperature.
-      real zu(ngrid,nlayer),zv(ngrid,nlayer)             ! Zonal and Meridional Winds.
-      real zq(ngrid,nlayer,nq)                           ! Atmospheric Tracers.
-      real zdtadj(ngrid,nlayer)                          ! Convadj Diagnostic.
-      real zdtdyn(ngrid,nlayer)                          ! Dynamical Heating (K/s).
-      real,allocatable,dimension(:,:),save :: ztprevious ! Previous loop Atmospheric Temperature (K)                                                         ! Useful for Dynamical Heating calculation.
-!$OMP THREADPRIVATE(ztprevious)
-
-      real reff(ngrid,nlayer)                       ! Effective dust radius (used if doubleq=T).
-      real vmr(ngrid,nlayer)                        ! volume mixing ratio
-      real time_phys
-      real,allocatable,dimension(:),save :: tau_col ! Total Aerosol Optical Depth.
-!$OMP THREADPRIVATE(tau_col)
-      
-      real ISR,ASR,OLR,GND,DYN,GSR,Ts1,Ts2,Ts3,TsS ! for Diagnostic.
-      
-      real qcol(ngrid,nq) ! Tracer Column Mass (kg/m2).
-
-!     included by RW for H2O Manabe scheme
-      real rneb_man(ngrid,nlayer) ! H2O cloud fraction (moistadj).
-      real rneb_lsc(ngrid,nlayer) ! H2O cloud fraction (large scale).
-
-
-!     to test energy conservation (RW+JL)
-      real mass(ngrid,nlayer),massarea(ngrid,nlayer)
-      real dEtot, dEtots, AtmToSurf_TurbFlux
-      real,save :: dEtotSW, dEtotsSW, dEtotLW, dEtotsLW
-!$OMP THREADPRIVATE(dEtotSW, dEtotsSW, dEtotLW, dEtotsLW)
-      real dEzRadsw(ngrid,nlayer),dEzRadlw(ngrid,nlayer),dEzdiff(ngrid,nlayer)
-      real dEdiffs(ngrid),dEdiff(ngrid)
-      real madjdE(ngrid), lscaledE(ngrid),madjdEz(ngrid,nlayer), lscaledEz(ngrid,nlayer)
-      
-!JL12 conservation test for mean flow kinetic energy has been disabled temporarily
-
-      real dtmoist_max,dtmoist_min     
-      real dItot, dItot_tmp, dVtot, dVtot_tmp
-
-      real,allocatable,save :: hice(:) ! Oceanic Ice height. by BC
- !$OMP THREADPRIVATE(hice)     
-
-      real h2otot                      ! Total Amount of water. For diagnostic.
-      real icesrf,liqsrf,icecol,vapcol ! Total Amounts of water (ice,liq,vap). For diagnostic.
-      real dWtot, dWtot_tmp, dWtots, dWtots_tmp
-      logical,save :: watertest
-!$OMP THREADPRIVATE(watertest)
-
-      real qsat(ngrid,nlayer) ! Water Vapor Volume Mixing Ratio at saturation (kg/kg_of_air).
-      real RH(ngrid,nlayer)   ! Relative humidity.
-      real H2Omaxcol(ngrid)   ! Maximum possible H2O column amount (at 100% saturation) (kg/m2).
-      real psat_tmp
-      
-      logical clearsky ! For double radiative transfer call. By BC
-      
-      ! For Clear Sky Case.
-      real fluxsurf_lw1(ngrid), fluxsurf_sw1(ngrid), fluxsurfabs_sw1(ngrid)  ! For SW/LW flux.
-      real fluxtop_lw1(ngrid), fluxabs_sw1(ngrid)                            ! For SW/LW flux.
-      real albedo_equivalent1(ngrid)                                         ! For Equivalent albedo calculation.
-      real tau_col1(ngrid)                                                   ! For aerosol optical depth diagnostic.
-      real OLR_nu1(ngrid,L_NSPECTI), OSR_nu1(ngrid,L_NSPECTV)                ! For Outgoing Radiation diagnostics.
-      real tf, ntf
-
-      real,allocatable,dimension(:,:),save :: cloudfrac  ! Fraction of clouds (%).
-      real,allocatable,dimension(:),save :: totcloudfrac ! Column fraction of clouds (%).
-!$OMP THREADPRIVATE(cloudfrac,totcloudfrac)
-
-      real nconsMAX, vdifcncons(ngrid), cadjncons(ngrid) ! Vdfic water conservation test. By RW
-
-      real,allocatable,dimension(:,:),save :: qsurf_hist
-!$OMP THREADPRIVATE(qsurf_hist)
-
-      real muvar(ngrid,nlayer+1) ! For Runaway Greenhouse 1D study. By RW
-
-      real,allocatable,dimension(:,:,:),save :: reffrad  ! Aerosol effective radius (m). By RW
-      real,allocatable,dimension(:,:,:),save :: nueffrad ! Aerosol effective radius variance. By RW
-!$OMP THREADPRIVATE(reffrad,nueffrad)
-
-      real reffcol(ngrid,naerkind)
-
-!     Sourceevol for 'accelerated ice evolution'. By RW
-      real,allocatable,dimension(:),save :: ice_initial
-      real delta_ice,ice_tot
-      real,allocatable,dimension(:),save :: ice_min      
-      integer num_run
-      logical,save :: ice_update
-!$OMP THREADPRIVATE(ice_initial,ice_min,ice_update)
-
-!     For slab ocean. By BC
-      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 
-!$OMP THREADPRIVATE(pctsrf_sic,tslab,tsea_ice,sea_ice,zmasq,knindex)
-
-      real :: tsurf2(ngrid)
-      real :: flux_o(ngrid),flux_g(ngrid),fluxgrdocean(ngrid)
-      real :: flux_sens_lat(ngrid)
-      real :: qsurfint(ngrid,nq)
-
-
-!==================================================================================================
-
-! -----------------
-! I. INITIALISATION
-! -----------------
-
-! --------------------------------
-! I.1   First Call Initialisation.
-! --------------------------------
-      if (firstcall) then
-
-        ! Allocate saved arrays.
-        ALLOCATE(tsurf(ngrid))
-        ALLOCATE(tsoil(ngrid,nsoilmx))    
-        ALLOCATE(albedo(ngrid,L_NSPECTV))
-         ALLOCATE(albedo_equivalent(ngrid))        
-         ALLOCATE(albedo_snow_SPECTV(L_NSPECTV))
-         ALLOCATE(albedo_co2_ice_SPECTV(L_NSPECTV))
-         ALLOCATE(albedo_bareground(ngrid))           
-        ALLOCATE(rnat(ngrid))         
-        ALLOCATE(emis(ngrid))   
-        ALLOCATE(dtrad(ngrid,nlayer))
-        ALLOCATE(fluxrad_sky(ngrid))
-        ALLOCATE(fluxrad(ngrid))    
-        ALLOCATE(capcal(ngrid))    
-        ALLOCATE(fluxgrd(ngrid))  
-        ALLOCATE(qsurf(ngrid,nq))  
-        ALLOCATE(q2(ngrid,nlayer+1)) 
-        ALLOCATE(ztprevious(ngrid,nlayer))
-        ALLOCATE(cloudfrac(ngrid,nlayer))
-        ALLOCATE(totcloudfrac(ngrid))
-        ALLOCATE(hice(ngrid))
-        ALLOCATE(qsurf_hist(ngrid,nq))
-        ALLOCATE(reffrad(ngrid,nlayer,naerkind))
-        ALLOCATE(nueffrad(ngrid,nlayer,naerkind))
-        ALLOCATE(ice_initial(ngrid))
-        ALLOCATE(ice_min(ngrid)) 
-        ALLOCATE(fluxsurf_lw(ngrid))
-        ALLOCATE(fluxsurf_sw(ngrid))
-        ALLOCATE(fluxsurfabs_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,nlayer))
-        ALLOCATE(zdtsw(ngrid,nlayer))
-        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))
-
-        ! This is defined in comsaison_h
-        ALLOCATE(mu0(ngrid))
-        ALLOCATE(fract(ngrid))            
-         ! This is defined in radcommon_h
-        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
-
-
-!        Read 'startfi.nc' file.
-!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         call phyetat0(ngrid,nlayer,"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 calculation. 
-!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         albedo(:,:)=0.0
-          albedo_bareground(:)=0.0
-          albedo_snow_SPECTV(:)=0.0
-          albedo_co2_ice_SPECTV(:)=0.0
-         call surfini(ngrid,nq,qsurf,albedo,albedo_bareground,albedo_snow_SPECTV,albedo_co2_ice_SPECTV) 
-         
-!        Initialize orbital calculation. 
-!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         call iniorbit(apoastr,periastr,year_day,peri_day,obliquit)
-
-
-         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)
-
-           call ini_surf_heat_transp_mod()
-           
-           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(ngrid,zmasq)
-
-         endif ! end of 'ok_slab_ocean'.
-
-
-!        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 ! end of 'ok_slab_ocean'.
-
-         else ! else of 'callsoil'.
-         
-            print*,'WARNING! Thermal conduction in the soil turned off'
-            capcal(:)=1.e6
-            fluxgrd(:)=intheat
-            print*,'Flux from ground = ',intheat,' W m^-2'
-            
-         endif ! end of 'callsoil'.
-         
-         icount=1
-
-!        Decide whether to update ice at end of run.
-!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         ice_update=.false.
-         if(sourceevol)then
-!$OMP MASTER
-            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)
-!$OMP END MASTER
-!$OMP BARRIER
-        
-            if(num_run.ne.0.and.mod(num_run,2).eq.0)then
-               print*,'Updating ice at end of this year!'
-               ice_update=.true.
-               ice_min(:)=1.e4
-            endif
-            
-         endif ! end of 'sourceevol'.
-
-
-         ! Here is defined the type of the surface : Continent or Ocean.
-         ! BC2014 : This is now already done in newstart.
-         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         if (.not.ok_slab_ocean) then
-         
-           rnat(:)=1.
-           do ig=1,ngrid
-              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 ! end of 'ok_slab_ocean'.
-
-
-!        Initialize surface history variable.
-!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         qsurf_hist(:,:)=qsurf(:,:)
-
-!        Initialize 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          
-            call system('rm -f rad_bal.out') ! to record global radiative balance.           
-            call system('rm -f tem_bal.out') ! to record global mean/max/min temperatures.            
-            call system('rm -f h2o_bal.out') ! to record global hydrological balance.
-         endif
-
-
-         watertest=.false.        
-         if(water)then ! Initialize 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 ! Note : no need to create a restart file in 1d.
-            call physdem0("restartfi.nc",longitude,latitude,nsoilmx,ngrid,nlayer,nq, &
-                          ptimestep,pday+nday,time_phys,cell_area,          &
-                          albedo_bareground,inertiedat,zmea,zstd,zsig,zgam,zthe)
-         endif
-         
-               
-      endif ! end of 'firstcall'
-
-! ------------------------------------------------------
-! I.2   Initializations done at every physical timestep:
-! ------------------------------------------------------
-
-      ! Initialize various variables
-      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      
-      if ( .not.nearco2cond ) then
-         pdt(1:ngrid,1:nlayer) = 0.0
-      endif      
-      zdtsurf(1:ngrid)      = 0.0
-      pdq(1:ngrid,1:nlayer,1:nq) = 0.0
-      dqsurf(1:ngrid,1:nq)= 0.0
-      pdu(1:ngrid,1:nlayer) = 0.0
-      pdv(1:ngrid,1:nlayer) = 0.0
-      pdpsrf(1:ngrid)       = 0.0
-      zflubid(1:ngrid)      = 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), and orbital parameters.
-      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      if (season) then
-         call stellarlong(zday,zls)
-      else
-         call stellarlong(float(day_ini),zls)
-      end if
-
-      call orbite(zls,dist_star,declin,right_ascen)
-      
-      if (tlocked) then
-              zlss=Mod(-(2.*pi*(zday/year_day)*nres - right_ascen),2.*pi)
-      elseif (diurnal) then
-              zlss=-2.*pi*(zday-.5)
-      else if(diurnal .eqv. .false.) then
-              zlss=9999.
-      endif 
-
-
-      ! 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. - latitude(ig)))) 
-         end do
-      endif
-
-      ! Compute geopotential between layers.
-      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      zzlay(1:ngrid,1:nlayer)=pphi(1:ngrid,1:nlayer)
-      do l=1,nlayer         
-         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     
-
-      ! Compute potential temperature
-      ! Note : Potential temperature calculation may not be the same in physiq and dynamic...
-      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      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)*cell_area(ig)
-         enddo
-      enddo
-
-     ! Compute vertical velocity (m/s) from vertical mass flux
-     ! w = F / (rho*area) and rho = P/(r*T)
-     ! But first linearly interpolate mass flux to mid-layers
-      do l=1,nlayer-1
-         pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
-      enddo
-      pw(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
-      do l=1,nlayer
-         pw(1:ngrid,l)=(pw(1:ngrid,l)*r*pt(1:ngrid,l)) /  &
-                       (pplay(1:ngrid,l)*cell_area(1:ngrid))
-      enddo
-
-!---------------------------------
-! II. Compute radiative tendencies
-!---------------------------------
-
-      if (callrad) then
-         if( mod(icount-1,iradia).eq.0.or.lastcall) then
-
-          ! Compute local stellar zenith angles
-          ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-            if (tlocked) then
-            ! JL14 corrects tidally resonant (and inclined) cases. nres=omega_rot/omega_orb
-               ztim1=SIN(declin)
-               ztim2=COS(declin)*COS(zlss)
-               ztim3=COS(declin)*SIN(zlss)
-
-               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,latitude,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
-                call call_rings(ngrid, ptime, pday, diurnal)
-            endif    
-
-
-            if (corrk) then
-            
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! II.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:nlayer)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,1:nlayer,igcm_h2o_vap)) 
-                  muvar(1:ngrid,nlayer+1)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,nlayer,igcm_h2o_vap)) 
-                  ! take into account water effect on mean molecular weight
-               else
-                  muvar(1:ngrid,1:nlayer+1)=mugaz
-               endif 
-      
-
-               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)
-                
-               ! standard callcorrk
-               clearsky=.false.
-               call callcorrk(ngrid,nlayer,pq,nq,qsurf,                           &
-                              albedo,albedo_equivalent,emis,mu0,pplev,pplay,pt,   &
-                              tsurf,fract,dist_star,aerosol,muvar,                &
-                              zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,                &
-                              fluxsurfabs_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,albedo_equivalent1,emis,mu0,pplev,pplay,pt,   &
-                                 tsurf,fract,dist_star,aerosol,muvar,                &
-                                 zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,            &
-                                 fluxsurfabs_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)
-                     albedo_equivalent(ig) = ntf*albedo_equivalent1(ig) + tf*albedo_equivalent(ig)
-                     fluxsurfabs_sw(ig)    = ntf*fluxsurfabs_sw1(ig)    + tf*fluxsurfabs_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:nlayer) = ntf*zdtlw1(ig,1:nlayer) + tf*zdtlw(ig,1:nlayer)
-                     zdtsw(ig,1:nlayer) = ntf*zdtsw1(ig,1:nlayer) + tf*zdtsw(ig,1:nlayer)
-
-                     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 ! end of CLFvarying.
-
-               if(ok_slab_ocean) then
-                  tsurf(:)=tsurf2(:)
-               endif
-
-
-               ! 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)+fluxsurfabs_sw(1:ngrid)
-
-                            !if(noradsurf)then ! no lower surface; SW flux just disappears
-                            !   GSR = SUM(fluxsurf_sw(1:ngrid)*cell_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:nlayer)=zdtsw(1:ngrid,1:nlayer)+zdtlw(1:ngrid,1:nlayer)
-               
-               ! Late initialization of the Ice Spectral Albedo. We needed the visible bands to do that ! 
-               if (firstcall .and. albedo_spectral_mode) then
-                  call spectral_albedo_calc(albedo_snow_SPECTV)
-               endif
-
-            elseif(newtonian)then
-            
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! II.b Call Newtonian cooling scheme
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-               call newtrelax(ngrid,nlayer,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
-            
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! II.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)
-               print*,'------------WARNING---WARNING------------' ! by MT2015.
-               print*,'You are in corrk=false mode, '
-               print*,'and the surface albedo is taken equal to the first visible spectral value'               
-               
-               fluxsurfabs_sw(1:ngrid) = fluxtop_dn(1:ngrid)*(1.-albedo(1:ngrid,1))
-               fluxrad_sky(1:ngrid)    = fluxsurfabs_sw(1:ngrid)
-               fluxtop_lw(1:ngrid)  = emis(1:ngrid)*sigma*tsurf(1:ngrid)**4
-
-               dtrad(1:ngrid,1:nlayer)=0.0 ! no atmospheric radiative heating
-
-            endif ! end of 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:nlayer)=pdt(1:ngrid,1:nlayer)+dtrad(1:ngrid,1:nlayer)
-         
-         ! Test of 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_equivalent(:))*cell_area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk
-            call planetwide_sumval(fluxsurfabs_sw(:)*cell_area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk
-            call planetwide_sumval((fluxsurf_lw(:)*emis(:)-zplanck(:))*cell_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 ! end of 'enertest'
-
-      endif ! of if (callrad)
-
-
-
-!  --------------------------------------------
-!  III. Vertical diffusion (turbulent mixing) :
-!  --------------------------------------------
-
-      if (calldifv) then
-      
-         zflubid(1:ngrid)=fluxrad(1:ngrid)+fluxgrd(1:ngrid)
-
-         ! 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,   &
-                          pdt,pdq,zflubid,                       &
-                          zdudif,zdvdif,zdtdif,zdtsdif,          &
-                          sensibFlux,q2,zdqdif,zdqevap,zdqsdif,  &
-                          taux,tauy,lastcall)
-
-         else
-         
-            zdh(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer)
- 
-            call vdifc(ngrid,nlayer,nq,rnat,zpopsk,           &
-                       ptimestep,capcal,lwrite,               &
-                       pplay,pplev,zzlay,zzlev,z0,            &
-                       pu,pv,zh,pq,tsurf,emis,qsurf,          &
-                       zdh,pdq,zflubid,                       &
-                       zdudif,zdvdif,zdhdif,zdtsdif,          &
-                       sensibFlux,q2,zdqdif,zdqsdif,          &
-                       taux,tauy,lastcall)
-
-            zdtdif(1:ngrid,1:nlayer)=zdhdif(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only
-            zdqevap(1:ngrid,1:nlayer)=0.
-
-         end if !end of 'UseTurbDiff'
-
-
-         pdv(1:ngrid,1:nlayer)=pdv(1:ngrid,1:nlayer)+zdvdif(1:ngrid,1:nlayer)
-         pdu(1:ngrid,1:nlayer)=pdu(1:ngrid,1:nlayer)+zdudif(1:ngrid,1:nlayer)
-         pdt(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)+zdtdif(1:ngrid,1:nlayer)
-         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:nlayer,1:nq)=pdq(1:ngrid,1:nlayer,1:nq)+ zdqdif(1:ngrid,1:nlayer,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(:)*cell_area(:)/totarea_planet,dEtot)
-            dEdiffs(:)=capcal(:)*zdtsdif(:)-zflubid(:)-sensibFlux(:)
-            call planetwide_sumval(dEdiffs(:)*cell_area(:)/totarea_planet,dEtots)
-            call planetwide_sumval(sensibFlux(:)*cell_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 ! end of '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 ! end of 'enertest'
-
-
-         ! 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)*cell_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)*cell_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 ! end of 'watertest'
-         !-------------------------
-
-      else ! calldifv
-
-         if(.not.newtonian)then
-
-            zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + (fluxrad(1:ngrid) + fluxgrd(1:ngrid))/capcal(1:ngrid)
-
-         endif
-
-      endif ! end of 'calldifv'
-
-
-!----------------------------------
-!   IV. Dry convective adjustment :
-!----------------------------------
-
-      if(calladj) then
-
-         zdh(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer)
-         zduadj(1:ngrid,1:nlayer)=0.0
-         zdvadj(1:ngrid,1:nlayer)=0.0
-         zdhadj(1:ngrid,1:nlayer)=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:nlayer) = pdu(1:ngrid,1:nlayer) + zduadj(1:ngrid,1:nlayer)
-         pdv(1:ngrid,1:nlayer) = pdv(1:ngrid,1:nlayer) + zdvadj(1:ngrid,1:nlayer)
-         pdt(1:ngrid,1:nlayer)    = pdt(1:ngrid,1:nlayer) + zdhadj(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer)
-         zdtadj(1:ngrid,1:nlayer) = zdhadj(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only
-
-         if(tracer) then 
-            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqadj(1:ngrid,1:nlayer,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 ! end of 'watertest'
-         
-      endif ! end of 'calladj'
-
-!-----------------------------------------------
-!   V. 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_co2(ngrid,nlayer,nq,ptimestep,                    &
-                           capcal,pplay,pplev,tsurf,pt,                  &
-                           pdt,zdtsurf,pq,pdq,                           &
-                           qsurf,zdqsurfc,albedo,emis,                   &
-                           albedo_bareground,albedo_co2_ice_SPECTV,      &
-                           zdtc,zdtsurfc,pdpsrf,zdqc)
-
-         pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtc(1:ngrid,1:nlayer)
-         zdtsurf(1:ngrid)      = zdtsurf(1:ngrid) + zdtsurfc(1:ngrid)
-
-         pdq(1:ngrid,1:nlayer,1:nq)   = pdq(1:ngrid,1:nlayer,1:nq)+ zdqc(1:ngrid,1:nlayer,1:nq)
-         dqsurf(1:ngrid,igcm_co2_ice) = dqsurf(1:ngrid,igcm_co2_ice) + zdqsurfc(1:ngrid)
-
-         ! test energy conservation
-         if(enertest)then
-            call planetwide_sumval(cpp*massarea(:,:)*zdtc(:,:)/totarea_planet,dEtot)
-            call planetwide_sumval(capcal(:)*zdtsurfc(:)*cell_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  ! end of 'co2cond'
-
-
-!---------------------------------------------
-!   VI. Specific parameterizations for tracers 
-!---------------------------------------------
-
-      if (tracer) then
-      
-  ! ---------------------
-  !   VI.1. Water and ice
-  ! ---------------------
-         if (water) then
-
-            ! Water ice condensation in the atmosphere
-            if(watercond.and.(RLVTT.gt.1.e-8))then
-
-               dqmoist(1:ngrid,1:nlayer,1:nq)=0.
-               dtmoist(1:ngrid,1:nlayer)=0.
-               
-               ! Moist Convective Adjustment.
-               ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-               call moistadj(ngrid,nlayer,nq,pt,pq,pdq,pplev,pplay,dtmoist,dqmoist,ptimestep,rneb_man)
-
-               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap)     &
-                                                  + dqmoist(1:ngrid,1:nlayer,igcm_h2o_vap)
-               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice)     &
-                                                  + dqmoist(1:ngrid,1:nlayer,igcm_h2o_ice)
-               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+dtmoist(1:ngrid,1:nlayer)
-
-               ! 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
-                  
-                  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 ! end of 'enertest'
-               
-
-               ! Large scale condensation/evaporation.
-               ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-               call largescale(ngrid,nlayer,nq,ptimestep,pplev,pplay,pt,pq,pdt,pdq,dtlscale,dqvaplscale,dqcldlscale,rneb_lsc)
-
-               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+dtlscale(1:ngrid,1:nlayer)
-               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap)+dqvaplscale(1:ngrid,1:nlayer)
-               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice)+dqcldlscale(1:ngrid,1:nlayer)
-
-               ! 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 (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 ! end of 'enertest'
-
-               ! 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 ! end of 'watercond'
-           
-            ! Water ice / liquid precipitation.
-            ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-            if(waterrain)then
-
-               zdqrain(1:ngrid,1:nlayer,1:nq) = 0.0
-               zdqsrain(1:ngrid)    = 0.0
-               zdqssnow(1:ngrid)    = 0.0
-
-               call rain(ngrid,nlayer,nq,ptimestep,pplev,pplay,pt,pdt,pq,pdq,            &
-                         zdtrain,zdqrain,zdqsrain,zdqssnow,cloudfrac)
-
-               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap) &
-                                                  + zdqrain(1:ngrid,1:nlayer,igcm_h2o_vap)
-               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice) &
-                                                  + zdqrain(1:ngrid,1:nlayer,igcm_h2o_ice)
-               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtrain(1:ngrid,1:nlayer)
-               
-               dqsurf(1:ngrid,igcm_h2o_vap) = dqsurf(1:ngrid,igcm_h2o_vap)+zdqsrain(1:ngrid)
-               dqsurf(1:ngrid,igcm_h2o_ice) = dqsurf(1:ngrid,igcm_h2o_ice)+zdqssnow(1:ngrid) 
-
-               ! 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(cell_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(cell_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(:))*cell_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 of 'enertest'
-
-            end if ! enf of 'waterrain'
-            
-         end if ! end of 'water'
-
-  ! -------------------------
-  !   VI.2. Aerosol particles
-  ! -------------------------
-
-         ! Sedimentation.
-         if (sedimentation) then
-        
-            zdqsed(1:ngrid,1:nlayer,1:nq) = 0.0
-            zdqssed(1:ngrid,1:nq)  = 0.0
-
-            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)
-
-            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
-
-            ! Whether it falls as rain or snow depends only on the surface temperature
-            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqsed(1:ngrid,1:nlayer,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))*cell_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 ! end of 'sedimentation'
-
-
-  ! ---------------
-  !   VI.3. Updates
-  ! ---------------
-
-         ! Updating Atmospheric Mass and Tracers budgets.
-         if(mass_redistrib) then
-
-            zdmassmr(1:ngrid,1:nlayer) = mass(1:ngrid,1:nlayer) *     &
-               (   zdqevap(1:ngrid,1:nlayer)                          &
-                 + zdqrain(1:ngrid,1:nlayer,igcm_h2o_vap)             &
-                 + dqmoist(1:ngrid,1:nlayer,igcm_h2o_vap)             &
-                 + dqvaplscale(1:ngrid,1:nlayer) )
-
-            do ig = 1, ngrid
-               zdmassmr_col(ig)=SUM(zdmassmr(ig,1:nlayer))
-            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","kg/m2",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:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqmr(1:ngrid,1:nlayer,1:nq)
-            dqsurf(1:ngrid,1:nq)       = dqsurf(1:ngrid,1:nq) + zdqsurfmr(1:ngrid,1:nq)
-            pdt(1:ngrid,1:nlayer)      = pdt(1:ngrid,1:nlayer) + zdtmr(1:ngrid,1:nlayer)
-            pdu(1:ngrid,1:nlayer)      = pdu(1:ngrid,1:nlayer) + zdumr(1:ngrid,1:nlayer)
-            pdv(1:ngrid,1:nlayer)      = pdv(1:ngrid,1:nlayer) + zdvmr(1:ngrid,1:nlayer)
-            pdpsrf(1:ngrid)            = pdpsrf(1:ngrid) + zdpsrfmr(1:ngrid)
-            zdtsurf(1:ngrid)           = zdtsurf(1:ngrid) + zdtsurfmr(1:ngrid)
-            
-         endif
-
-  ! ------------------
-  !   VI.4. 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 ! end of 'ok_slab_ocean'
-
-  ! -----------------------------
-  !   VI.5. Surface Tracer Update
-  ! -----------------------------
-
-         if(hydrology)then
-            
-            call hydrol(ngrid,nq,ptimestep,rnat,tsurf,qsurf,dqsurf,dqs_hyd, &
-                        capcal,albedo,albedo_bareground,                    &
-                        albedo_snow_SPECTV,albedo_co2_ice_SPECTV,           &
-                        mu0,zdtsurf,zdtsurf_hyd,hice,pctsrf_sic,            &
-                        sea_ice)
-
-            zdtsurf(1:ngrid)     = zdtsurf(1:ngrid) + zdtsurf_hyd(1:ngrid)
-            dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + dqs_hyd(1:ngrid,1:nq)
-            
-            qsurf(1:ngrid,1:nq) = qsurf(1:ngrid,1:nq) + ptimestep*dqsurf(1:ngrid,1:nq)
-
-            ! Test energy conservation
-            if(enertest)then
-               call planetwide_sumval(cell_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)*cell_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)*cell_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. 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! end of if 'tracer'
-
-
-!------------------------------------------------
-!   VII. 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 ! end of '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 !end of 'ok_slab_ocean'
-
-
-      ! Test energy conservation
-      if(enertest)then
-         call planetwide_sumval(cell_area(:)*capcal(:)*zdtsurf(:)/totarea_planet,dEtots)         
-         if (is_master) print*,'Surface energy change                 =',dEtots,' W m-2'
-      endif
-
-
-!---------------------------------------------------
-!   VIII. Perform diagnostics and write output files
-!---------------------------------------------------
-
-      ! Note : For output only: the actual model integration is performed in the dynamics.
-
-
- 
-      ! Temperature, zonal and meridional winds.
-      zt(1:ngrid,1:nlayer) = pt(1:ngrid,1:nlayer) + pdt(1:ngrid,1:nlayer)*ptimestep
-      zu(1:ngrid,1:nlayer) = pu(1:ngrid,1:nlayer) + pdu(1:ngrid,1:nlayer)*ptimestep
-      zv(1:ngrid,1:nlayer) = pv(1:ngrid,1:nlayer) + pdv(1:ngrid,1:nlayer)*ptimestep
-
-      ! Diagnostic.
-      zdtdyn(1:ngrid,1:nlayer)     = pt(1:ngrid,1:nlayer)-ztprevious(1:ngrid,1:nlayer)
-      ztprevious(1:ngrid,1:nlayer) = zt(1:ngrid,1:nlayer)
-
-      if(firstcall)then
-         zdtdyn(1:ngrid,1:nlayer)=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:nlayer,1:nq) = pq(1:ngrid,1:nlayer,1:nq) + pdq(1:ngrid,1:nlayer,1:nq)*ptimestep
-
-      ! Surface pressure.
-      ps(1:ngrid) = pplev(1:ngrid,1) + pdpsrf(1:ngrid)*ptimestep
-
-
-
-      ! Surface and soil temperature information
-      call planetwide_sumval(cell_area(:)*tsurf(:)/totarea_planet,Ts1)
-      call planetwide_minval(tsurf(:),Ts2)
-      call planetwide_maxval(tsurf(:),Ts3)
-      if(callsoil)then
-         TsS = SUM(cell_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(cell_area(:)*fluxtop_dn(:)/totarea_planet,ISR)
-         call planetwide_sumval(cell_area(:)*fluxabs_sw(:)/totarea_planet,ASR)
-         call planetwide_sumval(cell_area(:)*fluxtop_lw(:)/totarea_planet,OLR)
-         call planetwide_sumval(cell_area(:)*fluxgrd(:)/totarea_planet,GND)
-         call planetwide_sumval(cell_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 ! end of 'corrk'
-
-
-      ! 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:nlayer,iq) * mass(ig,1:nlayer))
-            enddo
-         enddo
-
-         ! Generalised for arbitrary aerosols now. By LK
-         reffcol(1:ngrid,1:naerkind)=0.0
-         if(co2cond.and.(iaero_co2.ne.0))then
-            call co2_reffrad(ngrid,nlayer,nq,zq,reffrad(1,1,iaero_co2))
-            do ig=1,ngrid
-               reffcol(ig,iaero_co2) = SUM(zq(ig,1:nlayer,igcm_co2_ice)*reffrad(ig,1:nlayer,iaero_co2)*mass(ig,1:nlayer))
-            enddo
-         endif
-         if(water.and.(iaero_h2o.ne.0))then
-            call h2o_reffrad(ngrid,nlayer,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:nlayer,igcm_h2o_ice)*reffrad(ig,1:nlayer,iaero_h2o)*mass(ig,1:nlayer))
-            enddo
-         endif
-
-      endif ! end of 'tracer'
-
-
-      ! Test for water conservation.
-      if(water)then
-
-         call planetwide_sumval(cell_area(:)*qsurf_hist(:,igcm_h2o_ice)/totarea_planet,icesrf)
-         call planetwide_sumval(cell_area(:)*qsurf_hist(:,igcm_h2o_vap)/totarea_planet,liqsrf)
-         call planetwide_sumval(cell_area(:)*qcol(:,igcm_h2o_ice)/totarea_planet,icecol)
-         call planetwide_sumval(cell_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 (Relative Humidity) for diagnostic.
-      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 ! end of 'water'
-
-
-      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)*cell_area(:) )/SUM(cell_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
-            
-            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 ! end of 'lastcall'
-
-
-!-----------------------------------
-!        Saving statistics :
-!-----------------------------------
-
-!    Note :("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,"fluxtop_lw",                                &
-                     "Thermal IR radiative flux to space","W.m-2",2,    &
-                     fluxtop_lw)
-                     
-!            call wstats(ngrid,"fluxsurf_sw",                               &
-!                        "Solar radiative flux to surface","W.m-2",2,       &
-!                         fluxsurf_sw_tot)                     
-!            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_equivalent)
-         !call wstats(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1))
-         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:nlayer,igcm_h2o_vap)*mugaz/mmol(igcm_h2o_vap)
-               call wstats(ngrid,"vmr_h2ovapor",                             &
-                           "H2O vapour volume mixing ratio","mol/mol",       & 
-                           3,vmr)
-            endif
-
-         endif ! end of '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
-
-         if(lastcall) then
-            write (*,*) "Writing stats..."
-            call mkstats(ierr)
-         endif
-         
-      endif ! end of 'callstats'
-
-
-!-----------------------------------------------------------------------------------------------------
-!           OUTPUT in netcdf file "DIAGFI.NC", containing any variable for diagnostic
-!
-!             Note 1 : output with  period "ecritphy", set in "run.def"
-!
-!             Note 2 : 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,"Lss","sub solar longitude","deg",0,zlss*180./pi)
-      call writediagfi(ngrid,"RA","right ascension","deg",0,right_ascen*180./pi)
-      call writediagfi(ngrid,"Declin","solar declination","deg",0,declin*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
-      
-
-      ! Total energy balance diagnostics
-      if(callrad.and.(.not.newtonian))then
-      
-         !call writediagfi(ngrid,"ALB","Surface albedo"," ",2,albedo_equivalent)
-         !call writediagfi(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1))
-         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
-         
-         call writediagfi(ngrid,"DYN","dynamical heat input","W m-2",2,fluxdyn)
-         
-      endif ! end of 'callrad'
-        
-      if(enertest) then
-      
-         if (calldifv) then
-         
-            call writediagfi(ngrid,"q2","turbulent kinetic energy","J.kg^-1",3,q2)
-            call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux)
-            
-!             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)
-             
-         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,"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,"lscaledEz","heat from largescale","W m-2",3,lscaledEz) 
-!             call writediagfi(ngrid,"madjdEz","heat from moistadj","W m-2",3,madjdEz)             
-!             call writediagfi(ngrid,"h2o_max_col","maximum H2O column amount","kg.m^-2",2,H2Omaxcol)
-
-         endif
-          
-      endif ! end of 'enertest'
-
-
-        ! Temporary inclusions for heating diagnostics.
-        !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)
-        ! call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn)
-        
-        ! For 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_hist(1,iq) )
-            call writediagfi(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col',    & 
-                            'kg m^-2',2,qcol(1,iq) )
-                          
-!          call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  & 
-!                          'kg m^-2',2,qsurf(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 ! end of 'nq' loop
-         
-       endif ! end of 'tracer'
-
-
-      ! 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
-
-    end subroutine physiq
Index: /trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90	(revision 1549)
+++ /trunk/LMDZ.GENERIC/libf/phystd/physiq_mod.F90	(revision 1549)
@@ -0,0 +1,2141 @@
+      module physiq_mod
+      
+      implicit none
+      
+      contains
+      
+      subroutine physiq(ngrid,nlayer,nq,   &
+                  nametrac,                & 
+                  firstcall,lastcall,      &
+                  pday,ptime,ptimestep,    &
+                  pplev,pplay,pphi,        &
+                  pu,pv,pt,pq,             &
+                  flxw,                    &
+                  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, glat, grav, BWNV
+      use radii_mod, only: h2o_reffrad, co2_reffrad
+      use aerosol_mod, only: iaero_co2, iaero_h2o
+      use surfdat_h, only: phisfi, zmea, zstd, zsig, zgam, zthe, &
+                           dryness, watercaptag
+      use comdiurn_h, only: coslat, sinlat, coslon, sinlon
+      use comsaison_h, only: mu0, fract, dist_star, declin, right_ascen
+      use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat
+      use geometry_mod, only: latitude, longitude, cell_area
+      USE comgeomfi_h, only: 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 time_phylmdz_mod, only: ecritphy, iphysiq, nday
+      use phyredem, only: physdem0, physdem1
+      use slab_ice_h, only: capcalocean, capcalseaice,capcalsno, &
+                            noceanmx
+      use ocean_slab_mod, only :ocean_slab_init, ocean_slab_ice, &
+                                ini_surf_heat_transp_mod, &
+                                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
+      use planete_mod, only: apoastr, periastr, year_day, peri_day, &
+                            obliquit, nres, z0
+      use comcstfi_mod, only: pi, g, rcp, r, rad, mugaz, cpp
+      use time_phylmdz_mod, only: daysec
+      use callkeys_mod
+      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:
+!
+!      I. Initialization :
+!         I.1 Firstcall initializations.
+!         I.2 Initialization for every call to physiq.
+!
+!      II. Compute radiative transfer tendencies (longwave and shortwave) :
+!         II.a Option 1 : Call correlated-k radiative transfer scheme.
+!         II.b Option 2 : Call Newtonian cooling scheme.
+!         II.c Option 3 : Atmosphere has no radiative effect.
+!
+!      III. Vertical diffusion (turbulent mixing) :
+!
+!      IV. Dry Convective adjustment :
+!
+!      V. Condensation and sublimation of gases (currently just CO2).
+!
+!      VI. Tracers
+!         VI.1. Water and water ice.
+!         VI.2. Aerosols and particles.
+!         VI.3. Updates (pressure variations, surface budget).
+!         VI.4. Slab Ocean.
+!         VI.5. Surface Tracer Update.
+!
+!      VII. Surface and sub-surface soil temperature.
+!
+!      VIII. Perform diagnostics and write output files.
+!
+!
+!   arguments
+!   ---------
+!
+!   INPUT
+!   -----
+!
+!    ngrid                 Size of the horizontal grid.
+!    nlayer                Number of vertical layers.
+!    nq                    Number of advected fields.
+!    nametrac              Name of corresponding 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 (m2.s-2).
+!
+!    pu(ngrid,nlayer)      u, zonal component of the wind (ms-1).
+!    pv(ngrid,nlayer)      v, meridional 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) /
+!    flxw(ngrid,nlayer)      vertical mass flux (kg/s) at layer lower boundary
+!
+!   OUTPUT
+!   ------
+!
+!    pdu(ngrid,nlayer)        \
+!    pdv(ngrid,nlayer)         \  Temporal derivative of the corresponding
+!    pdt(ngrid,nlayer)         /  variables due to physical processes.
+!    pdq(ngrid,nlayer)        /
+!    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)
+!           Purge of the code : M. Turbet (2015)
+!==================================================================
+
+
+!    0.  Declarations :
+!    ------------------
+
+#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) ! Names of the tracers taken 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/kg_of_air).
+      real,intent(in) :: flxw(ngrid,nlayer)    ! Vertical mass flux (ks/s) at lower boundary of layer
+
+!   OUTPUTS:
+!   --------
+
+!     Physical tendencies :
+
+      real,intent(out) :: pdu(ngrid,nlayer)    ! Zonal wind tendencies (m/s/s).
+      real,intent(out) :: pdv(ngrid,nlayer)    ! Meridional wind tendencies (m/s/s).
+      real,intent(out) :: pdt(ngrid,nlayer)    ! Temperature tendencies (K/s).
+      real,intent(out) :: pdq(ngrid,nlayer,nq) ! Tracer tendencies (kg/kg_of_air/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:
+! ----------------------
+
+      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 Spectral albedo. By MT2015.
+      real, dimension(:),allocatable,save :: albedo_equivalent     ! Spectral Mean albedo.
+      real, dimension(:),allocatable,save :: albedo_snow_SPECTV    ! Snow Spectral albedo.
+      real, dimension(:),allocatable,save :: albedo_co2_ice_SPECTV ! CO2 ice Spectral albedo.
+      
+!$OMP THREADPRIVATE(tsurf,tsoil,albedo,albedo_equivalent,albedo_snow_SPECTV,albedo_co2_ice_SPECTV)
+
+      real,dimension(:),allocatable,save :: albedo_bareground ! Bare Ground Albedo. By MT 2015.
+      real,dimension(:),allocatable,save :: rnat              ! Defines the type of the grid (ocean,continent,...). By BC.
+      
+!$OMP THREADPRIVATE(albedo_bareground,rnat)
+
+      real,dimension(:),allocatable,save :: emis        ! Thermal IR surface emissivity.
+      real,dimension(:,:),allocatable,save :: dtrad     ! Net atmospheric radiative heating rate (K.s-1).
+      real,dimension(:),allocatable,save :: fluxrad_sky ! Radiative 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.
+      
+!$OMP THREADPRIVATE(emis,dtrad,fluxrad_sky,fluxrad,capcal,fluxgrd,qsurf,q2)
+
+      save day_ini, icount
+      
+!$OMP THREADPRIVATE(day_ini,icount)
+
+! Local variables :
+! -----------------
+
+!     Aerosol (dust or ice) extinction optical depth  at reference wavelength 
+!     for the "naerkind" optically active aerosols:
+
+      real aerosol(ngrid,nlayer,naerkind) ! Aerosols.
+      real zh(ngrid,nlayer)               ! Potential temperature (K).
+      real pw(ngrid,nlayer)               ! Vertical velocity (m/s). (NOTE : >0 WHEN DOWNWARDS !!)
+
+      integer l,ig,ierr,iq,nw
+      
+      ! FOR DIAGNOSTIC :
+      
+      real,dimension(:),allocatable,save :: fluxsurf_lw     ! Incident Long Wave (IR) surface flux (W.m-2).
+      real,dimension(:),allocatable,save :: fluxsurf_sw     ! Incident Short Wave (stellar) surface flux (W.m-2).
+      real,dimension(:),allocatable,save :: fluxsurfabs_sw  ! Absorbed Short Wave (stellar) flux by the surface (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      ! Incoming SW (stellar) radiation at the top of the atmosphere (W.m-2).
+      real,dimension(:),allocatable,save :: fluxdyn         ! Horizontal heat transport by dynamics (W.m-2).
+      real,dimension(:,:),allocatable,save :: OLR_nu        ! Outgoing LW radiation in each band (Normalized to the band width (W/m2/cm-1)).
+      real,dimension(:,:),allocatable,save :: OSR_nu        ! Outgoing SW radiation in each band (Normalized to the band width (W/m2/cm-1)).
+      real,dimension(:,:),allocatable,save :: zdtlw         ! LW heating tendencies (K/s).
+      real,dimension(:,:),allocatable,save :: zdtsw         ! SW heating tendencies (K/s).
+      real,dimension(:),allocatable,save :: sensibFlux      ! Turbulent flux given by the atmosphere to the surface (W.m-2).
+      
+!$OMP THREADPRIVATE(fluxsurf_lw,fluxsurf_sw,fluxsurfabs_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn,OLR_nu,OSR_nu,&
+        
+        !$OMP zdtlw,zdtsw,sensibFlux)
+
+      real zls                       ! Solar longitude (radians).
+      real zlss                      ! Sub solar point longitude (radians).
+      real zday                      ! Date (time since Ls=0, calculated in sols).
+      real zzlay(ngrid,nlayer)       ! Altitude at the middle of the atmospheric layers.
+      real zzlev(ngrid,nlayer+1)     ! Altitude at the atmospheric layer boundaries.
+
+! TENDENCIES due to various processes :
+
+      ! For Surface Temperature : (K/s)
+      real zdtsurf(ngrid)     ! Cumulated tendencies.
+      real zdtsurfmr(ngrid)   ! Mass_redistribution routine.
+      real zdtsurfc(ngrid)    ! Condense_co2 routine.
+      real zdtsdif(ngrid)     ! Turbdiff/vdifc routines.
+      real zdtsurf_hyd(ngrid) ! Hydrol routine.
+            
+      ! For Atmospheric Temperatures : (K/s)    
+      real dtlscale(ngrid,nlayer)                             ! Largescale routine.
+      real zdtc(ngrid,nlayer)                                 ! Condense_co2 routine.
+      real zdtdif(ngrid,nlayer)                                      ! Turbdiff/vdifc routines.
+      real zdtmr(ngrid,nlayer)                                ! Mass_redistribution routine.
+      real zdtrain(ngrid,nlayer)                              ! Rain routine.
+      real dtmoist(ngrid,nlayer)                              ! Moistadj routine.
+      real dt_ekman(ngrid,noceanmx), dt_hdiff(ngrid,noceanmx) ! Slab_ocean routine.
+      real zdtsw1(ngrid,nlayer), zdtlw1(ngrid,nlayer)         ! Callcorrk routine.
+                              
+      ! For Surface Tracers : (kg/m2/s)
+      real dqsurf(ngrid,nq)                 ! Cumulated tendencies.
+      real zdqsurfc(ngrid)                  ! Condense_co2 routine.
+      real zdqsdif(ngrid,nq)                ! Turbdiff/vdifc routines.
+      real zdqssed(ngrid,nq)                ! Callsedim routine.
+      real zdqsurfmr(ngrid,nq)              ! Mass_redistribution routine.
+      real zdqsrain(ngrid), zdqssnow(ngrid) ! Rain routine.
+      real dqs_hyd(ngrid,nq)                ! Hydrol routine.
+                  
+      ! For Tracers : (kg/kg_of_air/s)
+      real zdqc(ngrid,nlayer,nq)      ! Condense_co2 routine.
+      real zdqadj(ngrid,nlayer,nq)    ! Convadj routine.
+      real zdqdif(ngrid,nlayer,nq)    ! Turbdiff/vdifc routines.
+      real zdqevap(ngrid,nlayer)      ! Turbdiff routine.
+      real zdqsed(ngrid,nlayer,nq)    ! Callsedim routine.
+      real zdqmr(ngrid,nlayer,nq)     ! Mass_redistribution routine.
+      real zdqrain(ngrid,nlayer,nq)   ! Rain routine.
+      real dqmoist(ngrid,nlayer,nq)   ! Moistadj routine.
+      real dqvaplscale(ngrid,nlayer)  ! Largescale routine.
+      real dqcldlscale(ngrid,nlayer)  ! Largescale routine.
+                        
+      ! For Winds : (m/s/s)
+      real zdvadj(ngrid,nlayer),zduadj(ngrid,nlayer) ! Convadj routine.
+      real zdumr(ngrid,nlayer),zdvmr(ngrid,nlayer)   ! Mass_redistribution routine.
+      real zdvdif(ngrid,nlayer),zdudif(ngrid,nlayer) ! Turbdiff/vdifc routines.
+      real zdhdif(ngrid,nlayer)                      ! Turbdiff/vdifc routines.
+      real zdhadj(ngrid,nlayer)                      ! Convadj routine.
+     
+      ! For Pressure and Mass :
+      real zdmassmr(ngrid,nlayer) ! Atmospheric Mass tendency for mass_redistribution (kg_of_air/m2/s).
+      real zdmassmr_col(ngrid)    ! Atmospheric Column Mass tendency for mass_redistribution (kg_of_air/m2/s).
+      real zdpsrfmr(ngrid)        ! Pressure tendency for mass_redistribution routine (Pa/s).
+
+      
+    
+! Local variables for LOCAL CALCULATIONS:
+! ---------------------------------------
+      real zflubid(ngrid)
+      real zplanck(ngrid),zpopsk(ngrid,nlayer)
+      real ztim1,ztim2,ztim3, z1,z2
+      real ztime_fin
+      real zdh(ngrid,nlayer)
+      real gmplanet
+      real taux(ngrid),tauy(ngrid)
+
+
+! local variables for DIAGNOSTICS : (diagfi & stat)
+! -------------------------------------------------
+      real ps(ngrid)                                     ! Surface Pressure.
+      real zt(ngrid,nlayer)                              ! Atmospheric Temperature.
+      real zu(ngrid,nlayer),zv(ngrid,nlayer)             ! Zonal and Meridional Winds.
+      real zq(ngrid,nlayer,nq)                           ! Atmospheric Tracers.
+      real zdtadj(ngrid,nlayer)                          ! Convadj Diagnostic.
+      real zdtdyn(ngrid,nlayer)                          ! Dynamical Heating (K/s).
+      real,allocatable,dimension(:,:),save :: ztprevious ! Previous loop Atmospheric Temperature (K)                                                         ! Useful for Dynamical Heating calculation.
+!$OMP THREADPRIVATE(ztprevious)
+
+      real reff(ngrid,nlayer)                       ! Effective dust radius (used if doubleq=T).
+      real vmr(ngrid,nlayer)                        ! volume mixing ratio
+      real time_phys
+      real,allocatable,dimension(:),save :: tau_col ! Total Aerosol Optical Depth.
+!$OMP THREADPRIVATE(tau_col)
+      
+      real ISR,ASR,OLR,GND,DYN,GSR,Ts1,Ts2,Ts3,TsS ! for Diagnostic.
+      
+      real qcol(ngrid,nq) ! Tracer Column Mass (kg/m2).
+
+!     included by RW for H2O Manabe scheme
+      real rneb_man(ngrid,nlayer) ! H2O cloud fraction (moistadj).
+      real rneb_lsc(ngrid,nlayer) ! H2O cloud fraction (large scale).
+
+
+!     to test energy conservation (RW+JL)
+      real mass(ngrid,nlayer),massarea(ngrid,nlayer)
+      real dEtot, dEtots, AtmToSurf_TurbFlux
+      real,save :: dEtotSW, dEtotsSW, dEtotLW, dEtotsLW
+!$OMP THREADPRIVATE(dEtotSW, dEtotsSW, dEtotLW, dEtotsLW)
+      real dEzRadsw(ngrid,nlayer),dEzRadlw(ngrid,nlayer),dEzdiff(ngrid,nlayer)
+      real dEdiffs(ngrid),dEdiff(ngrid)
+      real madjdE(ngrid), lscaledE(ngrid),madjdEz(ngrid,nlayer), lscaledEz(ngrid,nlayer)
+      
+!JL12 conservation test for mean flow kinetic energy has been disabled temporarily
+
+      real dtmoist_max,dtmoist_min     
+      real dItot, dItot_tmp, dVtot, dVtot_tmp
+
+      real,allocatable,save :: hice(:) ! Oceanic Ice height. by BC
+ !$OMP THREADPRIVATE(hice)     
+
+      real h2otot                      ! Total Amount of water. For diagnostic.
+      real icesrf,liqsrf,icecol,vapcol ! Total Amounts of water (ice,liq,vap). For diagnostic.
+      real dWtot, dWtot_tmp, dWtots, dWtots_tmp
+      logical,save :: watertest
+!$OMP THREADPRIVATE(watertest)
+
+      real qsat(ngrid,nlayer) ! Water Vapor Volume Mixing Ratio at saturation (kg/kg_of_air).
+      real RH(ngrid,nlayer)   ! Relative humidity.
+      real H2Omaxcol(ngrid)   ! Maximum possible H2O column amount (at 100% saturation) (kg/m2).
+      real psat_tmp
+      
+      logical clearsky ! For double radiative transfer call. By BC
+      
+      ! For Clear Sky Case.
+      real fluxsurf_lw1(ngrid), fluxsurf_sw1(ngrid), fluxsurfabs_sw1(ngrid)  ! For SW/LW flux.
+      real fluxtop_lw1(ngrid), fluxabs_sw1(ngrid)                            ! For SW/LW flux.
+      real albedo_equivalent1(ngrid)                                         ! For Equivalent albedo calculation.
+      real tau_col1(ngrid)                                                   ! For aerosol optical depth diagnostic.
+      real OLR_nu1(ngrid,L_NSPECTI), OSR_nu1(ngrid,L_NSPECTV)                ! For Outgoing Radiation diagnostics.
+      real tf, ntf
+
+      real,allocatable,dimension(:,:),save :: cloudfrac  ! Fraction of clouds (%).
+      real,allocatable,dimension(:),save :: totcloudfrac ! Column fraction of clouds (%).
+!$OMP THREADPRIVATE(cloudfrac,totcloudfrac)
+
+      real nconsMAX, vdifcncons(ngrid), cadjncons(ngrid) ! Vdfic water conservation test. By RW
+
+      real,allocatable,dimension(:,:),save :: qsurf_hist
+!$OMP THREADPRIVATE(qsurf_hist)
+
+      real muvar(ngrid,nlayer+1) ! For Runaway Greenhouse 1D study. By RW
+
+      real,allocatable,dimension(:,:,:),save :: reffrad  ! Aerosol effective radius (m). By RW
+      real,allocatable,dimension(:,:,:),save :: nueffrad ! Aerosol effective radius variance. By RW
+!$OMP THREADPRIVATE(reffrad,nueffrad)
+
+      real reffcol(ngrid,naerkind)
+
+!     Sourceevol for 'accelerated ice evolution'. By RW
+      real,allocatable,dimension(:),save :: ice_initial
+      real delta_ice,ice_tot
+      real,allocatable,dimension(:),save :: ice_min      
+      integer num_run
+      logical,save :: ice_update
+!$OMP THREADPRIVATE(ice_initial,ice_min,ice_update)
+
+!     For slab ocean. By BC
+      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 
+!$OMP THREADPRIVATE(pctsrf_sic,tslab,tsea_ice,sea_ice,zmasq,knindex)
+
+      real :: tsurf2(ngrid)
+      real :: flux_o(ngrid),flux_g(ngrid),fluxgrdocean(ngrid)
+      real :: flux_sens_lat(ngrid)
+      real :: qsurfint(ngrid,nq)
+
+
+!==================================================================================================
+
+! -----------------
+! I. INITIALISATION
+! -----------------
+
+! --------------------------------
+! I.1   First Call Initialisation.
+! --------------------------------
+      if (firstcall) then
+
+        ! Allocate saved arrays.
+        ALLOCATE(tsurf(ngrid))
+        ALLOCATE(tsoil(ngrid,nsoilmx))    
+        ALLOCATE(albedo(ngrid,L_NSPECTV))
+         ALLOCATE(albedo_equivalent(ngrid))        
+         ALLOCATE(albedo_snow_SPECTV(L_NSPECTV))
+         ALLOCATE(albedo_co2_ice_SPECTV(L_NSPECTV))
+         ALLOCATE(albedo_bareground(ngrid))           
+        ALLOCATE(rnat(ngrid))         
+        ALLOCATE(emis(ngrid))   
+        ALLOCATE(dtrad(ngrid,nlayer))
+        ALLOCATE(fluxrad_sky(ngrid))
+        ALLOCATE(fluxrad(ngrid))    
+        ALLOCATE(capcal(ngrid))    
+        ALLOCATE(fluxgrd(ngrid))  
+        ALLOCATE(qsurf(ngrid,nq))  
+        ALLOCATE(q2(ngrid,nlayer+1)) 
+        ALLOCATE(ztprevious(ngrid,nlayer))
+        ALLOCATE(cloudfrac(ngrid,nlayer))
+        ALLOCATE(totcloudfrac(ngrid))
+        ALLOCATE(hice(ngrid))
+        ALLOCATE(qsurf_hist(ngrid,nq))
+        ALLOCATE(reffrad(ngrid,nlayer,naerkind))
+        ALLOCATE(nueffrad(ngrid,nlayer,naerkind))
+        ALLOCATE(ice_initial(ngrid))
+        ALLOCATE(ice_min(ngrid)) 
+        ALLOCATE(fluxsurf_lw(ngrid))
+        ALLOCATE(fluxsurf_sw(ngrid))
+        ALLOCATE(fluxsurfabs_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,nlayer))
+        ALLOCATE(zdtsw(ngrid,nlayer))
+        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))
+
+        ! This is defined in comsaison_h
+        ALLOCATE(mu0(ngrid))
+        ALLOCATE(fract(ngrid))            
+         ! This is defined in radcommon_h
+        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
+
+
+!        Read 'startfi.nc' file.
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         call phyetat0(ngrid,nlayer,"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 calculation. 
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         albedo(:,:)=0.0
+          albedo_bareground(:)=0.0
+          albedo_snow_SPECTV(:)=0.0
+          albedo_co2_ice_SPECTV(:)=0.0
+         call surfini(ngrid,nq,qsurf,albedo,albedo_bareground,albedo_snow_SPECTV,albedo_co2_ice_SPECTV) 
+         
+!        Initialize orbital calculation. 
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         call iniorbit(apoastr,periastr,year_day,peri_day,obliquit)
+
+
+         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)
+
+           call ini_surf_heat_transp_mod()
+           
+           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(ngrid,zmasq)
+
+         endif ! end of 'ok_slab_ocean'.
+
+
+!        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 ! end of 'ok_slab_ocean'.
+
+         else ! else of 'callsoil'.
+         
+            print*,'WARNING! Thermal conduction in the soil turned off'
+            capcal(:)=1.e6
+            fluxgrd(:)=intheat
+            print*,'Flux from ground = ',intheat,' W m^-2'
+            
+         endif ! end of 'callsoil'.
+         
+         icount=1
+
+!        Decide whether to update ice at end of run.
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         ice_update=.false.
+         if(sourceevol)then
+!$OMP MASTER
+            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)
+!$OMP END MASTER
+!$OMP BARRIER
+        
+            if(num_run.ne.0.and.mod(num_run,2).eq.0)then
+               print*,'Updating ice at end of this year!'
+               ice_update=.true.
+               ice_min(:)=1.e4
+            endif
+            
+         endif ! end of 'sourceevol'.
+
+
+         ! Here is defined the type of the surface : Continent or Ocean.
+         ! BC2014 : This is now already done in newstart.
+         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         if (.not.ok_slab_ocean) then
+         
+           rnat(:)=1.
+           do ig=1,ngrid
+              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 ! end of 'ok_slab_ocean'.
+
+
+!        Initialize surface history variable.
+!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         qsurf_hist(:,:)=qsurf(:,:)
+
+!        Initialize 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          
+            call system('rm -f rad_bal.out') ! to record global radiative balance.           
+            call system('rm -f tem_bal.out') ! to record global mean/max/min temperatures.            
+            call system('rm -f h2o_bal.out') ! to record global hydrological balance.
+         endif
+
+
+         watertest=.false.        
+         if(water)then ! Initialize 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 ! Note : no need to create a restart file in 1d.
+            call physdem0("restartfi.nc",longitude,latitude,nsoilmx,ngrid,nlayer,nq, &
+                          ptimestep,pday+nday,time_phys,cell_area,          &
+                          albedo_bareground,inertiedat,zmea,zstd,zsig,zgam,zthe)
+         endif
+         
+               
+      endif ! end of 'firstcall'
+
+! ------------------------------------------------------
+! I.2   Initializations done at every physical timestep:
+! ------------------------------------------------------
+
+      ! Initialize various variables
+      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      
+      if ( .not.nearco2cond ) then
+         pdt(1:ngrid,1:nlayer) = 0.0
+      endif      
+      zdtsurf(1:ngrid)      = 0.0
+      pdq(1:ngrid,1:nlayer,1:nq) = 0.0
+      dqsurf(1:ngrid,1:nq)= 0.0
+      pdu(1:ngrid,1:nlayer) = 0.0
+      pdv(1:ngrid,1:nlayer) = 0.0
+      pdpsrf(1:ngrid)       = 0.0
+      zflubid(1:ngrid)      = 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), and orbital parameters.
+      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (season) then
+         call stellarlong(zday,zls)
+      else
+         call stellarlong(float(day_ini),zls)
+      end if
+
+      call orbite(zls,dist_star,declin,right_ascen)
+      
+      if (tlocked) then
+              zlss=Mod(-(2.*pi*(zday/year_day)*nres - right_ascen),2.*pi)
+      elseif (diurnal) then
+              zlss=-2.*pi*(zday-.5)
+      else if(diurnal .eqv. .false.) then
+              zlss=9999.
+      endif 
+
+
+      ! 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. - latitude(ig)))) 
+         end do
+      endif
+
+      ! Compute geopotential between layers.
+      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      zzlay(1:ngrid,1:nlayer)=pphi(1:ngrid,1:nlayer)
+      do l=1,nlayer         
+         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     
+
+      ! Compute potential temperature
+      ! Note : Potential temperature calculation may not be the same in physiq and dynamic...
+      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      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)*cell_area(ig)
+         enddo
+      enddo
+
+     ! Compute vertical velocity (m/s) from vertical mass flux
+     ! w = F / (rho*area) and rho = P/(r*T)
+     ! But first linearly interpolate mass flux to mid-layers
+      do l=1,nlayer-1
+         pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
+      enddo
+      pw(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
+      do l=1,nlayer
+         pw(1:ngrid,l)=(pw(1:ngrid,l)*r*pt(1:ngrid,l)) /  &
+                       (pplay(1:ngrid,l)*cell_area(1:ngrid))
+      enddo
+
+!---------------------------------
+! II. Compute radiative tendencies
+!---------------------------------
+
+      if (callrad) then
+         if( mod(icount-1,iradia).eq.0.or.lastcall) then
+
+          ! Compute local stellar zenith angles
+          ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            if (tlocked) then
+            ! JL14 corrects tidally resonant (and inclined) cases. nres=omega_rot/omega_orb
+               ztim1=SIN(declin)
+               ztim2=COS(declin)*COS(zlss)
+               ztim3=COS(declin)*SIN(zlss)
+
+               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,latitude,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
+                call call_rings(ngrid, ptime, pday, diurnal)
+            endif    
+
+
+            if (corrk) then
+            
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! II.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:nlayer)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,1:nlayer,igcm_h2o_vap)) 
+                  muvar(1:ngrid,nlayer+1)=mugaz/(1.e0+(1.e0/epsi-1.e0)*pq(1:ngrid,nlayer,igcm_h2o_vap)) 
+                  ! take into account water effect on mean molecular weight
+               else
+                  muvar(1:ngrid,1:nlayer+1)=mugaz
+               endif 
+      
+
+               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)
+                
+               ! standard callcorrk
+               clearsky=.false.
+               call callcorrk(ngrid,nlayer,pq,nq,qsurf,                           &
+                              albedo,albedo_equivalent,emis,mu0,pplev,pplay,pt,   &
+                              tsurf,fract,dist_star,aerosol,muvar,                &
+                              zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,                &
+                              fluxsurfabs_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,albedo_equivalent1,emis,mu0,pplev,pplay,pt,   &
+                                 tsurf,fract,dist_star,aerosol,muvar,                &
+                                 zdtlw1,zdtsw1,fluxsurf_lw1,fluxsurf_sw1,            &
+                                 fluxsurfabs_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)
+                     albedo_equivalent(ig) = ntf*albedo_equivalent1(ig) + tf*albedo_equivalent(ig)
+                     fluxsurfabs_sw(ig)    = ntf*fluxsurfabs_sw1(ig)    + tf*fluxsurfabs_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:nlayer) = ntf*zdtlw1(ig,1:nlayer) + tf*zdtlw(ig,1:nlayer)
+                     zdtsw(ig,1:nlayer) = ntf*zdtsw1(ig,1:nlayer) + tf*zdtsw(ig,1:nlayer)
+
+                     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 ! end of CLFvarying.
+
+               if(ok_slab_ocean) then
+                  tsurf(:)=tsurf2(:)
+               endif
+
+
+               ! 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)+fluxsurfabs_sw(1:ngrid)
+
+                            !if(noradsurf)then ! no lower surface; SW flux just disappears
+                            !   GSR = SUM(fluxsurf_sw(1:ngrid)*cell_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:nlayer)=zdtsw(1:ngrid,1:nlayer)+zdtlw(1:ngrid,1:nlayer)
+               
+               ! Late initialization of the Ice Spectral Albedo. We needed the visible bands to do that ! 
+               if (firstcall .and. albedo_spectral_mode) then
+                  call spectral_albedo_calc(albedo_snow_SPECTV)
+               endif
+
+            elseif(newtonian)then
+            
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! II.b Call Newtonian cooling scheme
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               call newtrelax(ngrid,nlayer,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
+            
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! II.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)
+               print*,'------------WARNING---WARNING------------' ! by MT2015.
+               print*,'You are in corrk=false mode, '
+               print*,'and the surface albedo is taken equal to the first visible spectral value'               
+               
+               fluxsurfabs_sw(1:ngrid) = fluxtop_dn(1:ngrid)*(1.-albedo(1:ngrid,1))
+               fluxrad_sky(1:ngrid)    = fluxsurfabs_sw(1:ngrid)
+               fluxtop_lw(1:ngrid)  = emis(1:ngrid)*sigma*tsurf(1:ngrid)**4
+
+               dtrad(1:ngrid,1:nlayer)=0.0 ! no atmospheric radiative heating
+
+            endif ! end of 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:nlayer)=pdt(1:ngrid,1:nlayer)+dtrad(1:ngrid,1:nlayer)
+         
+         ! Test of 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_equivalent(:))*cell_area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk
+            call planetwide_sumval(fluxsurfabs_sw(:)*cell_area(:)/totarea_planet,dEtotsSW) !JL13 carefull, albedo can have changed since the last time we called corrk
+            call planetwide_sumval((fluxsurf_lw(:)*emis(:)-zplanck(:))*cell_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 ! end of 'enertest'
+
+      endif ! of if (callrad)
+
+
+
+!  --------------------------------------------
+!  III. Vertical diffusion (turbulent mixing) :
+!  --------------------------------------------
+
+      if (calldifv) then
+      
+         zflubid(1:ngrid)=fluxrad(1:ngrid)+fluxgrd(1:ngrid)
+
+         ! 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,   &
+                          pdt,pdq,zflubid,                       &
+                          zdudif,zdvdif,zdtdif,zdtsdif,          &
+                          sensibFlux,q2,zdqdif,zdqevap,zdqsdif,  &
+                          taux,tauy,lastcall)
+
+         else
+         
+            zdh(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer)
+ 
+            call vdifc(ngrid,nlayer,nq,rnat,zpopsk,           &
+                       ptimestep,capcal,lwrite,               &
+                       pplay,pplev,zzlay,zzlev,z0,            &
+                       pu,pv,zh,pq,tsurf,emis,qsurf,          &
+                       zdh,pdq,zflubid,                       &
+                       zdudif,zdvdif,zdhdif,zdtsdif,          &
+                       sensibFlux,q2,zdqdif,zdqsdif,          &
+                       taux,tauy,lastcall)
+
+            zdtdif(1:ngrid,1:nlayer)=zdhdif(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only
+            zdqevap(1:ngrid,1:nlayer)=0.
+
+         end if !end of 'UseTurbDiff'
+
+
+         pdv(1:ngrid,1:nlayer)=pdv(1:ngrid,1:nlayer)+zdvdif(1:ngrid,1:nlayer)
+         pdu(1:ngrid,1:nlayer)=pdu(1:ngrid,1:nlayer)+zdudif(1:ngrid,1:nlayer)
+         pdt(1:ngrid,1:nlayer)=pdt(1:ngrid,1:nlayer)+zdtdif(1:ngrid,1:nlayer)
+         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:nlayer,1:nq)=pdq(1:ngrid,1:nlayer,1:nq)+ zdqdif(1:ngrid,1:nlayer,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(:)*cell_area(:)/totarea_planet,dEtot)
+            dEdiffs(:)=capcal(:)*zdtsdif(:)-zflubid(:)-sensibFlux(:)
+            call planetwide_sumval(dEdiffs(:)*cell_area(:)/totarea_planet,dEtots)
+            call planetwide_sumval(sensibFlux(:)*cell_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 ! end of '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 ! end of 'enertest'
+
+
+         ! 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)*cell_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)*cell_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 ! end of 'watertest'
+         !-------------------------
+
+      else ! calldifv
+
+         if(.not.newtonian)then
+
+            zdtsurf(1:ngrid) = zdtsurf(1:ngrid) + (fluxrad(1:ngrid) + fluxgrd(1:ngrid))/capcal(1:ngrid)
+
+         endif
+
+      endif ! end of 'calldifv'
+
+
+!----------------------------------
+!   IV. Dry convective adjustment :
+!----------------------------------
+
+      if(calladj) then
+
+         zdh(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)/zpopsk(1:ngrid,1:nlayer)
+         zduadj(1:ngrid,1:nlayer)=0.0
+         zdvadj(1:ngrid,1:nlayer)=0.0
+         zdhadj(1:ngrid,1:nlayer)=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:nlayer) = pdu(1:ngrid,1:nlayer) + zduadj(1:ngrid,1:nlayer)
+         pdv(1:ngrid,1:nlayer) = pdv(1:ngrid,1:nlayer) + zdvadj(1:ngrid,1:nlayer)
+         pdt(1:ngrid,1:nlayer)    = pdt(1:ngrid,1:nlayer) + zdhadj(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer)
+         zdtadj(1:ngrid,1:nlayer) = zdhadj(1:ngrid,1:nlayer)*zpopsk(1:ngrid,1:nlayer) ! for diagnostic only
+
+         if(tracer) then 
+            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqadj(1:ngrid,1:nlayer,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 ! end of 'watertest'
+         
+      endif ! end of 'calladj'
+
+!-----------------------------------------------
+!   V. 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_co2(ngrid,nlayer,nq,ptimestep,                    &
+                           capcal,pplay,pplev,tsurf,pt,                  &
+                           pdt,zdtsurf,pq,pdq,                           &
+                           qsurf,zdqsurfc,albedo,emis,                   &
+                           albedo_bareground,albedo_co2_ice_SPECTV,      &
+                           zdtc,zdtsurfc,pdpsrf,zdqc)
+
+         pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtc(1:ngrid,1:nlayer)
+         zdtsurf(1:ngrid)      = zdtsurf(1:ngrid) + zdtsurfc(1:ngrid)
+
+         pdq(1:ngrid,1:nlayer,1:nq)   = pdq(1:ngrid,1:nlayer,1:nq)+ zdqc(1:ngrid,1:nlayer,1:nq)
+         dqsurf(1:ngrid,igcm_co2_ice) = dqsurf(1:ngrid,igcm_co2_ice) + zdqsurfc(1:ngrid)
+
+         ! test energy conservation
+         if(enertest)then
+            call planetwide_sumval(cpp*massarea(:,:)*zdtc(:,:)/totarea_planet,dEtot)
+            call planetwide_sumval(capcal(:)*zdtsurfc(:)*cell_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  ! end of 'co2cond'
+
+
+!---------------------------------------------
+!   VI. Specific parameterizations for tracers 
+!---------------------------------------------
+
+      if (tracer) then
+      
+  ! ---------------------
+  !   VI.1. Water and ice
+  ! ---------------------
+         if (water) then
+
+            ! Water ice condensation in the atmosphere
+            if(watercond.and.(RLVTT.gt.1.e-8))then
+
+               dqmoist(1:ngrid,1:nlayer,1:nq)=0.
+               dtmoist(1:ngrid,1:nlayer)=0.
+               
+               ! Moist Convective Adjustment.
+               ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               call moistadj(ngrid,nlayer,nq,pt,pq,pdq,pplev,pplay,dtmoist,dqmoist,ptimestep,rneb_man)
+
+               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap)     &
+                                                  + dqmoist(1:ngrid,1:nlayer,igcm_h2o_vap)
+               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice)     &
+                                                  + dqmoist(1:ngrid,1:nlayer,igcm_h2o_ice)
+               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+dtmoist(1:ngrid,1:nlayer)
+
+               ! 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
+                  
+                  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 ! end of 'enertest'
+               
+
+               ! Large scale condensation/evaporation.
+               ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+               call largescale(ngrid,nlayer,nq,ptimestep,pplev,pplay,pt,pq,pdt,pdq,dtlscale,dqvaplscale,dqcldlscale,rneb_lsc)
+
+               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+dtlscale(1:ngrid,1:nlayer)
+               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap)+dqvaplscale(1:ngrid,1:nlayer)
+               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice)+dqcldlscale(1:ngrid,1:nlayer)
+
+               ! 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 (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 ! end of 'enertest'
+
+               ! 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 ! end of 'watercond'
+           
+            ! Water ice / liquid precipitation.
+            ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            if(waterrain)then
+
+               zdqrain(1:ngrid,1:nlayer,1:nq) = 0.0
+               zdqsrain(1:ngrid)    = 0.0
+               zdqssnow(1:ngrid)    = 0.0
+
+               call rain(ngrid,nlayer,nq,ptimestep,pplev,pplay,pt,pdt,pq,pdq,            &
+                         zdtrain,zdqrain,zdqsrain,zdqssnow,cloudfrac)
+
+               pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = pdq(1:ngrid,1:nlayer,igcm_h2o_vap) &
+                                                  + zdqrain(1:ngrid,1:nlayer,igcm_h2o_vap)
+               pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = pdq(1:ngrid,1:nlayer,igcm_h2o_ice) &
+                                                  + zdqrain(1:ngrid,1:nlayer,igcm_h2o_ice)
+               pdt(1:ngrid,1:nlayer) = pdt(1:ngrid,1:nlayer)+zdtrain(1:ngrid,1:nlayer)
+               
+               dqsurf(1:ngrid,igcm_h2o_vap) = dqsurf(1:ngrid,igcm_h2o_vap)+zdqsrain(1:ngrid)
+               dqsurf(1:ngrid,igcm_h2o_ice) = dqsurf(1:ngrid,igcm_h2o_ice)+zdqssnow(1:ngrid) 
+
+               ! 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(cell_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(cell_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(:))*cell_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 of 'enertest'
+
+            end if ! enf of 'waterrain'
+            
+         end if ! end of 'water'
+
+  ! -------------------------
+  !   VI.2. Aerosol particles
+  ! -------------------------
+
+         ! Sedimentation.
+         if (sedimentation) then
+        
+            zdqsed(1:ngrid,1:nlayer,1:nq) = 0.0
+            zdqssed(1:ngrid,1:nq)  = 0.0
+
+            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)
+
+            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
+
+            ! Whether it falls as rain or snow depends only on the surface temperature
+            pdq(1:ngrid,1:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqsed(1:ngrid,1:nlayer,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))*cell_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 ! end of 'sedimentation'
+
+
+  ! ---------------
+  !   VI.3. Updates
+  ! ---------------
+
+         ! Updating Atmospheric Mass and Tracers budgets.
+         if(mass_redistrib) then
+
+            zdmassmr(1:ngrid,1:nlayer) = mass(1:ngrid,1:nlayer) *     &
+               (   zdqevap(1:ngrid,1:nlayer)                          &
+                 + zdqrain(1:ngrid,1:nlayer,igcm_h2o_vap)             &
+                 + dqmoist(1:ngrid,1:nlayer,igcm_h2o_vap)             &
+                 + dqvaplscale(1:ngrid,1:nlayer) )
+
+            do ig = 1, ngrid
+               zdmassmr_col(ig)=SUM(zdmassmr(ig,1:nlayer))
+            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","kg/m2",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:nlayer,1:nq) = pdq(1:ngrid,1:nlayer,1:nq) + zdqmr(1:ngrid,1:nlayer,1:nq)
+            dqsurf(1:ngrid,1:nq)       = dqsurf(1:ngrid,1:nq) + zdqsurfmr(1:ngrid,1:nq)
+            pdt(1:ngrid,1:nlayer)      = pdt(1:ngrid,1:nlayer) + zdtmr(1:ngrid,1:nlayer)
+            pdu(1:ngrid,1:nlayer)      = pdu(1:ngrid,1:nlayer) + zdumr(1:ngrid,1:nlayer)
+            pdv(1:ngrid,1:nlayer)      = pdv(1:ngrid,1:nlayer) + zdvmr(1:ngrid,1:nlayer)
+            pdpsrf(1:ngrid)            = pdpsrf(1:ngrid) + zdpsrfmr(1:ngrid)
+            zdtsurf(1:ngrid)           = zdtsurf(1:ngrid) + zdtsurfmr(1:ngrid)
+            
+         endif
+
+  ! ------------------
+  !   VI.4. 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 ! end of 'ok_slab_ocean'
+
+  ! -----------------------------
+  !   VI.5. Surface Tracer Update
+  ! -----------------------------
+
+         if(hydrology)then
+            
+            call hydrol(ngrid,nq,ptimestep,rnat,tsurf,qsurf,dqsurf,dqs_hyd, &
+                        capcal,albedo,albedo_bareground,                    &
+                        albedo_snow_SPECTV,albedo_co2_ice_SPECTV,           &
+                        mu0,zdtsurf,zdtsurf_hyd,hice,pctsrf_sic,            &
+                        sea_ice)
+
+            zdtsurf(1:ngrid)     = zdtsurf(1:ngrid) + zdtsurf_hyd(1:ngrid)
+            dqsurf(1:ngrid,1:nq) = dqsurf(1:ngrid,1:nq) + dqs_hyd(1:ngrid,1:nq)
+            
+            qsurf(1:ngrid,1:nq) = qsurf(1:ngrid,1:nq) + ptimestep*dqsurf(1:ngrid,1:nq)
+
+            ! Test energy conservation
+            if(enertest)then
+               call planetwide_sumval(cell_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)*cell_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)*cell_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. 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! end of if 'tracer'
+
+
+!------------------------------------------------
+!   VII. 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 ! end of '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 !end of 'ok_slab_ocean'
+
+
+      ! Test energy conservation
+      if(enertest)then
+         call planetwide_sumval(cell_area(:)*capcal(:)*zdtsurf(:)/totarea_planet,dEtots)         
+         if (is_master) print*,'Surface energy change                 =',dEtots,' W m-2'
+      endif
+
+
+!---------------------------------------------------
+!   VIII. Perform diagnostics and write output files
+!---------------------------------------------------
+
+      ! Note : For output only: the actual model integration is performed in the dynamics.
+
+
+ 
+      ! Temperature, zonal and meridional winds.
+      zt(1:ngrid,1:nlayer) = pt(1:ngrid,1:nlayer) + pdt(1:ngrid,1:nlayer)*ptimestep
+      zu(1:ngrid,1:nlayer) = pu(1:ngrid,1:nlayer) + pdu(1:ngrid,1:nlayer)*ptimestep
+      zv(1:ngrid,1:nlayer) = pv(1:ngrid,1:nlayer) + pdv(1:ngrid,1:nlayer)*ptimestep
+
+      ! Diagnostic.
+      zdtdyn(1:ngrid,1:nlayer)     = pt(1:ngrid,1:nlayer)-ztprevious(1:ngrid,1:nlayer)
+      ztprevious(1:ngrid,1:nlayer) = zt(1:ngrid,1:nlayer)
+
+      if(firstcall)then
+         zdtdyn(1:ngrid,1:nlayer)=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:nlayer,1:nq) = pq(1:ngrid,1:nlayer,1:nq) + pdq(1:ngrid,1:nlayer,1:nq)*ptimestep
+
+      ! Surface pressure.
+      ps(1:ngrid) = pplev(1:ngrid,1) + pdpsrf(1:ngrid)*ptimestep
+
+
+
+      ! Surface and soil temperature information
+      call planetwide_sumval(cell_area(:)*tsurf(:)/totarea_planet,Ts1)
+      call planetwide_minval(tsurf(:),Ts2)
+      call planetwide_maxval(tsurf(:),Ts3)
+      if(callsoil)then
+         TsS = SUM(cell_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(cell_area(:)*fluxtop_dn(:)/totarea_planet,ISR)
+         call planetwide_sumval(cell_area(:)*fluxabs_sw(:)/totarea_planet,ASR)
+         call planetwide_sumval(cell_area(:)*fluxtop_lw(:)/totarea_planet,OLR)
+         call planetwide_sumval(cell_area(:)*fluxgrd(:)/totarea_planet,GND)
+         call planetwide_sumval(cell_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 ! end of 'corrk'
+
+
+      ! 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:nlayer,iq) * mass(ig,1:nlayer))
+            enddo
+         enddo
+
+         ! Generalised for arbitrary aerosols now. By LK
+         reffcol(1:ngrid,1:naerkind)=0.0
+         if(co2cond.and.(iaero_co2.ne.0))then
+            call co2_reffrad(ngrid,nlayer,nq,zq,reffrad(1,1,iaero_co2))
+            do ig=1,ngrid
+               reffcol(ig,iaero_co2) = SUM(zq(ig,1:nlayer,igcm_co2_ice)*reffrad(ig,1:nlayer,iaero_co2)*mass(ig,1:nlayer))
+            enddo
+         endif
+         if(water.and.(iaero_h2o.ne.0))then
+            call h2o_reffrad(ngrid,nlayer,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:nlayer,igcm_h2o_ice)*reffrad(ig,1:nlayer,iaero_h2o)*mass(ig,1:nlayer))
+            enddo
+         endif
+
+      endif ! end of 'tracer'
+
+
+      ! Test for water conservation.
+      if(water)then
+
+         call planetwide_sumval(cell_area(:)*qsurf_hist(:,igcm_h2o_ice)/totarea_planet,icesrf)
+         call planetwide_sumval(cell_area(:)*qsurf_hist(:,igcm_h2o_vap)/totarea_planet,liqsrf)
+         call planetwide_sumval(cell_area(:)*qcol(:,igcm_h2o_ice)/totarea_planet,icecol)
+         call planetwide_sumval(cell_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 (Relative Humidity) for diagnostic.
+      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 ! end of 'water'
+
+
+      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)*cell_area(:) )/SUM(cell_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
+            
+            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 ! end of 'lastcall'
+
+
+!-----------------------------------
+!        Saving statistics :
+!-----------------------------------
+
+!    Note :("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,"fluxtop_lw",                                &
+                     "Thermal IR radiative flux to space","W.m-2",2,    &
+                     fluxtop_lw)
+                     
+!            call wstats(ngrid,"fluxsurf_sw",                               &
+!                        "Solar radiative flux to surface","W.m-2",2,       &
+!                         fluxsurf_sw_tot)                     
+!            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_equivalent)
+         !call wstats(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1))
+         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:nlayer,igcm_h2o_vap)*mugaz/mmol(igcm_h2o_vap)
+               call wstats(ngrid,"vmr_h2ovapor",                             &
+                           "H2O vapour volume mixing ratio","mol/mol",       & 
+                           3,vmr)
+            endif
+
+         endif ! end of '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
+
+         if(lastcall) then
+            write (*,*) "Writing stats..."
+            call mkstats(ierr)
+         endif
+         
+      endif ! end of 'callstats'
+
+
+!-----------------------------------------------------------------------------------------------------
+!           OUTPUT in netcdf file "DIAGFI.NC", containing any variable for diagnostic
+!
+!             Note 1 : output with  period "ecritphy", set in "run.def"
+!
+!             Note 2 : 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,"Lss","sub solar longitude","deg",0,zlss*180./pi)
+      call writediagfi(ngrid,"RA","right ascension","deg",0,right_ascen*180./pi)
+      call writediagfi(ngrid,"Declin","solar declination","deg",0,declin*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
+      
+
+      ! Total energy balance diagnostics
+      if(callrad.and.(.not.newtonian))then
+      
+         !call writediagfi(ngrid,"ALB","Surface albedo"," ",2,albedo_equivalent)
+         !call writediagfi(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1))
+         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
+         
+         call writediagfi(ngrid,"DYN","dynamical heat input","W m-2",2,fluxdyn)
+         
+      endif ! end of 'callrad'
+        
+      if(enertest) then
+      
+         if (calldifv) then
+         
+            call writediagfi(ngrid,"q2","turbulent kinetic energy","J.kg^-1",3,q2)
+            call writediagfi(ngrid,"sensibFlux","sensible heat flux","w.m^-2",2,sensibFlux)
+            
+!             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)
+             
+         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,"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,"lscaledEz","heat from largescale","W m-2",3,lscaledEz) 
+!             call writediagfi(ngrid,"madjdEz","heat from moistadj","W m-2",3,madjdEz)             
+!             call writediagfi(ngrid,"h2o_max_col","maximum H2O column amount","kg.m^-2",2,H2Omaxcol)
+
+         endif
+          
+      endif ! end of 'enertest'
+
+
+        ! Temporary inclusions for heating diagnostics.
+        !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)
+        ! call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn)
+        
+        ! For 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_hist(1,iq) )
+            call writediagfi(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col',    & 
+                            'kg m^-2',2,qcol(1,iq) )
+                          
+!          call writediagfi(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',  & 
+!                          'kg m^-2',2,qsurf(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 ! end of 'nq' loop
+         
+       endif ! end of 'tracer'
+
+
+      ! 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
+
+    end subroutine physiq
+    
+    end module physiq_mod
Index: /trunk/LMDZ.MARS/README
===================================================================
--- /trunk/LMDZ.MARS/README	(revision 1548)
+++ /trunk/LMDZ.MARS/README	(revision 1549)
@@ -2287,2 +2287,4 @@
   Moreover values at the poles needed to be correctly recomputed.
 
+== 06/05/2016 == EM
+- turn physiq.F into module physiq_mod.F
Index: /trunk/LMDZ.MARS/libf/dynphy_lonlat/calfis.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynphy_lonlat/calfis.F	(revision 1548)
+++ /trunk/LMDZ.MARS/libf/dynphy_lonlat/calfis.F	(revision 1549)
@@ -9,4 +9,5 @@
       USE comvert_mod, ONLY: preff
       USE comconst_mod, ONLY: dtphys,cpp,kappa,pi
+      USE physiq_mod, ONLY: physiq
 
       IMPLICIT NONE
@@ -128,5 +129,4 @@
       
       EXTERNAL gr_dyn_fi,gr_fi_dyn
-      EXTERNAL physiq,multipl
       REAL SSUM
       EXTERNAL SSUM
Index: /trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/callphysiq_mod.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/callphysiq_mod.F90	(revision 1549)
+++ /trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/callphysiq_mod.F90	(revision 1549)
@@ -0,0 +1,97 @@
+!
+! $Id: $
+!
+MODULE callphysiq_mod
+
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE call_physiq(klon,llm,nqtot,tname,                              &
+                       debut_split,lafin_split,                           &
+                       jD_cur,jH_cur_split,zdt_split,                     &
+                       zplev_omp,zplay_omp,                               &
+                       zpk_omp,zphi_omp,zphis_omp,                        &
+                       presnivs_omp,                                      &
+                       zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp,      &
+                       flxwfi_omp,pducov,                                 &
+                       zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp,zdpsrf_omp,&
+                       tracerdyn)
+
+  USE control_mod, ONLY: planet_type
+  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
+  USE physiq_mod, ONLY: physiq
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: klon ! (local) number of atmospheric columns
+  INTEGER,INTENT(IN) :: llm  ! number of atmospheric layers
+  INTEGER,INTENT(IN) :: nqtot ! number of tracers
+  CHARACTER(len=*),INTENT(IN) :: tname(nqtot) ! tracer names
+  LOGICAL,INTENT(IN) :: debut_split ! .true. if very first call to physics
+  LOGICAL,INTENT(IN) :: lafin_split ! .true. if last call to physics
+  REAL,INTENT(IN) :: JD_cur ! Julian day
+  REAL,INTENT(IN) :: JH_cur_split ! Julian hour (fraction of day)
+  REAL,INTENT(IN) :: zdt_split ! time step over which the physics are evaluated
+  REAL,INTENT(IN) :: zplev_omp(klon,llm+1) ! interlayer pressure (Pa)
+  REAL,INTENT(IN) :: zplay_omp(klon,llm) ! mid-layer pressure (Pa)
+  REAL,INTENT(IN) :: zpk_omp(klon,llm)
+  REAL,INTENT(IN) :: zphi_omp(klon,llm) ! geopotential at midlayer
+  REAL,INTENT(IN) :: zphis_omp(klon) ! surface geopotential
+  REAL,INTENT(IN) :: presnivs_omp(llm) ! approximate pressure of atm. layers
+  REAL,INTENT(IN) :: zufi_omp(klon,llm) ! zonal wind (m/s)
+  REAL,INTENT(IN) :: zvfi_omp(klon,llm) ! meridional wind (m/s)
+  REAL,INTENT(IN) :: zrfi_omp(klon,llm) ! relative wind vorticity, in s-1
+  REAL,INTENT(IN) :: ztfi_omp(klon,llm) ! temperature (K)
+  REAL,INTENT(IN) :: zqfi_omp(klon,llm,nqtot) ! tracers (*/kg of air)
+  REAL,INTENT(IN) :: flxwfi_omp(klon,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) 
+  REAL,INTENT(IN) :: pducov(nbp_lon+1,nbp_lat,llm) ! dynamical tendency on ucov
+  ! tendencies (in */s) from the physics:
+  REAL,INTENT(OUT) :: zdufi_omp(klon,llm) ! tendency on zonal winds
+  REAL,INTENT(OUT) :: zdvfi_omp(klon,llm) ! tendency on meridional winds
+  REAL,INTENT(OUT) :: zdtfi_omp(klon,llm) ! tendency on temperature
+  REAL,INTENT(OUT) :: zdqfi_omp(klon,llm,nqtot) ! tendency on tracers
+  REAL,INTENT(OUT) :: zdpsrf_omp(klon) ! tendency on surface pressure
+  LOGICAL,INTENT(OUT) :: tracerdyn
+
+  ! Local variables
+  CHARACTER(len=11) :: modname="call_physiq"
+  LOGICAL,SAVE :: firstcall=.true.
+!$OMP THREADPRIVATE(firstcall)
+
+! Sanity check on physics package type
+  IF (firstcall) THEN
+    IF (planet_type.ne."mars") THEN
+      CALL abort_gcm(modname,"wrong planet_type for this physics package",1)
+    ENDIF
+    firstcall=.false.
+  ENDIF
+
+
+! Call physics package with required inputs/outputs
+  CALL physiq(klon,           & ! ngrid
+              llm,            & ! nlayer
+              nqtot,          & ! nq
+              debut_split,    & ! firstcall
+              lafin_split,    & ! lastcall
+              jD_cur,         & ! pday
+              jH_cur_split,   & ! ptime
+              zdt_split,      & ! ptimestep
+              zplev_omp,      & ! pplev
+              zplay_omp,      & ! pplay
+              zphi_omp,       & ! pphi
+              zufi_omp,       & ! pu
+              zvfi_omp,       & ! pv
+              ztfi_omp,       & ! pt
+              zqfi_omp,       & ! pq
+              flxwfi_omp,     & ! flxw
+              zdufi_omp,      & ! pdu
+              zdvfi_omp,      & ! pdv
+              zdtfi_omp,      & ! pdt
+              zdqfi_omp,      & ! pdq
+              zdpsrf_omp,     & ! pdpsrf
+              tracerdyn)        ! tracerdyn (somewhat obsolete)
+
+
+END SUBROUTINE call_physiq
+
+END MODULE callphysiq_mod
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F	(revision 1548)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F	(revision 1549)
@@ -27,4 +27,5 @@
       use mod_interface_dyn_phys, only: init_interface_dyn_phys
       USE phys_state_var_init_mod, ONLY: phys_state_var_init
+      USE physiq_mod, ONLY: physiq
       IMPLICIT NONE
 
@@ -95,5 +96,5 @@
       REAL du(nlayer),dv(nlayer),dtemp(nlayer)
       REAL dudyn(nlayer),dvdyn(nlayer),dtempdyn(nlayer)
-      REAL dpsurf    
+      REAL dpsurf(1)    
       REAL,ALLOCATABLE :: dq(:,:)
       REAL,ALLOCATABLE :: dqdyn(:,:)
@@ -792,5 +793,5 @@
 c       ----------------------------------------------------------
 
-           psurf=psurf+dtphys*dpsurf   ! surface pressure change
+           psurf=psurf+dtphys*dpsurf(1)   ! surface pressure change
            DO ilevel=1,nlevel
              plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
Index: unk/LMDZ.MARS/libf/phymars/physiq.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/physiq.F	(revision 1548)
+++ 	(revision )
@@ -1,2642 +1,0 @@
-      SUBROUTINE physiq(
-     $            ngrid,nlayer,nq
-     $            ,firstcall,lastcall
-     $            ,pday,ptime,ptimestep
-     $            ,pplev,pplay,pphi
-     $            ,pu,pv,pt,pq
-     $            ,flxw
-     $            ,pdu,pdv,pdt,pdq,pdpsrf,tracerdyn)
-
-      use tracer_mod, only: noms, mmol, igcm_co2, igcm_n2,
-     &                      igcm_co, igcm_o, igcm_h2o_vap, igcm_h2o_ice,
-     &                      igcm_ccn_mass, igcm_ccn_number,
-     &                      igcm_dust_mass, igcm_dust_number, igcm_h2o2,
-     &                      nuice_ref, rho_ice, rho_dust, ref_r0
-      use comsoil_h, only: inertiedat, ! soil thermal inertia
-     &                     tsoil, nsoilmx ! number of subsurface layers
-      use geometry_mod, only: longitude, latitude, cell_area
-      use comgeomfi_h, only: sinlon, coslon, sinlat, coslat
-      use surfdat_h, only: phisfi, albedodat, zmea, zstd, zsig, zgam,
-     &                     zthe, z0, albedo_h2o_ice,
-     &                     frost_albedo_threshold,
-     &                     tsurf, co2ice, emis,
-     &                     capcal, fluxgrd, qsurf
-      use comsaison_h, only: dist_sol, declin, mu0, fract
-      use slope_mod, only: theta_sl, psi_sl
-      use conc_mod, only: rnew, cpnew, mmean
-      use time_phylmdz_mod, only: iphysiq, day_step, ecritstart, daysec
-      use dimradmars_mod, only: tauscaling, aerosol,
-     &                          dtrad, fluxrad_sky, fluxrad, albedo,
-     &                          naerkind
-      use turb_mod, only: q2, wstar, ustar, sensibFlux, 
-     &                    zmax_th, hfmax_th, turb_resolved
-      use planete_h, only: aphelie, periheli, year_day, peri_day,
-     &                     obliquit
-      USE comcstfi_h, only: r, cpp, mugaz, g, rcp, pi, rad
-      use param_v4_h, only: nreact,n_avog, 
-     &                      fill_data_thermos, allocate_param_thermos
-      use iono_h, only: allocate_param_iono
-#ifdef MESOSCALE
-      use comsoil_h, only: mlayer,layer
-      use surfdat_h, only: z0_default
-      use comm_wrf
-#else
-      use planetwide_mod
-      use phyredem, only: physdem0, physdem1
-      use eofdump_mod, only: eofdump
-      USE comvert_mod, ONLY: ap,bp,aps,bps
-#endif
-
-      IMPLICIT NONE
-c=======================================================================
-c
-c   subject:
-c   --------
-c
-c   Organisation of the physical parametrisations of the LMD 
-c   martian atmospheric general circulation model.
-c
-c   The GCM can be run without or with tracer transport
-c   depending on the value of Logical "tracer" in file  "callphys.def"
-c   Tracers may be water vapor, ice OR chemical species OR dust particles
-c
-c   SEE comments in initracer.F about numbering of tracer species...
-c
-c   It includes:
-c
-c      1. Initialization:
-c      1.1 First call initializations
-c      1.2 Initialization for every call to physiq
-c      1.2.5 Compute mean mass and cp, R and thermal conduction coeff.
-c      2. Compute radiative transfer tendencies
-c         (longwave and shortwave) for CO2 and aerosols.
-c      3. Gravity wave and subgrid scale topography drag :
-c      4. Vertical diffusion (turbulent mixing):
-c      5. Convective adjustment
-c      6. Condensation and sublimation of carbon dioxide.
-c      7.  TRACERS :
-c       7a. water and water ice
-c       7b. call for photochemistry when tracers are chemical species
-c       7c. other scheme for tracer (dust) transport (lifting, sedimentation)
-c       7d. updates (CO2 pressure variations, surface budget)
-c      8. Contribution to tendencies due to thermosphere
-c      9. Surface and sub-surface temperature calculations
-c     10. Write outputs :
-c           - "startfi", "histfi" (if it's time)
-c           - Saving statistics (if "callstats = .true.")
-c           - Dumping eof (if "calleofdump = .true.")
-c           - Output any needed variables in "diagfi" 
-c     11. Diagnostic: mass conservation of tracers
-c 
-c   author: 
-c   ------- 
-c           Frederic Hourdin	15/10/93
-c           Francois Forget		1994
-c           Christophe Hourdin	02/1997 
-c           Subroutine completly rewritten by F.Forget (01/2000)
-c           Introduction of the photochemical module: S. Lebonnois (11/2002)
-c           Introduction of the thermosphere module: M. Angelats i Coll (2002)
-c           Water ice clouds: Franck Montmessin (update 06/2003)
-c           Radiatively active tracers: J.-B. Madeleine (10/2008-06/2009)
-c             Nb: See callradite.F for more information.
-c           Mesoscale lines: Aymeric Spiga (2007 - 2011) -- check MESOSCALE flags
-c           jul 2011 malv+fgg: Modified calls to NIR heating routine and 15 um cooling parameterization
-c           
-c   arguments:
-c   ----------
-c
-c   input:
-c   ------
-c    ecri                  period (in dynamical timestep) to write output
-c    ngrid                 Size of the horizontal grid.
-c                          All internal loops are performed on that grid.
-c    nlayer                Number of vertical layers.
-c    nq                    Number of advected fields
-c    firstcall             True at the first call
-c    lastcall              True at the last call
-c    pday                  Number of days counted from the North. Spring
-c                          equinoxe.
-c    ptime                 Universal time (0<ptime<1): ptime=0.5 at 12:00 UT
-c    ptimestep             timestep (s)
-c    pplay(ngrid,nlayer)   Pressure at the middle of the layers (Pa)
-c    pplev(ngrid,nlayer+1) intermediate pressure levels (pa)
-c    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2s-2)
-c    pu(ngrid,nlayer)      u component of the wind (ms-1)
-c    pv(ngrid,nlayer)      v component of the wind (ms-1)
-c    pt(ngrid,nlayer)      Temperature (K)
-c    pq(ngrid,nlayer,nq)   Advected fields
-c    pudyn(ngrid,nlayer)    | 
-c    pvdyn(ngrid,nlayer)    | Dynamical temporal derivative for the
-c    ptdyn(ngrid,nlayer)    | corresponding variables
-c    pqdyn(ngrid,nlayer,nq) |
-c    flxw(ngrid,nlayer)      vertical mass flux (kg/s) at layer lower boundary
-c
-c   output:
-c   -------
-c
-c    pdu(ngrid,nlayer)       |
-c    pdv(ngrid,nlayer)       |  Temporal derivative of the corresponding
-c    pdt(ngrid,nlayer)       |  variables due to physical processes.
-c    pdq(ngrid,nlayer,nq)    |
-c    pdpsrf(ngrid)           |
-c    tracerdyn                 call tracer in dynamical part of GCM ?
-
-c
-c=======================================================================
-c
-c    0.  Declarations :
-c    ------------------
-
-#include "callkeys.h"
-#include "comg1d.h"
-#include "nlteparams.h"
-#include "chimiedata.h"
-#include "netcdf.inc"
-
-c Arguments :
-c -----------
-
-c   inputs:
-c   -------
-      INTEGER,INTENT(in) :: ngrid ! number of atmospheric columns
-      INTEGER,INTENT(in) :: nlayer ! number of atmospheric layers
-      INTEGER,INTENT(in) :: nq ! number of tracers
-      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) :: flxw(ngrid,nlayer) ! vertical mass flux (ks/s)
-                                            ! at lower boundary of layer
-
-c   outputs:
-c   --------
-c     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
-
-
-c Local saved variables:
-c ----------------------
-      INTEGER,SAVE :: day_ini ! Initial date of the run (sol since Ls=0)
-      INTEGER,SAVE :: icount     ! counter of calls to physiq during the run.
-#ifdef DUSTSTORM
-      REAL pq_tmp(ngrid, nlayer, 2) ! To compute tendencies due the dust bomb
-#endif
-c     Variables used by the water ice microphysical scheme:
-      REAL rice(ngrid,nlayer)    ! Water ice geometric mean radius (m)
-      REAL nuice(ngrid,nlayer)   ! Estimated effective variance
-                                     !   of the size distribution
-      real rsedcloud(ngrid,nlayer) ! Cloud sedimentation radius
-      real rhocloud(ngrid,nlayer)  ! Cloud density (kg.m-3)
-      REAL inertiesoil(ngrid,nsoilmx) ! Time varying subsurface
-                                      ! thermal inertia (J.s-1/2.m-2.K-1)
-                                      ! (used only when tifeedback=.true.)
-c     Variables used by the photochemistry
-      logical :: asis             ! true  : adaptative semi-implicit symmetric (asis) chemical solver
-                                  ! false : euler backward chemical solver
-      REAL surfdust(ngrid,nlayer) ! dust surface area (m2/m3, if photochemistry)
-      REAL surfice(ngrid,nlayer)  !  ice surface area (m2/m3, if photochemistry)
-c     Variables used by the slope model
-      REAL sl_ls, sl_lct, sl_lat
-      REAL sl_tau, sl_alb, sl_the, sl_psi
-      REAL sl_fl0, sl_flu
-      REAL sl_ra, sl_di0
-      REAL sky
-
-      REAL,PARAMETER :: stephan = 5.67e-08 ! Stephan Boltzman constant
-
-c Local variables :
-c -----------------
-
-      REAL CBRT
-      EXTERNAL CBRT
-
-!      CHARACTER*80 fichier 
-      INTEGER l,ig,ierr,igout,iq,tapphys
-
-      REAL fluxsurf_lw(ngrid)      !incident LW (IR) surface flux (W.m-2)
-      REAL fluxsurf_sw(ngrid,2)    !incident SW (solar) surface flux (W.m-2)
-      REAL fluxtop_lw(ngrid)       !Outgoing LW (IR) flux to space (W.m-2)
-      REAL fluxtop_sw(ngrid,2)     !Outgoing SW (solar) flux to space (W.m-2)
-      REAL tauref(ngrid)           ! Reference column optical depth at odpref
-      real,parameter :: odpref=610. ! DOD reference pressure (Pa)
-      REAL tau(ngrid,naerkind)     ! Column dust optical depth at each point
-                                   ! AS: TBD: this one should be in a module !
-      REAL dsodust(ngrid,nlayer)   ! density-scaled opacity (in infrared) 
-      REAL zls                       !  solar longitude (rad)
-      REAL zday                      ! date (time since Ls=0, in martian days)
-      REAL zzlay(ngrid,nlayer)     ! altitude at the middle of the layers
-      REAL zzlev(ngrid,nlayer+1)   ! altitude at layer boundaries
-!      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
-
-c     Tendancies due to various processes:
-      REAL dqsurf(ngrid,nq)
-      REAL zdtlw(ngrid,nlayer)     ! (K/s)
-      REAL zdtsw(ngrid,nlayer)     ! (K/s)
-!      REAL cldtlw(ngrid,nlayer)     ! (K/s) LW heating rate for clear area
-!      REAL cldtsw(ngrid,nlayer)     ! (K/s) SW heating rate for clear area
-      REAL zdtnirco2(ngrid,nlayer) ! (K/s)
-      REAL zdtnlte(ngrid,nlayer)   ! (K/s)
-      REAL zdtsurf(ngrid)            ! (K/s)
-      REAL zdtcloud(ngrid,nlayer)
-      REAL zdvdif(ngrid,nlayer),zdudif(ngrid,nlayer)  ! (m.s-2)
-      REAL zdhdif(ngrid,nlayer), zdtsdif(ngrid)         ! (K/s)
-      REAL zdvadj(ngrid,nlayer),zduadj(ngrid,nlayer)  ! (m.s-2)
-      REAL zdhadj(ngrid,nlayer)                           ! (K/s)
-      REAL zdtgw(ngrid,nlayer)                            ! (K/s)
-      REAL zdugw(ngrid,nlayer),zdvgw(ngrid,nlayer)    ! (m.s-2)
-      REAL zdtc(ngrid,nlayer),zdtsurfc(ngrid)
-      REAL zdvc(ngrid,nlayer),zduc(ngrid,nlayer)
-
-      REAL zdqdif(ngrid,nlayer,nq), zdqsdif(ngrid,nq)
-      REAL zdqsed(ngrid,nlayer,nq), zdqssed(ngrid,nq)
-      REAL zdqdev(ngrid,nlayer,nq), zdqsdev(ngrid,nq)
-      REAL zdqadj(ngrid,nlayer,nq)
-      REAL zdqc(ngrid,nlayer,nq)
-      REAL zdqcloud(ngrid,nlayer,nq)
-      REAL zdqscloud(ngrid,nq)
-      REAL zdqchim(ngrid,nlayer,nq)
-      REAL zdqschim(ngrid,nq)
-
-      REAL zdteuv(ngrid,nlayer)    ! (K/s)
-      REAL zdtconduc(ngrid,nlayer) ! (K/s)
-      REAL zdumolvis(ngrid,nlayer)
-      REAL zdvmolvis(ngrid,nlayer)
-      real zdqmoldiff(ngrid,nlayer,nq)
-
-c     Local variable for local intermediate calcul:
-      REAL zflubid(ngrid)
-      REAL zplanck(ngrid),zpopsk(ngrid,nlayer)
-      REAL zdum1(ngrid,nlayer)
-      REAL zdum2(ngrid,nlayer)
-      REAL ztim1,ztim2,ztim3, z1,z2
-      REAL ztime_fin
-      REAL zdh(ngrid,nlayer)
-      REAL zh(ngrid,nlayer)      ! potential temperature (K)
-      REAL pw(ngrid,nlayer) ! vertical velocity (m/s) (>0 when downwards)
-      INTEGER length
-      PARAMETER (length=100)
-
-c local variables only used for diagnostic (output in file "diagfi" or "stats")
-c -----------------------------------------------------------------------------
-      REAL ps(ngrid), zt(ngrid,nlayer)
-      REAL zu(ngrid,nlayer),zv(ngrid,nlayer)
-      REAL zq(ngrid,nlayer,nq)
-      REAL fluxtop_sw_tot(ngrid), fluxsurf_sw_tot(ngrid)
-      character*2 str2
-!      character*5 str5
-      real zdtdif(ngrid,nlayer), zdtadj(ngrid,nlayer)
-      real rdust(ngrid,nlayer) ! dust geometric mean radius (m)
-      integer igmin, lmin
-      logical tdiag
-
-      real co2col(ngrid)        ! CO2 column
-      ! pplev and pplay are dynamical inputs and must not be modified in the physics.
-      ! instead, use zplay and zplev :
-      REAL zplev(ngrid,nlayer+1),zplay(ngrid,nlayer) 
-!      REAL zstress(ngrid),cd
-      real tmean, zlocal(nlayer)
-      real rho(ngrid,nlayer)  ! density
-      real vmr(ngrid,nlayer)  ! volume mixing ratio
-      real rhopart(ngrid,nlayer) ! number density of a given species
-      real colden(ngrid,nq)     ! vertical column of tracers
-      real mass(nq)             ! global mass of tracers (g)
-      REAL mtot(ngrid)          ! Total mass of water vapor (kg/m2)
-      REAL icetot(ngrid)        ! Total mass of water ice (kg/m2)
-      REAL Nccntot(ngrid)       ! Total number of ccn (nbr/m2)
-      REAL Mccntot(ngrid)       ! Total mass of ccn (kg/m2)
-      REAL rave(ngrid)          ! Mean water ice effective radius (m)
-      REAL opTES(ngrid,nlayer)  ! abs optical depth at 825 cm-1
-      REAL tauTES(ngrid)        ! column optical depth at 825 cm-1
-      REAL Qabsice                ! Water ice absorption coefficient
-      REAL taucloudtes(ngrid)  ! Cloud opacity at infrared
-                               !   reference wavelength using
-                               !   Qabs instead of Qext
-                               !   (direct comparison with TES)
-                               
-      REAL dqdustsurf(ngrid) ! surface q dust flux (kg/m2/s)
-      REAL dndustsurf(ngrid) ! surface n dust flux (number/m2/s)
-      REAL ndust(ngrid,nlayer) ! true n dust (kg/kg)
-      REAL qdust(ngrid,nlayer) ! true q dust (kg/kg)
-      REAL nccn(ngrid,nlayer)  ! true n ccn (kg/kg)
-      REAL qccn(ngrid,nlayer)  ! true q ccn (kg/kg)
-
-c Test 1d/3d scavenging
-      real h2otot(ngrid)
-      REAL satu(ngrid,nlayer)  ! satu ratio for output
-      REAL zqsat(ngrid,nlayer) ! saturation
-
-      REAL,SAVE :: time_phys
-
-! Added for new NLTE scheme
-
-      real co2vmr_gcm(ngrid,nlayer)
-      real n2vmr_gcm(ngrid,nlayer)
-      real ovmr_gcm(ngrid,nlayer)
-      real covmr_gcm(ngrid,nlayer)
-      integer ierr_nlte
-      real*8  varerr
-
-c Variables for PBL
-      REAL zz1(ngrid)
-      REAL lmax_th_out(ngrid)
-      REAL pdu_th(ngrid,nlayer),pdv_th(ngrid,nlayer)
-      REAL pdt_th(ngrid,nlayer),pdq_th(ngrid,nlayer,nq)
-      INTEGER lmax_th(ngrid),dimout,n_out,n
-      CHARACTER(50) zstring
-      REAL dtke_th(ngrid,nlayer+1)
-      REAL zcdv(ngrid), zcdh(ngrid)
-      REAL, ALLOCATABLE, DIMENSION(:,:) :: T_out
-      REAL, ALLOCATABLE, DIMENSION(:,:) :: u_out ! Interpolated teta and u at z_out
-      REAL u_out1(ngrid)
-      REAL T_out1(ngrid)
-      REAL, ALLOCATABLE, DIMENSION(:) :: z_out     ! height of interpolation between z0 and z1 [meters]
-      REAL tstar(ngrid)  ! friction velocity and friction potential temp
-      REAL L_mo(ngrid),vhf(ngrid),vvv(ngrid)
-!      REAL zu2(ngrid)
-
-c=======================================================================
-
-c 1. Initialisation:
-c -----------------
-
-c  1.1   Initialisation only at first call
-c  ---------------------------------------
-      IF (firstcall) THEN
-
-c        variables set to 0
-c        ~~~~~~~~~~~~~~~~~~
-         aerosol(:,:,:)=0
-         dtrad(:,:)=0
-
-#ifndef MESOSCALE
-         fluxrad(:)=0
-         wstar(:)=0.
-#endif
-
-c        read startfi 
-c        ~~~~~~~~~~~~
-#ifndef MESOSCALE
-! GCM. Read netcdf initial physical parameters.
-         CALL phyetat0 ("startfi.nc",0,0,
-     &         nsoilmx,ngrid,nlayer,nq,
-     &         day_ini,time_phys,
-     &         tsurf,tsoil,emis,q2,qsurf,co2ice,tauscaling)
-
-         if (pday.ne.day_ini) then
-           write(*,*) "PHYSIQ: ERROR: bad synchronization between ",
-     &                "physics and dynamics"
-           write(*,*) "dynamics day: ",pday
-           write(*,*) "physics day:  ",day_ini
-           stop
-         endif
-
-         write (*,*) 'In physiq day_ini =', day_ini
-
-#else
-! MESOSCALE. Supposedly everything is already set in modules.
-! So we just check. And we calculate day_ini + two param in dyn3d/control_mod.
-      print*,"check: rad,cpp,g,r,rcp,daysec"
-      print*,rad,cpp,g,r,rcp,daysec
-      PRINT*,'check: tsurf ',tsurf(1),tsurf(ngrid)
-      PRINT*,'check: tsoil ',tsoil(1,1),tsoil(ngrid,nsoilmx)
-      PRINT*,'check: inert ',inertiedat(1,1),inertiedat(ngrid,nsoilmx)
-      PRINT*,'check: midlayer,layer ', mlayer(:),layer(:)
-      PRINT*,'check: tracernames ', noms
-      PRINT*,'check: emis ',emis(1),emis(ngrid)
-      PRINT*,'check: q2 ',q2(1,1),q2(ngrid,nlayer+1)
-      PRINT*,'check: qsurf ',qsurf(1,1),qsurf(ngrid,nq)
-      PRINT*,'check: co2 ',co2ice(1),co2ice(ngrid)
-      day_step=daysec/ptimestep
-      PRINT*,'Call to LMD physics:',day_step,' per Martian day'
-      iphysiq=ptimestep
-      day_ini = pday
-#endif
-
-c        initialize tracers
-c        ~~~~~~~~~~~~~~~~~~
-         tracerdyn=tracer
-         IF (tracer) THEN
-            CALL initracer(ngrid,nq,qsurf)
-         ENDIF  ! end tracer
-
-c        Initialize albedo and orbital calculation
-c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-         CALL surfini(ngrid,co2ice,qsurf,albedo)
-         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
-
-c        initialize soil 
-c        ~~~~~~~~~~~~~~~
-         IF (callsoil) THEN
-c           Thermal inertia feedback:
-            IF (tifeedback) THEN
-                CALL soil_tifeedback(ngrid,nsoilmx,qsurf,inertiesoil)
-                CALL soil(ngrid,nsoilmx,firstcall,inertiesoil,
-     s             ptimestep,tsurf,tsoil,capcal,fluxgrd)
-            ELSE
-                CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
-     s             ptimestep,tsurf,tsoil,capcal,fluxgrd)
-            ENDIF ! of IF (tifeedback)
-         ELSE
-            PRINT*,
-     &     'PHYSIQ WARNING! Thermal conduction in the soil turned off'
-            DO ig=1,ngrid
-               capcal(ig)=1.e5
-               fluxgrd(ig)=0.
-            ENDDO
-         ENDIF
-         icount=1
-
-#ifndef MESOSCALE
-c        Initialize thermospheric parameters
-c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-         if (callthermos) then
-            call fill_data_thermos
-            call allocate_param_thermos(nlayer)
-            call allocate_param_iono(nlayer,nreact)
-            if(solvarmod.eq.0) call param_read
-            if(solvarmod.eq.1) call param_read_e107
-         endif
-#endif
-c        Initialize R and Cp as constant
-
-         if (.not.callthermos .and. .not.photochem) then
-                 do l=1,nlayer
-                  do ig=1,ngrid
-                   rnew(ig,l)=r
-                   cpnew(ig,l)=cpp
-                   mmean(ig,l)=mugaz
-                   enddo
-                  enddo  
-         endif         
-
-         if(callnlte.and.nltemodel.eq.2) call nlte_setup
-         if(callnirco2.and.nircorr.eq.1) call NIR_leedat
-         if(thermochem) call chemthermos_readini
-
-        IF (tracer.AND.water.AND.(ngrid.NE.1)) THEN
-          write(*,*)"physiq: water_param Surface water ice albedo:", 
-     .                  albedo_h2o_ice
-        ENDIF
-
-#ifndef MESOSCALE
-         if (callslope) call getslopes(ngrid,phisfi)
-
-         if (ngrid.ne.1) then ! no need to create a restart file in 1d
-         call physdem0("restartfi.nc",longitude,latitude,
-     &                 nsoilmx,ngrid,nlayer,nq,
-     &                 ptimestep,pday,time_phys,cell_area,
-     &                 albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
-         endif
-#endif
-                   
-      ENDIF        !  (end of "if firstcall")
-
-
-c ---------------------------------------------------
-c 1.2   Initializations done at every physical timestep:
-c ---------------------------------------------------
-c
-
-c     Initialize various variables
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      pdv(:,:)=0
-      pdu(:,:)=0
-      pdt(:,:)=0
-      pdq(:,:,:)=0
-      pdpsrf(:)=0
-      zflubid(:)=0
-      zdtsurf(:)=0
-      dqsurf(:,:)=0
-#ifdef DUSTSTORM
-      pq_tmp(:,:,:)=0
-#endif
-      igout=ngrid/2+1 
-
-
-      zday=pday+ptime ! compute time, in sols (and fraction thereof)
-
-c     Compute Solar Longitude (Ls) :
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      if (season) then
-         call solarlong(zday,zls)
-      else
-         call solarlong(float(day_ini),zls)
-      end if
-
-c     Initialize pressure levels
-c     ~~~~~~~~~~~~~~~~~~
-      zplev(:,:) = pplev(:,:)
-      zplay(:,:) = pplay(:,:)
-      ps(:) = pplev(:,1)
-
-
-c     Compute geopotential at interlayers
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-c     ponderation des altitudes au niveau des couches en dp/p
-
-      DO l=1,nlayer
-         DO ig=1,ngrid
-            zzlay(ig,l)=pphi(ig,l)/g
-         ENDDO
-      ENDDO
-      DO ig=1,ngrid
-         zzlev(ig,1)=0.
-         zzlev(ig,nlayer+1)=1.e7    ! dummy top of last layer above 10000 km...
-      ENDDO
-      DO l=2,nlayer
-         DO ig=1,ngrid
-            z1=(zplay(ig,l-1)+zplev(ig,l))/(zplay(ig,l-1)-zplev(ig,l))
-            z2=(zplev(ig,l)+zplay(ig,l))/(zplev(ig,l)-zplay(ig,l))
-            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
-         ENDDO
-      ENDDO
-
-
-!     Potential temperature calculation not the same in physiq and dynamic
-
-c     Compute potential temperature
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      DO l=1,nlayer
-         DO ig=1,ngrid 
-            zpopsk(ig,l)=(zplay(ig,l)/zplev(ig,1))**rcp
-            zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
-         ENDDO
-      ENDDO
-
-#ifndef MESOSCALE
-c-----------------------------------------------------------------------
-c    1.2.5 Compute mean mass, cp, and R
-c    --------------------------------
-
-      if(photochem.or.callthermos) then
-         call concentrations(ngrid,nlayer,nq,
-     &                       zplay,pt,pdt,pq,pdq,ptimestep)
-      endif
-#endif
-
-      ! Compute vertical velocity (m/s) from vertical mass flux
-      ! w = F / (rho*area) and rho = P/(r*T)
-      ! but first linearly interpolate mass flux to mid-layers
-      do l=1,nlayer-1
-       pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
-      enddo
-      pw(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
-      do l=1,nlayer
-       pw(1:ngrid,l)=(pw(1:ngrid,l)*r*pt(1:ngrid,l)) / 
-     &               (pplay(1:ngrid,l)*cell_area(1:ngrid))
-       ! NB: here we use r and not rnew since this diagnostic comes
-       ! from the dynamics
-      enddo
-
-c-----------------------------------------------------------------------
-c    2. Compute radiative tendencies :
-c------------------------------------
-
-
-      IF (callrad) THEN
-         IF( MOD(icount-1,iradia).EQ.0) THEN
-
-c          Local Solar zenith angle
-c          ~~~~~~~~~~~~~~~~~~~~~~~~
-           CALL orbite(zls,dist_sol,declin)
-
-           IF(diurnal) THEN
-               ztim1=SIN(declin)
-               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
-               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
-
-               CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
-     s         ztim1,ztim2,ztim3, mu0,fract)
-
-           ELSE
-               CALL mucorr(ngrid,declin,latitude,mu0,fract,10000.,rad)
-           ENDIF
-
-c          NLTE cooling from CO2 emission
-c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-           IF(callnlte) then
-              if(nltemodel.eq.0.or.nltemodel.eq.1) then
-                 CALL nltecool(ngrid,nlayer,nq,zplay,pt,pq,zdtnlte)
-              else if(nltemodel.eq.2) then
-                co2vmr_gcm(1:ngrid,1:nlayer)=
-     &                      pq(1:ngrid,1:nlayer,igcm_co2)*
-     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_co2)
-                n2vmr_gcm(1:ngrid,1:nlayer)=
-     &                      pq(1:ngrid,1:nlayer,igcm_n2)*
-     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_n2)
-                covmr_gcm(1:ngrid,1:nlayer)=
-     &                      pq(1:ngrid,1:nlayer,igcm_co)*
-     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_co)
-                ovmr_gcm(1:ngrid,1:nlayer)=
-     &                      pq(1:ngrid,1:nlayer,igcm_o)*
-     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_o)
-                 
-                 CALL nlte_tcool(ngrid,nlayer,zplay*9.869e-6,
-     $                pt,zzlay,co2vmr_gcm, n2vmr_gcm, covmr_gcm, 
-     $                ovmr_gcm,  zdtnlte,ierr_nlte,varerr )
-                 if(ierr_nlte.gt.0) then
-                    write(*,*)
-     $                'WARNING: nlte_tcool output with error message',
-     $                'ierr_nlte=',ierr_nlte,'varerr=',varerr
-                    write(*,*)'I will continue anyway'
-                 endif
-
-                 zdtnlte(1:ngrid,1:nlayer)=
-     &                             zdtnlte(1:ngrid,1:nlayer)/86400.
-              endif
-           else
-              zdtnlte(:,:)=0.
-           endif
-
-c          Find number of layers for LTE radiation calculations
-           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
-     &          CALL nlthermeq(ngrid,nlayer,zplev,zplay)
-
-c          Note: Dustopacity.F has been transferred to callradite.F
-
-#ifdef DUSTSTORM
-!! specific case: save the quantity of dust before adding perturbation
-       if (firstcall) then
-        pq_tmp(1:ngrid,1:nlayer,1)=pq(1:ngrid,1:nlayer,igcm_dust_mass)
-        pq_tmp(1:ngrid,1:nlayer,2)=pq(1:ngrid,1:nlayer,igcm_dust_number)
-       endif
-#endif
-         
-c          Call main radiative transfer scheme
-c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-c          Transfer through CO2 (except NIR CO2 absorption)
-c            and aerosols (dust and water ice)
-
-c          Radiative transfer
-c          ------------------
-
-           CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
-     $     emis,mu0,zplev,zplay,pt,tsurf,fract,dist_sol,igout,
-     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
-     $     tauref,tau,aerosol,dsodust,tauscaling,taucloudtes,rdust,rice,
-     $     nuice,co2ice)
-
-
-#ifdef DUSTSTORM
-!! specific case: compute the added quantity of dust for perturbation
-       if (firstcall) then
-         pdq(1:ngrid,1:nlayer,igcm_dust_mass)= 
-     &      pdq(1:ngrid,1:nlayer,igcm_dust_mass)
-     &      - pq_tmp(1:ngrid,1:nlayer,1)
-     &      + pq(1:ngrid,1:nlayer,igcm_dust_mass)
-         pdq(1:ngrid,1:nlayer,igcm_dust_number)=
-     &      pdq(1:ngrid,1:nlayer,igcm_dust_number)
-     &      - pq_tmp(1:ngrid,1:nlayer,2)
-     &      + pq(1:ngrid,1:nlayer,igcm_dust_number)
-       endif
-#endif
-
-c          Outputs for basic check (middle of domain)
-c          ------------------------------------------
-           write(*,'("Ls =",f11.6," check lat =",f10.6,
-     &               " lon =",f11.6)')
-     &           zls*180./pi,latitude(igout)*180/pi,
-     &                       longitude(igout)*180/pi
-           write(*,'(" tauref(",f4.0," Pa) =",f9.6,
-     &             " tau(",f4.0," Pa) =",f9.6)')
-     &            odpref,tauref(igout),
-     &            odpref,tau(igout,1)*odpref/zplev(igout,1)
-c          ---------------------------------------------------------
-c          Call slope parameterization for direct and scattered flux
-c          ---------------------------------------------------------
-           IF(callslope) THEN
-            print *, 'Slope scheme is on and computing...'
-            DO ig=1,ngrid  
-              sl_the = theta_sl(ig)
-              IF (sl_the .ne. 0.) THEN
-                ztim1=fluxsurf_sw(ig,1)+fluxsurf_sw(ig,2)
-                DO l=1,2
-                 sl_lct = ptime*24. + 180.*longitude(ig)/pi/15.
-                 sl_ra  = pi*(1.0-sl_lct/12.)
-                 sl_lat = 180.*latitude(ig)/pi
-                 sl_tau = tau(ig,1) !il faudrait iaerdust(iaer)
-                 sl_alb = albedo(ig,l)
-                 sl_psi = psi_sl(ig)
-                 sl_fl0 = fluxsurf_sw(ig,l)
-                 sl_di0 = 0.
-                 if (mu0(ig) .gt. 0.) then
-                  sl_di0 = mu0(ig)*(exp(-sl_tau/mu0(ig)))
-                  sl_di0 = sl_di0*1370./dist_sol/dist_sol
-                  sl_di0 = sl_di0/ztim1
-                  sl_di0 = fluxsurf_sw(ig,l)*sl_di0
-                 endif
-                 ! you never know (roundup concern...)
-                 if (sl_fl0 .lt. sl_di0) sl_di0=sl_fl0
-                 !!!!!!!!!!!!!!!!!!!!!!!!!!
-                 CALL param_slope( mu0(ig), declin, sl_ra, sl_lat, 
-     &                             sl_tau, sl_alb, sl_the, sl_psi,
-     &                             sl_di0, sl_fl0, sl_flu )
-                 !!!!!!!!!!!!!!!!!!!!!!!!!!
-                 fluxsurf_sw(ig,l) = sl_flu
-                ENDDO
-              !!! compute correction on IR flux as well
-              sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
-              fluxsurf_lw(ig)= fluxsurf_lw(ig)*sky
-              ENDIF
-            ENDDO
-           ENDIF
-
-c          CO2 near infrared absorption
-c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-           zdtnirco2(:,:)=0
-           if (callnirco2) then
-              call nirco2abs (ngrid,nlayer,zplay,dist_sol,nq,pq,
-     .                       mu0,fract,declin, zdtnirco2)
-           endif
-
-c          Radiative flux from the sky absorbed by the surface (W.m-2)
-c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-           DO ig=1,ngrid
-               fluxrad_sky(ig)=emis(ig)*fluxsurf_lw(ig)
-     $         +fluxsurf_sw(ig,1)*(1.-albedo(ig,1))
-     $         +fluxsurf_sw(ig,2)*(1.-albedo(ig,2))
-           ENDDO
-
-
-c          Net atmospheric radiative heating rate (K.s-1)
-c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-           IF(callnlte) THEN
-              CALL blendrad(ngrid, nlayer, zplay,
-     &             zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
-           ELSE
-              DO l=1,nlayer
-                 DO ig=1,ngrid
-                    dtrad(ig,l)=zdtsw(ig,l)+zdtlw(ig,l)
-     &                          +zdtnirco2(ig,l)
-                  ENDDO
-              ENDDO
-           ENDIF
-
-        ENDIF ! of if(mod(icount-1,iradia).eq.0)
-
-c    Transformation of the radiative tendencies:
-c    -------------------------------------------
-
-c          Net radiative surface flux (W.m-2)
-c          ~~~~~~~~~~~~~~~~~~~~~~~~~~
-c
-           DO ig=1,ngrid
-               zplanck(ig)=tsurf(ig)*tsurf(ig)
-               zplanck(ig)=emis(ig)*
-     $         stephan*zplanck(ig)*zplanck(ig)
-               fluxrad(ig)=fluxrad_sky(ig)-zplanck(ig)
-               IF(callslope) THEN
-                 sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
-                 fluxrad(ig)=fluxrad(ig)+(1.-sky)*zplanck(ig)
-               ENDIF
-           ENDDO
-
-         DO l=1,nlayer
-            DO ig=1,ngrid
-               pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
-            ENDDO
-         ENDDO
-
-      ENDIF ! of IF (callrad)
-
-c-----------------------------------------------------------------------
-c    3. Gravity wave and subgrid scale topography drag :
-c    -------------------------------------------------
-
-
-      IF(calllott)THEN
-
-        CALL calldrag_noro(ngrid,nlayer,ptimestep,
-     &                 zplay,zplev,pt,pu,pv,zdtgw,zdugw,zdvgw)
- 
-        DO l=1,nlayer
-          DO ig=1,ngrid
-            pdv(ig,l)=pdv(ig,l)+zdvgw(ig,l)
-            pdu(ig,l)=pdu(ig,l)+zdugw(ig,l)
-            pdt(ig,l)=pdt(ig,l)+zdtgw(ig,l)
-          ENDDO
-        ENDDO
-      ENDIF
-
-c-----------------------------------------------------------------------
-c    4. Vertical diffusion (turbulent mixing):
-c    -----------------------------------------
-
-      IF (calldifv) THEN
-
-         DO ig=1,ngrid
-            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
-         ENDDO
-
-         zdum1(:,:)=0
-         zdum2(:,:)=0
-         do l=1,nlayer
-            do ig=1,ngrid
-               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
-            enddo
-         enddo
-
-c ----------------------
-c Treatment of a special case : using new surface layer (Richardson based)
-c without using the thermals in gcm and mesoscale can yield problems in
-c weakly unstable situations when winds are near to 0. For those cases, we add
-c a unit subgrid gustiness. Remember that thermals should be used we using the 
-c Richardson based surface layer model.
-        IF ( .not.calltherm 
-     .       .and. callrichsl 
-     .       .and. .not.turb_resolved) THEN
-          DO ig=1, ngrid
-             IF (zh(ig,1) .lt. tsurf(ig)) THEN
-               wstar(ig)=1.
-               hfmax_th(ig)=0.2
-             ELSE
-               wstar(ig)=0.
-               hfmax_th(ig)=0.
-             ENDIF      
-          ENDDO
-        ENDIF
-c ----------------------
-
-         IF (tke_heat_flux .ne. 0.) THEN
-             zz1(:)=(pt(:,1)+pdt(:,1)*ptimestep)*(r/g)*
-     &                 (-alog(zplay(:,1)/zplev(:,1)))
-             pdt(:,1)=pdt(:,1) + (tke_heat_flux/zz1(:))*zpopsk(:,1)
-         ENDIF
-
-c        Calling vdif (Martian version WITH CO2 condensation)
-         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
-     $        ptimestep,capcal,lwrite,
-     $        zplay,zplev,zzlay,zzlev,z0,
-     $        pu,pv,zh,pq,tsurf,emis,qsurf,
-     $        zdum1,zdum2,zdh,pdq,zflubid,
-     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
-     &        zdqdif,zdqsdif,wstar,zcdv,zcdh,hfmax_th,sensibFlux)
-
-
-          DO ig=1,ngrid
-             zdtsurf(ig)=zdtsurf(ig)+zdtsdif(ig)
-          ENDDO
-
-         IF (.not.turb_resolved) THEN
-          DO l=1,nlayer
-            DO ig=1,ngrid
-               pdv(ig,l)=pdv(ig,l)+zdvdif(ig,l)
-               pdu(ig,l)=pdu(ig,l)+zdudif(ig,l)
-               pdt(ig,l)=pdt(ig,l)+zdhdif(ig,l)*zpopsk(ig,l)
-
-               zdtdif(ig,l)=zdhdif(ig,l)*zpopsk(ig,l) ! for diagnostic only
-            ENDDO
-          ENDDO
-
-          if (tracer) then
-           DO iq=1, nq
-            DO l=1,nlayer
-              DO ig=1,ngrid
-                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdif(ig,l,iq) 
-              ENDDO
-            ENDDO
-           ENDDO
-           DO iq=1, nq
-              DO ig=1,ngrid
-                 dqsurf(ig,iq)=dqsurf(ig,iq) + zdqsdif(ig,iq)
-              ENDDO
-           ENDDO
-          end if ! of if (tracer)
-         ELSE
-           write (*,*) '******************************************'
-           write (*,*) '** LES mode: the difv part is only used to'
-           write (*,*) '**  - provide HFX and UST to the dynamics'
-           write (*,*) '**  - update TSURF'
-           write (*,*) '******************************************'
-           !! Specific treatment for lifting in turbulent-resolving mode (AC)
-           IF (lifting .and. doubleq) THEN
-             !! lifted dust is injected in the first layer. 
-             !! Sedimentation must be called after turbulent mixing, i.e. on next step, after WRF. 
-             !! => lifted dust is not incremented before the sedimentation step.
-             zdqdif(1:ngrid,1,1:nq)=0.
-             zdqdif(1:ngrid,1,igcm_dust_number) = 
-     .                  -zdqsdif(1:ngrid,igcm_dust_number)
-             zdqdif(1:ngrid,1,igcm_dust_mass) = 
-     .                  -zdqsdif(1:ngrid,igcm_dust_mass)
-             zdqdif(1:ngrid,2:nlayer,1:nq) = 0.
-             DO iq=1, nq
-              IF ((iq .ne. igcm_dust_mass)
-     &        .and. (iq .ne. igcm_dust_number)) THEN
-                zdqsdif(:,iq)=0.
-              ENDIF
-             ENDDO
-           ELSE
-             zdqdif(1:ngrid,1:nlayer,1:nq) = 0.
-             zdqsdif(1:ngrid,1:nq) = 0.
-           ENDIF
-         ENDIF
-      ELSE    
-         DO ig=1,ngrid
-            zdtsurf(ig)=zdtsurf(ig)+
-     s        (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
-         ENDDO
-         IF (turb_resolved) THEN
-            write(*,*) 'Turbulent-resolving mode !' 
-            write(*,*) 'Please set calldifv to T in callphys.def'
-            STOP
-         ENDIF
-      ENDIF ! of IF (calldifv)
-
-c-----------------------------------------------------------------------
-c   5. Thermals :
-c   -----------------------------
-
-      if(calltherm .and. .not.turb_resolved) then
- 
-        call calltherm_interface(ngrid,nlayer,nq,
-     $ tracer,igcm_co2,
-     $ zzlev,zzlay,
-     $ ptimestep,pu,pv,pt,pq,pdu,pdv,pdt,pdq,q2,
-     $ zplay,zplev,pphi,zpopsk,
-     $ pdu_th,pdv_th,pdt_th,pdq_th,lmax_th,zmax_th,
-     $ dtke_th,zdhdif,hfmax_th,wstar,sensibFlux)
-     
-         DO l=1,nlayer
-           DO ig=1,ngrid
-              pdu(ig,l)=pdu(ig,l)+pdu_th(ig,l)
-              pdv(ig,l)=pdv(ig,l)+pdv_th(ig,l)
-              pdt(ig,l)=pdt(ig,l)+pdt_th(ig,l)
-              q2(ig,l)=q2(ig,l)+dtke_th(ig,l)*ptimestep
-           ENDDO
-        ENDDO
- 
-        DO ig=1,ngrid
-          q2(ig,nlayer+1)=q2(ig,nlayer+1)+dtke_th(ig,nlayer+1)*ptimestep
-        ENDDO      
-    
-        if (tracer) then
-        DO iq=1,nq
-         DO l=1,nlayer
-           DO ig=1,ngrid
-             pdq(ig,l,iq)=pdq(ig,l,iq)+pdq_th(ig,l,iq)
-           ENDDO
-         ENDDO
-        ENDDO
-        endif
-
-        lmax_th_out(:)=real(lmax_th(:))
-
-      else   !of if calltherm
-        lmax_th(:)=0
-        wstar(:)=0.
-        hfmax_th(:)=0.
-        lmax_th_out(:)=0.
-      end if
-
-c-----------------------------------------------------------------------
-c   5. Dry convective adjustment:
-c   -----------------------------
-
-      IF(calladj) THEN
-
-         DO l=1,nlayer
-            DO ig=1,ngrid
-               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
-            ENDDO
-         ENDDO
-         zduadj(:,:)=0
-         zdvadj(:,:)=0
-         zdhadj(:,:)=0
-
-         CALL convadj(ngrid,nlayer,nq,ptimestep,
-     $                zplay,zplev,zpopsk,lmax_th,
-     $                pu,pv,zh,pq,
-     $                pdu,pdv,zdh,pdq,
-     $                zduadj,zdvadj,zdhadj,
-     $                zdqadj)
-
-
-         DO l=1,nlayer
-            DO ig=1,ngrid
-               pdu(ig,l)=pdu(ig,l)+zduadj(ig,l)
-               pdv(ig,l)=pdv(ig,l)+zdvadj(ig,l)
-               pdt(ig,l)=pdt(ig,l)+zdhadj(ig,l)*zpopsk(ig,l)
-
-               zdtadj(ig,l)=zdhadj(ig,l)*zpopsk(ig,l) ! for diagnostic only
-            ENDDO
-         ENDDO
-
-         if(tracer) then 
-           DO iq=1, nq
-            DO l=1,nlayer
-              DO ig=1,ngrid
-                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqadj(ig,l,iq) 
-              ENDDO
-            ENDDO
-           ENDDO
-         end if
-      ENDIF ! of IF(calladj)
-
-
-
-c-----------------------------------------------------------------------
-c   6. Specific parameterizations for tracers 
-c:   -----------------------------------------
-
-      if (tracer) then 
-
-c   6a. Water and ice
-c     ---------------
-
-c        ---------------------------------------
-c        Water ice condensation in the atmosphere
-c        ----------------------------------------
-         IF (water) THEN
-
-           call watercloud(ngrid,nlayer,ptimestep,
-     &                zplev,zplay,pdpsrf,zzlay, pt,pdt,
-     &                pq,pdq,zdqcloud,zdtcloud,
-     &                nq,tau,tauscaling,rdust,rice,nuice,
-     &                rsedcloud,rhocloud)
-     
-c Temperature variation due to latent heat release
-           if (activice) then
-               pdt(1:ngrid,1:nlayer) = 
-     &          pdt(1:ngrid,1:nlayer) + 
-     &          zdtcloud(1:ngrid,1:nlayer)
-           endif
-           
-! increment water vapour and ice atmospheric tracers tendencies
-           pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = 
-     &       pdq(1:ngrid,1:nlayer,igcm_h2o_vap) + 
-     &       zdqcloud(1:ngrid,1:nlayer,igcm_h2o_vap)
-           pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = 
-     &       pdq(1:ngrid,1:nlayer,igcm_h2o_ice) + 
-     &       zdqcloud(1:ngrid,1:nlayer,igcm_h2o_ice)
-
-! increment dust and ccn masses and numbers
-! We need to check that we have Nccn & Ndust > 0
-! This is due to single precision rounding problems
-           if (microphys) then
-             pdq(1:ngrid,1:nlayer,igcm_ccn_mass) = 
-     &         pdq(1:ngrid,1:nlayer,igcm_ccn_mass) + 
-     &         zdqcloud(1:ngrid,1:nlayer,igcm_ccn_mass)
-             pdq(1:ngrid,1:nlayer,igcm_ccn_number) = 
-     &         pdq(1:ngrid,1:nlayer,igcm_ccn_number) + 
-     &         zdqcloud(1:ngrid,1:nlayer,igcm_ccn_number)
-             where (pq(:,:,igcm_ccn_mass) + 
-     &       ptimestep*pdq(:,:,igcm_ccn_mass) < 0.)
-               pdq(:,:,igcm_ccn_mass) = 
-     &         - pq(:,:,igcm_ccn_mass)/ptimestep + 1.e-30
-               pdq(:,:,igcm_ccn_number) = 
-     &         - pq(:,:,igcm_ccn_number)/ptimestep + 1.e-30
-             end where
-             where (pq(:,:,igcm_ccn_number) + 
-     &       ptimestep*pdq(:,:,igcm_ccn_number) < 0.)
-               pdq(:,:,igcm_ccn_mass) = 
-     &         - pq(:,:,igcm_ccn_mass)/ptimestep + 1.e-30
-               pdq(:,:,igcm_ccn_number) = 
-     &         - pq(:,:,igcm_ccn_number)/ptimestep + 1.e-30
-             end where
-           endif
-
-           if (scavenging) then
-             pdq(1:ngrid,1:nlayer,igcm_dust_mass) = 
-     &         pdq(1:ngrid,1:nlayer,igcm_dust_mass) + 
-     &         zdqcloud(1:ngrid,1:nlayer,igcm_dust_mass)
-             pdq(1:ngrid,1:nlayer,igcm_dust_number) = 
-     &         pdq(1:ngrid,1:nlayer,igcm_dust_number) + 
-     &         zdqcloud(1:ngrid,1:nlayer,igcm_dust_number)
-             where (pq(:,:,igcm_dust_mass) + 
-     &       ptimestep*pdq(:,:,igcm_dust_mass) < 0.)
-               pdq(:,:,igcm_dust_mass) = 
-     &         - pq(:,:,igcm_dust_mass)/ptimestep + 1.e-30
-               pdq(:,:,igcm_dust_number) = 
-     &         - pq(:,:,igcm_dust_number)/ptimestep + 1.e-30
-             end where
-             where (pq(:,:,igcm_dust_number) + 
-     &       ptimestep*pdq(:,:,igcm_dust_number) < 0.)
-               pdq(:,:,igcm_dust_mass) = 
-     &         - pq(:,:,igcm_dust_mass)/ptimestep + 1.e-30
-               pdq(:,:,igcm_dust_number) = 
-     &         - pq(:,:,igcm_dust_number)/ptimestep + 1.e-30
-             end where
-           endif ! of if scavenging
-                      
-
-         END IF  ! of IF (water)
-
-c   6b. Aerosol particles
-c     -------------------
-
-c        ----------
-c        Dust devil :
-c        ----------
-         IF(callddevil) then 
-           call dustdevil(ngrid,nlayer,nq, zplev,pu,pv,pt, tsurf,q2,
-     &                zdqdev,zdqsdev)
- 
-           if (dustbin.ge.1) then
-              do iq=1,nq
-                 DO l=1,nlayer
-                    DO ig=1,ngrid
-                       pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdev(ig,l,iq)
-                    ENDDO
-                 ENDDO
-              enddo
-              do iq=1,nq
-                 DO ig=1,ngrid
-                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqsdev(ig,iq)
-                 ENDDO
-              enddo
-           endif  ! of if (dustbin.ge.1)
-
-         END IF ! of IF (callddevil)
-
-c        ------------- 
-c        Sedimentation :   acts also on water ice
-c        ------------- 
-         IF (sedimentation) THEN 
-           zdqsed(1:ngrid,1:nlayer,1:nq)=0
-           zdqssed(1:ngrid,1:nq)=0
-
-           call callsedim(ngrid,nlayer, ptimestep,
-     &                zplev,zzlev, zzlay, pt, pdt, rdust, rice,
-     &                rsedcloud,rhocloud,
-     &                pq, pdq, zdqsed, zdqssed,nq, 
-     &                tau,tauscaling)
-
-           DO iq=1, nq
-             DO l=1,nlayer
-               DO ig=1,ngrid
-                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqsed(ig,l,iq)
-               ENDDO
-             ENDDO
-           ENDDO
-           DO iq=1, nq
-             DO ig=1,ngrid
-                dqsurf(ig,iq)= dqsurf(ig,iq) + zdqssed(ig,iq)
-             ENDDO
-           ENDDO
-         END IF   ! of IF (sedimentation)
-        
-c Add lifted dust to tendancies after sedimentation in the LES (AC)
-      IF (turb_resolved) THEN
-           DO iq=1, nq
-            DO l=1,nlayer
-              DO ig=1,ngrid
-                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdif(ig,l,iq)
-              ENDDO
-            ENDDO
-           ENDDO
-           DO iq=1, nq
-              DO ig=1,ngrid
-                 dqsurf(ig,iq)=dqsurf(ig,iq) + zdqsdif(ig,iq)
-              ENDDO
-           ENDDO
-      ENDIF
-
-c
-c   6c. Chemical species
-c     ------------------
-
-#ifndef MESOSCALE
-c        --------------
-c        photochemistry :
-c        --------------
-         IF (photochem .or. thermochem) then
-
-!           dust and ice surface area
-            call surfacearea(ngrid, nlayer, naerkind,
-     $                       ptimestep, zplay, zzlay, 
-     $                       pt, pq, pdq, nq, 
-     $                       rdust, rice, tau, tauscaling, 
-     $                       surfdust, surfice)
-!           call photochemistry
-
-            asis = .false.
-
-            if (asis) then
-            call calchim_asis(ngrid,nlayer,nq,
-     &                   ptimestep,zplay,zplev,pt,pdt,dist_sol,mu0,
-     $                   zzlev,zzlay,zday,pq,pdq,zdqchim,zdqschim,
-     $                   zdqcloud,zdqscloud,tauref,co2ice,
-     $                   pu,pdu,pv,pdv,surfdust,surfice)
-            else
-            call calchim(ngrid,nlayer,nq,
-     &                   ptimestep,zplay,zplev,pt,pdt,dist_sol,mu0,
-     $                   zzlev,zzlay,zday,pq,pdq,zdqchim,zdqschim,
-     $                   zdqcloud,zdqscloud,tauref,co2ice,
-     $                   pu,pdu,pv,pdv,surfdust,surfice)
-            end if
-
-           ! increment values of tracers:
-           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
-                      ! tracers is zero anyways
-             DO l=1,nlayer
-               DO ig=1,ngrid
-                 pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iq)
-               ENDDO
-             ENDDO
-           ENDDO ! of DO iq=1,nq
-           
-           ! add condensation tendency for H2O2
-           if (igcm_h2o2.ne.0) then
-             DO l=1,nlayer
-               DO ig=1,ngrid
-                 pdq(ig,l,igcm_h2o2)=pdq(ig,l,igcm_h2o2)
-     &                                +zdqcloud(ig,l,igcm_h2o2)
-               ENDDO
-             ENDDO
-           endif
-
-           ! increment surface values of tracers:
-           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
-                      ! tracers is zero anyways
-             DO ig=1,ngrid
-               dqsurf(ig,iq)=dqsurf(ig,iq)+zdqschim(ig,iq)
-             ENDDO
-           ENDDO ! of DO iq=1,nq
-
-           ! add condensation tendency for H2O2
-           if (igcm_h2o2.ne.0) then
-             DO ig=1,ngrid
-               dqsurf(ig,igcm_h2o2)=dqsurf(ig,igcm_h2o2)
-     &                                +zdqscloud(ig,igcm_h2o2)
-             ENDDO
-           endif
-
-         END IF  ! of IF (photochem.or.thermochem)
-#endif
-
-c   6d. Updates
-c     ---------
-
-        DO iq=1, nq
-          DO ig=1,ngrid
-
-c       ---------------------------------
-c       Updating tracer budget on surface
-c       ---------------------------------
-            qsurf(ig,iq)=qsurf(ig,iq)+ptimestep*dqsurf(ig,iq)
-
-          ENDDO  ! (ig)
-        ENDDO    ! (iq)
-
-      endif !  of if (tracer) 
-
-#ifndef MESOSCALE
-c-----------------------------------------------------------------------
-c   7. THERMOSPHERE CALCULATION
-c-----------------------------------------------------------------------
-
-      if (callthermos) then
-        call thermosphere(ngrid,nlayer,nq,zplev,zplay,dist_sol,
-     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
-     &     pt,pq,pu,pv,pdt,pdq,
-     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
-
-        DO l=1,nlayer
-          DO ig=1,ngrid
-            dtrad(ig,l)=dtrad(ig,l)+zdteuv(ig,l)
-            pdt(ig,l)=pdt(ig,l)+zdtconduc(ig,l)
-     &                         +zdteuv(ig,l)
-            pdv(ig,l)=pdv(ig,l)+zdvmolvis(ig,l)
-            pdu(ig,l)=pdu(ig,l)+zdumolvis(ig,l)
-            DO iq=1, nq
-              pdq(ig,l,iq)=pdq(ig,l,iq)+zdqmoldiff(ig,l,iq)
-            ENDDO
-          ENDDO
-        ENDDO
-
-      endif ! of if (callthermos)
-#endif
-
-c-----------------------------------------------------------------------
-c   8. Carbon dioxide condensation-sublimation:
-c     (should be the last atmospherical physical process to be computed)
-c   -------------------------------------------
-
-      IF (tituscap) THEN
-         !!! get the actual co2 seasonal cap from Titus observations
-         CALL geticecover( ngrid, 180.*zls/pi,
-     .                  180.*longitude/pi, 180.*latitude/pi, co2ice )
-         co2ice = co2ice * 10000.
-      ENDIF
-      
-      
-      pdpsrf(:) = 0
-
-      IF (callcond) THEN
-         CALL newcondens(ngrid,nlayer,nq,ptimestep,
-     $              capcal,zplay,zplev,tsurf,pt,
-     $              pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq,
-     $              co2ice,albedo,emis,
-     $              zdtc,zdtsurfc,pdpsrf,zduc,zdvc,zdqc,
-     $              fluxsurf_sw,zls) 
-
-         DO l=1,nlayer
-           DO ig=1,ngrid
-             pdt(ig,l)=pdt(ig,l)+zdtc(ig,l)
-             pdv(ig,l)=pdv(ig,l)+zdvc(ig,l)
-             pdu(ig,l)=pdu(ig,l)+zduc(ig,l)
-           ENDDO
-         ENDDO
-         DO ig=1,ngrid
-            zdtsurf(ig) = zdtsurf(ig) + zdtsurfc(ig)
-         ENDDO
-
-         IF (tracer) THEN
-           DO iq=1, nq
-            DO l=1,nlayer
-              DO ig=1,ngrid
-                pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqc(ig,l,iq) 
-              ENDDO
-            ENDDO
-           ENDDO
-         ENDIF ! of IF (tracer)
-
-#ifndef MESOSCALE
-        ! update surface pressure
-        DO ig=1,ngrid
-          ps(ig) = zplev(ig,1) + pdpsrf(ig)*ptimestep
-        ENDDO
-        
-        ! update pressure levels
-        DO l=1,nlayer
-         DO ig=1,ngrid
-          zplay(ig,l) = aps(l) + bps(l)*ps(ig)
-          zplev(ig,l) = ap(l)  + bp(l)*ps(ig)
-         ENDDO
-        ENDDO
-        zplev(:,nlayer+1) = 0.
-        
-        ! update layers altitude
-        DO l=2,nlayer
-          DO ig=1,ngrid
-           z1=(zplay(ig,l-1)+zplev(ig,l))/(zplay(ig,l-1)-zplev(ig,l))
-           z2=(zplev(ig,l)+zplay(ig,l))/(zplev(ig,l)-zplay(ig,l))
-           zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
-          ENDDO
-        ENDDO
-#endif
-      
-      ENDIF  ! of IF (callcond)
-      
-
-c-----------------------------------------------------------------------
-c   9. Surface  and sub-surface soil temperature
-c-----------------------------------------------------------------------
-c
-c
-c   9.1 Increment Surface temperature:
-c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-      DO ig=1,ngrid
-         tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 
-      ENDDO
-
-c  Prescribe a cold trap at south pole (except at high obliquity !!)
-c  Temperature at the surface is set there to be the temperature
-c  corresponding to equilibrium temperature between phases of CO2
-
-
-      IF (tracer.AND.water.AND.(ngrid.NE.1)) THEN
-!#ifndef MESOSCALE 
-!         if (caps.and.(obliquit.lt.27.)) then => now done in newcondens
-           ! NB: Updated surface pressure, at grid point 'ngrid', is
-           !     ps(ngrid)=zplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
-!           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
-!     &                     (zplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
-!           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*ps(ngrid)))
-!         endif
-!#endif
-c       -------------------------------------------------------------
-c       Change of surface albedo in case of ground frost
-c       everywhere except on the north permanent cap and in regions
-c       covered by dry ice. 
-c              ALWAYS PLACE these lines after newcondens !!!
-c       -------------------------------------------------------------
-         do ig=1,ngrid
-           if ((co2ice(ig).eq.0).and.
-     &        (qsurf(ig,igcm_h2o_ice).gt.frost_albedo_threshold)) then
-              albedo(ig,1) = albedo_h2o_ice
-              albedo(ig,2) = albedo_h2o_ice
-c              write(*,*) "frost thickness", qsurf(ig,igcm_h2o_ice)
-c              write(*,*) "physiq.F frost :"
-c     &        ,latitude(ig)*180./pi, longitude(ig)*180./pi
-           endif
-         enddo  ! of do ig=1,ngrid
-      ENDIF  ! of IF (tracer.AND.water.AND.(ngrid.NE.1))
-
-c
-c   9.2 Compute soil temperatures and subsurface heat flux:
-c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      IF (callsoil) THEN
-c       Thermal inertia feedback
-        IF (tifeedback) THEN
-         CALL soil_tifeedback(ngrid,nsoilmx,qsurf,inertiesoil)
-         CALL soil(ngrid,nsoilmx,.false.,inertiesoil,
-     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
-        ELSE
-         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
-     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
-        ENDIF
-      ENDIF
-      
-
-c-----------------------------------------------------------------------
-c  10. Write output files
-c  ----------------------
-
-c    -------------------------------
-c    Dynamical fields incrementation
-c    -------------------------------
-c (FOR OUTPUT ONLY : the actual model integration is performed in the dynamics)
-      ! temperature, zonal and meridional wind
-      DO l=1,nlayer
-        DO ig=1,ngrid
-          zt(ig,l)=pt(ig,l)  + pdt(ig,l)*ptimestep
-          zu(ig,l)=pu(ig,l)  + pdu(ig,l)*ptimestep
-          zv(ig,l)=pv(ig,l)  + pdv(ig,l)*ptimestep
-        ENDDO
-      ENDDO
-
-      ! tracers
-      DO iq=1, nq
-        DO l=1,nlayer
-          DO ig=1,ngrid
-            zq(ig,l,iq)=pq(ig,l,iq) +pdq(ig,l,iq)*ptimestep
-          ENDDO
-        ENDDO
-      ENDDO
-
-      ! Density 
-      DO l=1,nlayer
-         DO ig=1,ngrid
-            rho(ig,l) = zplay(ig,l)/(rnew(ig,l)*zt(ig,l))
-         ENDDO
-      ENDDO
-
-      ! Potential Temperature
-
-       DO ig=1,ngrid
-          DO l=1,nlayer
-              zh(ig,l) = zt(ig,l)*(zplev(ig,1)/zplay(ig,l))**rcp
-          ENDDO
-       ENDDO
-
-
-c    Compute surface stress : (NB: z0 is a common in surfdat.h)
-c     DO ig=1,ngrid
-c        cd = (0.4/log(zzlay(ig,1)/z0(ig)))**2
-c        zstress(ig) = rho(ig,1)*cd*(zu(ig,1)**2 + zv(ig,1)**2)
-c     ENDDO
-
-c     Sum of fluxes in solar spectral bands (for output only)
-      DO ig=1,ngrid
-             fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
-             fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
-      ENDDO
-c ******* TEST ******************************************************
-      ztim1 = 999
-      DO l=1,nlayer
-        DO ig=1,ngrid
-           if (pt(ig,l).lt.ztim1) then
-               ztim1 = pt(ig,l)
-               igmin = ig
-               lmin = l 
-           end if
-        ENDDO
-      ENDDO
-      if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then
-        write(*,*) 'PHYSIQ: stability WARNING :'
-        write(*,*) 'pt, zt Tmin = ', pt(igmin,lmin), zt(igmin,lmin),
-     &              'ig l =', igmin, lmin
-      end if
-c *******************************************************************
-
-c     ---------------------
-c     Outputs to the screen 
-c     ---------------------
-
-      IF (lwrite) THEN
-         PRINT*,'Global diagnostics for the physics'
-         PRINT*,'Variables and their increments x and dx/dt * dt'
-         WRITE(*,'(a6,a10,2a15)') 'Ts','dTs','ps','dps'
-         WRITE(*,'(2f10.5,2f15.5)')
-     s   tsurf(igout),zdtsurf(igout)*ptimestep,
-     s   zplev(igout,1),pdpsrf(igout)*ptimestep
-         WRITE(*,'(a4,a6,5a10)') 'l','u','du','v','dv','T','dT'
-         WRITE(*,'(i4,6f10.5)') (l,
-     s   pu(igout,l),pdu(igout,l)*ptimestep,
-     s   pv(igout,l),pdv(igout,l)*ptimestep,
-     s   pt(igout,l),pdt(igout,l)*ptimestep,
-     s   l=1,nlayer)
-      ENDIF ! of IF (lwrite)
-
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-c        INTERPOLATIONS IN THE SURFACE-LAYER
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-
-           n_out=0 ! number of elements in the z_out array.
-                   ! for z_out=[3.,2.,1.,0.5,0.1], n_out must be set
-                   ! to 5
-           IF (n_out .ne. 0) THEN
-
-           IF(.NOT. ALLOCATED(z_out)) ALLOCATE(z_out(n_out))
-           IF(.NOT. ALLOCATED(T_out)) ALLOCATE(T_out(ngrid,n_out))
-           IF(.NOT. ALLOCATED(u_out)) ALLOCATE(u_out(ngrid,n_out))
-
-           z_out(:)=[3.,2.,1.,0.5,0.1]
-           u_out(:,:)=0.
-           T_out(:,:)=0.
-
-           call pbl_parameters(ngrid,nlayer,ps,zplay,z0,
-     & g,zzlay,zzlev,zu,zv,wstar,hfmax_th,zmax_th,tsurf,zh,z_out,n_out,
-     & T_out,u_out,ustar,tstar,L_mo,vhf,vvv)
-                   ! pourquoi ustar recalcule ici? fait dans vdifc.
-
-#ifndef MESOSCALE
-            IF (ngrid .eq. 1) THEN
-               dimout=0
-            ELSE
-               dimout=2
-            ENDIF
-            DO n=1,n_out
-               write(zstring, '(F8.6)') z_out(n)
-               call WRITEDIAGFI(ngrid,'T_out_'//trim(zstring),
-     &   'potential temperature at z_out','K',dimout,T_out(:,n))
-               call WRITEDIAGFI(ngrid,'u_out_'//trim(zstring),
-     &   'horizontal velocity norm at z_out','m/s',dimout,u_out(:,n))
-            ENDDO
-            call WRITEDIAGFI(ngrid,'u_star',
-     &   'friction velocity','m/s',dimout,ustar)
-            call WRITEDIAGFI(ngrid,'teta_star',
-     &   'friction potential temperature','K',dimout,tstar)
-!            call WRITEDIAGFI(ngrid,'L',
-!     &   'Monin Obukhov length','m',dimout,L_mo)
-            call WRITEDIAGFI(ngrid,'vvv',
-     &   'Vertical velocity variance at zout','m',dimout,vvv)
-            call WRITEDIAGFI(ngrid,'vhf',
-     &   'Vertical heat flux at zout','m',dimout,vhf)
-#else
-         T_out1(:)=T_out(:,1)
-         u_out1(:)=u_out(:,1)
-#endif
-
-         ENDIF
-
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-c        END OF SURFACE LAYER INTERPOLATIONS
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-
-      IF (ngrid.NE.1) THEN
-
-#ifndef MESOSCALE
-c        -------------------------------------------------------------------
-c        Writing NetCDF file  "RESTARTFI" at the end of the run
-c        -------------------------------------------------------------------
-c        Note: 'restartfi' is stored just before dynamics are stored
-c              in 'restart'. Between now and the writting of 'restart',
-c              there will have been the itau=itau+1 instruction and
-c              a reset of 'time' (lastacll = .true. when itau+1= itaufin)
-c              thus we store for time=time+dtvr
-
-         IF(   ((ecritstart.GT.0) .and. 
-     .          (MOD(icount*iphysiq,ecritstart).EQ.0)) 
-     .    .or. lastcall  ) THEN
-         
-          ztime_fin = pday + ptime  + ptimestep/(float(iphysiq)*daysec)
-     .               - day_ini - time_phys
-          print*, pday,ptime,day_ini, time_phys
-          write(*,'(A,I7,A,F12.5)') 
-     .         'PHYSIQ: Ecriture du fichier restartfi ; icount=',
-     .          icount,' date=',ztime_fin
-            
-            
-          call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq,
-     .                ptimestep,ztime_fin,
-     .                tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
-          
-         ENDIF
-#endif
-
-c        -------------------------------------------------------------------
-c        Calculation of diagnostic variables written in both stats and
-c          diagfi files
-c        -------------------------------------------------------------------
-
-         if (tracer) then
-         
-           if(doubleq) then
-              do ig=1,ngrid 
-                dqdustsurf(ig) = 
-     &                zdqssed(ig,igcm_dust_mass)*tauscaling(ig)
-                dndustsurf(ig) = 
-     &                zdqssed(ig,igcm_dust_number)*tauscaling(ig)
-                ndust(ig,:) =
-     &                pq(ig,:,igcm_dust_number)*tauscaling(ig)
-                qdust(ig,:) =
-     &                pq(ig,:,igcm_dust_mass)*tauscaling(ig)
-              enddo
-              if (scavenging) then
-                do ig=1,ngrid 
-                  dqdustsurf(ig) = dqdustsurf(ig) + 
-     &                     zdqssed(ig,igcm_ccn_mass)*tauscaling(ig)
-                  dndustsurf(ig) = dndustsurf(ig) + 
-     &                     zdqssed(ig,igcm_ccn_number)*tauscaling(ig)
-                  nccn(ig,:) =
-     &                     pq(ig,:,igcm_ccn_number)*tauscaling(ig)
-                  qccn(ig,:) =
-     &                     pq(ig,:,igcm_ccn_mass)*tauscaling(ig)
-                enddo
-              endif
-           endif
-                    
-           if (water) then
-             mtot(:)=0
-             icetot(:)=0
-             rave(:)=0
-             tauTES(:)=0
-             do ig=1,ngrid 
-               do l=1,nlayer
-                 mtot(ig) = mtot(ig) + 
-     &                      zq(ig,l,igcm_h2o_vap) * 
-     &                      (zplev(ig,l) - zplev(ig,l+1)) / g
-                 icetot(ig) = icetot(ig) + 
-     &                        zq(ig,l,igcm_h2o_ice) * 
-     &                        (zplev(ig,l) - zplev(ig,l+1)) / g
-c                Computing abs optical depth at 825 cm-1 in each
-c                  layer to simulate NEW TES retrieval
-                 Qabsice = min(
-     &             max(0.4e6*rice(ig,l)*(1.+nuice_ref)-0.05 ,0.),1.2
-     &                        )
-                 opTES(ig,l)= 0.75 * Qabsice * 
-     &             zq(ig,l,igcm_h2o_ice) *
-     &             (zplev(ig,l) - zplev(ig,l+1)) / g
-     &             / (rho_ice * rice(ig,l) * (1.+nuice_ref))
-                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
-               enddo
-c              rave(ig)=rave(ig)/max(icetot(ig),1.e-30)       ! mass weight
-c               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
-             enddo
-             call watersat(ngrid*nlayer,zt,zplay,zqsat)
-             satu(:,:) = zq(:,:,igcm_h2o_vap)/zqsat(:,:)
-
-             if (scavenging) then
-               Nccntot(:)= 0
-               Mccntot(:)= 0
-               rave(:)=0
-               do ig=1,ngrid 
-                 do l=1,nlayer
-                    Nccntot(ig) = Nccntot(ig) + 
-     &              zq(ig,l,igcm_ccn_number)*tauscaling(ig)
-     &              *(zplev(ig,l) - zplev(ig,l+1)) / g
-                    Mccntot(ig) = Mccntot(ig) + 
-     &              zq(ig,l,igcm_ccn_mass)*tauscaling(ig)
-     &              *(zplev(ig,l) - zplev(ig,l+1)) / g
-cccc Column integrated effective ice radius 
-cccc is weighted by total ice surface area (BETTER than total ice mass) 
-                    rave(ig) = rave(ig) + 
-     &                      tauscaling(ig) *
-     &                      zq(ig,l,igcm_ccn_number) *
-     &                      (zplev(ig,l) - zplev(ig,l+1)) / g * 
-     &                      rice(ig,l) * rice(ig,l)*  (1.+nuice_ref)
-                 enddo
-               rave(ig)=(icetot(ig)/rho_ice+Mccntot(ig)/rho_dust)*0.75
-     &                  /max(pi*rave(ig),1.e-30) ! surface weight
-               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
-               enddo
-             else ! of if (scavenging)
-               rave(:)=0
-               do ig=1,ngrid 
-                 do l=1,nlayer
-                 rave(ig) = rave(ig) + 
-     &                      zq(ig,l,igcm_h2o_ice) *
-     &                      (zplev(ig,l) - zplev(ig,l+1)) / g * 
-     &                      rice(ig,l) * (1.+nuice_ref)
-                 enddo
-                 rave(ig) = max(rave(ig) / 
-     &             max(icetot(ig),1.e-30),1.e-30) ! mass weight
-               enddo
-             endif ! of if (scavenging)
-
-           endif ! of if (water)
-         endif ! of if (tracer)
-
-#ifndef MESOSCALE
-c        -----------------------------------------------------------------
-c        WSTATS: Saving statistics
-c        -----------------------------------------------------------------
-c        ("stats" stores and accumulates 8 key variables in file "stats.nc"
-c        which can later be used to make the statistic files of the run:
-c        "stats")          only possible in 3D runs !
-         
-       IF (callstats) THEN
-
-        call wstats(ngrid,"ps","Surface pressure","Pa",2,ps)
-        call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf)
-        call wstats(ngrid,"co2ice","CO2 ice cover",
-     &                "kg.m-2",2,co2ice)
-        call wstats(ngrid,"tauref","reference dod at 610 Pa","NU",
-     &                2,tauref)
-        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,"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,"rho","Atmospheric density","kg/m3",3,rho)
-        call wstats(ngrid,"pressure","Pressure","Pa",3,zplay)
-          call wstats(ngrid,"q2",
-     &                "Boundary layer eddy kinetic energy",
-     &                "m2.s-2",3,q2)
-          call wstats(ngrid,"emis","Surface emissivity","w.m-1",2,
-     &                emis)
-c          call wstats(ngrid,"ssurf","Surface stress","N.m-2",
-c    &                2,zstress)
-c          call wstats(ngrid,"sw_htrt","sw heat.rate",
-c    &                 "W.m-2",3,zdtsw)
-c          call wstats(ngrid,"lw_htrt","lw heat.rate",
-c    &                 "W.m-2",3,zdtlw)
-
-          if (calltherm) then
-            call wstats(ngrid,"zmax_th","Height of thermals",
-     &                "m",2,zmax_th)
-            call wstats(ngrid,"hfmax_th","Max thermals heat flux",
-     &                "K.m/s",2,hfmax_th)
-            call wstats(ngrid,"wstar",
-     &                "Max vertical velocity in thermals",
-     &                "m/s",2,wstar)
-          endif
-
-           if (tracer) then
-             if (water) then
-               vmr=zq(1:ngrid,1:nlayer,igcm_h2o_vap)
-     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_vap)
-               call wstats(ngrid,"vmr_h2ovap",
-     &                    "H2O vapor volume mixing ratio","mol/mol",
-     &                    3,vmr)
-               vmr=zq(1:ngrid,1:nlayer,igcm_h2o_ice)
-     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_ice)
-               call wstats(ngrid,"vmr_h2oice",
-     &                    "H2O ice volume mixing ratio","mol/mol",
-     &                    3,vmr)
-              ! also store vmr_ice*rice for better diagnostics of rice
-               vmr(1:ngrid,1:nlayer)=vmr(1:ngrid,1:nlayer)*
-     &                               rice(1:ngrid,1:nlayer)
-               call wstats(ngrid,"vmr_h2oice_rice",
-     &                "H2O ice mixing ratio times ice particule size",
-     &                    "(mol/mol)*m",
-     &                    3,vmr)
-               vmr=zqsat(1:ngrid,1:nlayer)
-     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_vap)
-               call wstats(ngrid,"vmr_h2osat",
-     &                    "saturation volume mixing ratio","mol/mol",
-     &                    3,vmr)
-               call wstats(ngrid,"h2o_ice_s",
-     &                    "surface h2o_ice","kg/m2",
-     &                    2,qsurf(1,igcm_h2o_ice))
-               call wstats(ngrid,'albedo',
-     &                         'albedo',
-     &                         '',2,albedo(1,1))
-               call wstats(ngrid,"mtot",
-     &                    "total mass of water vapor","kg/m2",
-     &                    2,mtot)
-               call wstats(ngrid,"icetot",
-     &                    "total mass of water ice","kg/m2",
-     &                    2,icetot)
-               call wstats(ngrid,"reffice",
-     &                    "Mean reff","m",
-     &                    2,rave)
-              call wstats(ngrid,"Nccntot",
-     &                    "condensation nuclei","Nbr/m2",
-     &                    2,Nccntot)
-              call wstats(ngrid,"Mccntot",
-     &                    "condensation nuclei mass","kg/m2",
-     &                    2,Mccntot)
-              call wstats(ngrid,"rice",
-     &                    "Ice particle size","m",
-     &                    3,rice)
-               if (.not.activice) then
-                 call wstats(ngrid,"tauTESap",
-     &                      "tau abs 825 cm-1","",
-     &                      2,tauTES)
-               else
-                 call wstats(ngrid,'tauTES',
-     &                   'tau abs 825 cm-1',
-     &                  '',2,taucloudtes)
-               endif
-
-             endif ! of if (water)
-             
-             
-           if (dustbin.ne.0) then
-          
-             call wstats(ngrid,'tau','taudust','SI',2,tau(1,1))
-             
-             if (doubleq) then
-c            call wstats(ngrid,'qsurf','qsurf',
-c     &                       'kg.m-2',2,qsurf(1,igcm_dust_mass))
-c            call wstats(ngrid,'Nsurf','N particles',
-c     &                       'N.m-2',2,qsurf(1,igcm_dust_number))
-c            call wstats(ngrid,'dqsdev','ddevil lift',
-c    &                       'kg.m-2.s-1',2,zdqsdev(1,1))
-c            call wstats(ngrid,'dqssed','sedimentation',
-c     &                       'kg.m-2.s-1',2,zdqssed(1,1))
-c            call wstats(ngrid,'dqsdif','diffusion',
-c     &                       'kg.m-2.s-1',2,zdqsdif(1,1))
-               call wstats(ngrid,'dqsdust',
-     &                        'deposited surface dust mass',
-     &                        'kg.m-2.s-1',2,dqdustsurf)
-               call wstats(ngrid,'dqndust',
-     &                        'deposited surface dust number',
-     &                        'number.m-2.s-1',2,dndustsurf)
-               call wstats(ngrid,'reffdust','reffdust',
-     &                        'm',3,rdust*ref_r0)
-               call wstats(ngrid,'dustq','Dust mass mr',
-     &                        'kg/kg',3,qdust)
-               call wstats(ngrid,'dustN','Dust number',
-     &                        'part/kg',3,ndust)
-             else
-               do iq=1,dustbin
-                 write(str2(1:2),'(i2.2)') iq
-                 call wstats(ngrid,'q'//str2,'mix. ratio',
-     &                         'kg/kg',3,zq(1,1,iq))
-                 call wstats(ngrid,'qsurf'//str2,'qsurf',
-     &                         'kg.m-2',2,qsurf(1,iq))
-               end do
-             endif ! (doubleq)
-
-             if (scavenging) then
-               call wstats(ngrid,'ccnq','CCN mass mr',
-     &                        'kg/kg',3,qccn)
-               call wstats(ngrid,'ccnN','CCN number',
-     &                        'part/kg',3,nccn)
-             endif ! (scavenging)
-          
-           endif ! (dustbin.ne.0)
-
-           if (thermochem .or. photochem) then
-              do iq=1,nq
-                 if (noms(iq) .ne. "dust_mass" .and.
-     $               noms(iq) .ne. "dust_number" .and.
-     $               noms(iq) .ne. "ccn_mass" .and.
-     $               noms(iq) .ne. "ccn_number") then
-
-!                   volume mixing ratio
-
-                    vmr(1:ngrid,1:nlayer)=zq(1:ngrid,1:nlayer,iq)
-     &                            *mmean(1:ngrid,1:nlayer)/mmol(iq)
-
-                    call wstats(ngrid,"vmr_"//trim(noms(iq)),
-     $                        "Volume mixing ratio","mol/mol",3,vmr)
-                    if ((noms(iq).eq."o")
-     $             .or. (noms(iq).eq."co2")
-     $             .or. (noms(iq).eq."o3")
-     $             .or. (noms(iq).eq."ar")
-     $             .or. (noms(iq).eq."o2")
-     $             .or. (noms(iq).eq."h2o_vap") ) then
-                      call writediagfi(ngrid,"vmr_"//trim(noms(iq)),
-     $                         "Volume mixing ratio","mol/mol",3,vmr)
-                    end if
-
-!                   number density (molecule.cm-3)
-
-                    rhopart(1:ngrid,1:nlayer)=zq(1:ngrid,1:nlayer,iq)
-     &                          *rho(1:ngrid,1:nlayer)*n_avog/
-     &                           (1000*mmol(iq))
-
-!                   call wstats(ngrid,"rho_"//trim(noms(iq)),
-!    $                     "Number density","cm-3",3,rhopart)
-!                   call writediagfi(ngrid,"rho_"//trim(noms(iq)),
-!    $                     "Number density","cm-3",3,rhopart)
-
-!                   vertical column (molecule.cm-2)
-
-                    do ig = 1,ngrid
-                       colden(ig,iq) = 0.                           
-                    end do
-                    do l=1,nlayer                                    
-                       do ig=1,ngrid                                  
-                          colden(ig,iq) = colden(ig,iq) + zq(ig,l,iq)
-     $                                   *(zplev(ig,l)-zplev(ig,l+1)) 
-     $                                   *6.022e22/(mmol(iq)*g)       
-                       end do                                        
-                    end do                                          
-
-                    call wstats(ngrid,"c_"//trim(noms(iq)),           
-     $                          "column","mol cm-2",2,colden(1,iq))  
-                    call writediagfi(ngrid,"c_"//trim(noms(iq)),
-     $                          "column","mol cm-2",2,colden(1,iq))
-
-!                   global mass (g)
-               
-                    call planetwide_sumval(colden(:,iq)/6.022e23
-     $                            *mmol(iq)*1.e4*cell_area(:),mass(iq))
-
-                    call writediagfi(ngrid,"mass_"//trim(noms(iq)),
-     $                              "global mass","g",0,mass(iq))
-
-                 end if ! of if (noms(iq) .ne. "dust_mass" ...)
-              end do ! of do iq=1,nq
-           end if ! of if (thermochem .or. photochem)
-
-           end if ! of if (tracer)
-
-           IF(lastcall) THEN
-             write (*,*) "Writing stats..."
-             call mkstats(ierr)
-           ENDIF
-
-         ENDIF !if callstats
-
-c        (Store EOF for Mars Climate database software)
-         IF (calleofdump) THEN
-            CALL eofdump(ngrid, nlayer, zu, zv, zt, rho, ps)
-         ENDIF
-#endif
-!endif of ifndef MESOSCALE
-
-#ifdef MESOSCALE
-      
-      !! see comm_wrf. 
-      !! not needed when an array is already in a shared module.
-      !! --> example : hfmax_th, zmax_th
-
-      !state  real  HR_SW     ikj   misc  1  -  h  "HR_SW"     "HEATING RATE SW"                 "K/s"
-      comm_HR_SW(1:ngrid,1:nlayer) = zdtsw(1:ngrid,1:nlayer)
-      !state  real  HR_LW     ikj   misc  1  -  h  "HR_LW"     "HEATING RATE LW"                 "K/s"
-      comm_HR_LW(1:ngrid,1:nlayer) = zdtlw(1:ngrid,1:nlayer)
-      !state  real  SWDOWNZ    ij   misc  1  -  h  "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"
-      comm_SWDOWNZ(1:ngrid) = fluxsurf_sw_tot(1:ngrid)
-      !state  real  TAU_DUST   ij   misc  1  -  h  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""
-      comm_TAU_DUST(1:ngrid) = tauref(1:ngrid)
-      !state  real  RDUST     ikj   misc  1  -  h  "RDUST"     "DUST RADIUS"                     "m"
-      comm_RDUST(1:ngrid,1:nlayer) = rdust(1:ngrid,1:nlayer)
-      !state  real  QSURFDUST  ij   misc  1  -  h  "QSURFDUST" "DUST MASS AT SURFACE"            "kg m-2"
-      IF (igcm_dust_mass .ne. 0) THEN
-        comm_QSURFDUST(1:ngrid) = qsurf(1:ngrid,igcm_dust_mass)
-      ELSE
-        comm_QSURFDUST(1:ngrid) = 0.
-      ENDIF
-      !state  real  MTOT       ij   misc  1  -  h  "MTOT"      "TOTAL MASS WATER VAPOR in pmic"  "pmic"
-      comm_MTOT(1:ngrid) = mtot(1:ngrid) * 1.e6 / rho_ice
-      !state  real  ICETOT     ij   misc  1  -  h  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"
-      comm_ICETOT(1:ngrid) = icetot(1:ngrid) * 1.e6 / rho_ice
-      !state  real  VMR_ICE   ikj   misc  1  -  h  "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"
-      IF (igcm_h2o_ice .ne. 0) THEN
-        comm_VMR_ICE(1:ngrid,1:nlayer) = 1.e6
-     .    * zq(1:ngrid,1:nlayer,igcm_h2o_ice)
-     .    * mmean(1:ngrid,1:nlayer) / mmol(igcm_h2o_ice)
-      ELSE
-        comm_VMR_ICE(1:ngrid,1:nlayer) = 0.
-      ENDIF
-      !state  real  TAU_ICE    ij   misc  1  -  h  "TAU_ICE"   "CLOUD OD at 825 cm-1 TES"        ""
-      if (activice) then
-        comm_TAU_ICE(1:ngrid) = taucloudtes(1:ngrid)
-      else
-        comm_TAU_ICE(1:ngrid) = tauTES(1:ngrid)
-      endif
-      !state  real  RICE      ikj   misc  1  -  h  "RICE"      "ICE RADIUS"                      "m"
-      comm_RICE(1:ngrid,1:nlayer) = rice(1:ngrid,1:nlayer)
-
-   
-      !! calculate sensible heat flux in W/m2 for outputs
-      !! -- the one computed in vdifc is not the real one
-      !! -- vdifc must have been called
-      if (.not.callrichsl) then
-        sensibFlux(1:ngrid) = zflubid(1:ngrid)
-     .         - capcal(1:ngrid)*zdtsdif(1:ngrid)
-      else
-        sensibFlux(1:ngrid) = 
-     &   (pplay(1:ngrid,1)/(r*pt(1:ngrid,1)))*cpp
-     &   *sqrt(pu(1:ngrid,1)*pu(1:ngrid,1)+pv(1:ngrid,1)*pv(1:ngrid,1)
-     &         +(log(1.+0.7*wstar(1:ngrid) + 2.3*wstar(1:ngrid)**2))**2)
-     &   *zcdh(1:ngrid)*(tsurf(1:ngrid)-zh(1:ngrid,1))
-      endif
-          
-#else
-#ifndef MESOINI
-
-c        ==========================================================
-c        WRITEDIAGFI: Outputs in netcdf file "DIAGFI", containing
-c          any variable for diagnostic (output with period
-c          "ecritphy", set in "run.def")
-c        ==========================================================
-c        WRITEDIAGFI can ALSO be called from any other subroutines
-c        for any variables !!
-c        call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
-c    &                  emis)
-c        call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay)
-c        call WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",3,zplev)
-         call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",2,
-     &                  tsurf)
-         call WRITEDIAGFI(ngrid,"ps","surface pressure","Pa",2,ps)
-         call WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness"
-     &                                         ,"kg.m-2",2,co2ice)
-
-         call WRITEDIAGFI(ngrid,"temp7","temperature in layer 7",
-     &                  "K",2,zt(1,7))
-         call WRITEDIAGFI(ngrid,"fluxsurf_lw","fluxsurf_lw","W.m-2",2,
-     &                  fluxsurf_lw)
-         call WRITEDIAGFI(ngrid,"fluxsurf_sw","fluxsurf_sw","W.m-2",2,
-     &                  fluxsurf_sw_tot)
-         call WRITEDIAGFI(ngrid,"fluxtop_lw","fluxtop_lw","W.m-2",2,
-     &                  fluxtop_lw)
-         call WRITEDIAGFI(ngrid,"fluxtop_sw","fluxtop_sw","W.m-2",2,
-     &                  fluxtop_sw_tot)
-         call WRITEDIAGFI(ngrid,"temp","temperature","K",3,zt)
-         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,"rho","density","none",3,rho)
-c        call WRITEDIAGFI(ngrid,"q2","q2","kg.m-3",3,q2)
-c        call WRITEDIAGFI(ngrid,'Teta','T potentielle','K',3,zh)
-         call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,zplay)
-c        call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2,
-c    &                  zstress)
-c        call WRITEDIAGFI(ngrid,'sw_htrt','sw heat. rate',
-c    &                   'w.m-2',3,zdtsw)
-c        call WRITEDIAGFI(ngrid,'lw_htrt','lw heat. rate',
-c    &                   'w.m-2',3,zdtlw)
-            if (.not.activice) then
-               CALL WRITEDIAGFI(ngrid,'tauTESap',
-     &                         'tau abs 825 cm-1',
-     &                         '',2,tauTES)
-             else
-               CALL WRITEDIAGFI(ngrid,'tauTES',
-     &                         'tau abs 825 cm-1',
-     &                         '',2,taucloudtes)
-             endif
-
-#else
-     !!! this is to ensure correct initialisation of mesoscale model
-        call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",2,
-     &                  tsurf)
-        call WRITEDIAGFI(ngrid,"ps","surface pressure","Pa",2,ps) 
-        call WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness","kg.m-2",2,
-     &                  co2ice)
-        call WRITEDIAGFI(ngrid,"temp","temperature","K",3,zt)
-        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,"emis","Surface emissivity","w.m-1",2,
-     &                  emis)
-        call WRITEDIAGFI(ngrid,"tsoil","Soil temperature",
-     &                       "K",3,tsoil)
-        call WRITEDIAGFI(ngrid,"inertiedat","Soil inertia",
-     &                       "K",3,inertiedat)
-#endif
-
-
-c        ----------------------------------------------------------
-c        Outputs of the CO2 cycle
-c        ----------------------------------------------------------
-
-         if (tracer.and.(igcm_co2.ne.0)) then
-!          call WRITEDIAGFI(ngrid,"co2_l1","co2 mix. ratio in 1st layer",
-!    &                     "kg/kg",2,zq(1,1,igcm_co2))
-          call WRITEDIAGFI(ngrid,"co2","co2 mass mixing ratio",
-     &                     "kg/kg",3,zq(1,1,igcm_co2))
-        
-         ! Compute co2 column
-         co2col(:)=0
-         do l=1,nlayer
-           do ig=1,ngrid
-             co2col(ig)=co2col(ig)+
-     &                  zq(ig,l,igcm_co2)*(zplev(ig,l)-zplev(ig,l+1))/g
-           enddo
-         enddo
-         call WRITEDIAGFI(ngrid,"co2col","CO2 column","kg.m-2",2,
-     &                  co2col)
-         endif ! of if (tracer.and.(igcm_co2.ne.0))
-
-c        ----------------------------------------------------------
-c        Outputs of the water cycle
-c        ----------------------------------------------------------
-         if (tracer) then
-           if (water) then
-
-#ifdef MESOINI
-            !!!! waterice = q01, voir readmeteo.F90
-            call WRITEDIAGFI(ngrid,'q01',noms(igcm_h2o_ice),
-     &                      'kg/kg',3,
-     &                       zq(1:ngrid,1:nlayer,igcm_h2o_ice))
-            !!!! watervapor = q02, voir readmeteo.F90
-            call WRITEDIAGFI(ngrid,'q02',noms(igcm_h2o_vap),
-     &                      'kg/kg',3,
-     &                       zq(1:ngrid,1:nlayer,igcm_h2o_vap))
-            !!!! surface waterice qsurf02 (voir readmeteo)
-            call WRITEDIAGFI(ngrid,'qsurf02','surface tracer',
-     &                      'kg.m-2',2,
-     &                       qsurf(1:ngrid,igcm_h2o_ice))
-#endif
-
-            CALL WRITEDIAGFI(ngrid,'mtot',
-     &                       'total mass of water vapor',
-     &                       'kg/m2',2,mtot)
-            CALL WRITEDIAGFI(ngrid,'icetot',
-     &                       'total mass of water ice',
-     &                       'kg/m2',2,icetot)
-            vmr=zq(1:ngrid,1:nlayer,igcm_h2o_ice)
-     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_ice)
-            call WRITEDIAGFI(ngrid,'vmr_h2oice','h2o ice vmr',
-     &                       'mol/mol',3,vmr)
-            vmr=zq(1:ngrid,1:nlayer,igcm_h2o_vap)
-     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_vap)
-            call WRITEDIAGFI(ngrid,'vmr_h2ovap','h2o vap vmr',
-     &                       'mol/mol',3,vmr)
-            CALL WRITEDIAGFI(ngrid,'reffice',
-     &                       'Mean reff',
-     &                       'm',2,rave)
-            call WRITEDIAGFI(ngrid,'saturation',
-     &           'h2o vap saturation ratio','dimless',3,satu)
-            if (scavenging) then
-              CALL WRITEDIAGFI(ngrid,"Nccntot",
-     &                    "condensation nuclei","Nbr/m2",
-     &                    2,Nccntot)
-              CALL WRITEDIAGFI(ngrid,"Mccntot",
-     &                    "mass condensation nuclei","kg/m2",
-     &                    2,Mccntot)
-            endif
-            call WRITEDIAGFI(ngrid,'rice','Ice particle size',
-     &                       'm',3,rice)
-            call WRITEDIAGFI(ngrid,'h2o_ice_s',
-     &                       'surface h2o_ice',
-     &                       'kg.m-2',2,qsurf(1,igcm_h2o_ice))
-            CALL WRITEDIAGFI(ngrid,'albedo',
-     &                         'albedo',
-     &                         '',2,albedo(1,1))
-              if (tifeedback) then
-                 call WRITEDIAGSOIL(ngrid,"soiltemp",
-     &                              "Soil temperature","K",
-     &                              3,tsoil)
-                 call WRITEDIAGSOIL(ngrid,'soilti',
-     &                       'Soil Thermal Inertia',
-     &                       'J.s-1/2.m-2.K-1',3,inertiesoil)
-              endif
-           endif !(water)
-
-
-           if (water.and..not.photochem) then
-             iq=nq
-c            write(str2(1:2),'(i2.2)') iq
-c            call WRITEDIAGFI(ngrid,'dqs'//str2,'dqscloud',
-c    &                       'kg.m-2',2,zdqscloud(1,iq))
-c            call WRITEDIAGFI(ngrid,'dqch'//str2,'var chim',
-c    &                       'kg/kg',3,zdqchim(1,1,iq))
-c            call WRITEDIAGFI(ngrid,'dqd'//str2,'var dif',
-c    &                       'kg/kg',3,zdqdif(1,1,iq))
-c            call WRITEDIAGFI(ngrid,'dqa'//str2,'var adj',
-c    &                       'kg/kg',3,zdqadj(1,1,iq))
-c            call WRITEDIAGFI(ngrid,'dqc'//str2,'var c',
-c    &                       'kg/kg',3,zdqc(1,1,iq))
-           endif  !(water.and..not.photochem)
-         endif
-
-c        ----------------------------------------------------------
-c        Outputs of the dust cycle
-c        ----------------------------------------------------------
-
-        call WRITEDIAGFI(ngrid,'tauref',
-     &                    'Dust ref opt depth','NU',2,tauref)
-
-         if (tracer.and.(dustbin.ne.0)) then
-
-          call WRITEDIAGFI(ngrid,'tau','taudust','SI',2,tau(1,1))
-
-#ifndef MESOINI
-           if (doubleq) then
-c            call WRITEDIAGFI(ngrid,'qsurf','qsurf',
-c     &                       'kg.m-2',2,qsurf(1,igcm_dust_mass))
-c            call WRITEDIAGFI(ngrid,'Nsurf','N particles',
-c     &                       'N.m-2',2,qsurf(1,igcm_dust_number))
-c            call WRITEDIAGFI(ngrid,'dqsdev','ddevil lift',
-c    &                       'kg.m-2.s-1',2,zdqsdev(1,1))
-c            call WRITEDIAGFI(ngrid,'dqssed','sedimentation',
-c     &                       'kg.m-2.s-1',2,zdqssed(1,1))
-c            call WRITEDIAGFI(ngrid,'dqsdif','diffusion',
-c     &                       'kg.m-2.s-1',2,zdqsdif(1,1))
-c             call WRITEDIAGFI(ngrid,'sedice','sedimented ice',
-c     &                       'kg.m-2.s-1',2,zdqssed(:,igcm_h2o_ice))
-c             call WRITEDIAGFI(ngrid,'subice','sublimated ice',
-c     &                       'kg.m-2.s-1',2,zdqsdif(:,igcm_h2o_ice))
-             call WRITEDIAGFI(ngrid,'dqsdust',
-     &                        'deposited surface dust mass',
-     &                        'kg.m-2.s-1',2,dqdustsurf)
-             call WRITEDIAGFI(ngrid,'dqndust',
-     &                        'deposited surface dust number',
-     &                        'number.m-2.s-1',2,dndustsurf)
-             call WRITEDIAGFI(ngrid,'reffdust','reffdust',
-     &                        'm',3,rdust*ref_r0)
-             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
-     &                        'kg/kg',3,qdust)
-             call WRITEDIAGFI(ngrid,'dustN','Dust number',
-     &                        'part/kg',3,ndust)
-             call WRITEDIAGFI(ngrid,'dsodust',
-     &                        'dust density scaled opacity',
-     &                        'm2.kg-1',3,dsodust)
-c             call WRITEDIAGFI(ngrid,"tauscaling",
-c     &                    "dust conversion factor"," ",2,tauscaling)
-           else
-             do iq=1,dustbin
-               write(str2(1:2),'(i2.2)') iq
-               call WRITEDIAGFI(ngrid,'q'//str2,'mix. ratio',
-     &                         'kg/kg',3,zq(1,1,iq))
-               call WRITEDIAGFI(ngrid,'qsurf'//str2,'qsurf',
-     &                         'kg.m-2',2,qsurf(1,iq))
-             end do
-           endif ! (doubleq)
-
-           if (scavenging) then
-             call WRITEDIAGFI(ngrid,'ccnq','CCN mass mr',
-     &                        'kg/kg',3,qccn)
-             call WRITEDIAGFI(ngrid,'ccnN','CCN number',
-     &                        'part/kg',3,nccn)
-           endif ! (scavenging)
-
-c          if (submicron) then
-c            call WRITEDIAGFI(ngrid,'dustsubm','subm mass mr',
-c    &                        'kg/kg',3,pq(1,1,igcm_dust_submicron))
-c          endif ! (submicron)
-
-#else
-!     !!! to initialize mesoscale we need scaled variables
-!     !!! because this must correspond to starting point for tracers
-!             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
-!     &           'kg/kg',3,pq(1:ngrid,1:nlayer,igcm_dust_mass))
-!             call WRITEDIAGFI(ngrid,'dustN','Dust number',
-!     &           'part/kg',3,pq(1:ngrid,1:nlayer,igcm_dust_number))
-!             call WRITEDIAGFI(ngrid,'ccn','Nuclei mass mr',
-!     &           'kg/kg',3,pq(1:ngrid,1:nlayer,igcm_ccn_mass))
-!             call WRITEDIAGFI(ngrid,'ccnN','Nuclei number',
-!     &           'part/kg',3,pq(1:ngrid,1:nlayer,igcm_ccn_number))
-      if (freedust) then
-             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
-     &                        'kg/kg',3,qdust)
-             call WRITEDIAGFI(ngrid,'dustN','Dust number',
-     &                        'part/kg',3,ndust)
-             call WRITEDIAGFI(ngrid,'ccn','CCN mass mr',
-     &                        'kg/kg',3,qccn)
-             call WRITEDIAGFI(ngrid,'ccnN','CCN number',
-     &                        'part/kg',3,nccn)
-      else
-             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
-     &                        'kg/kg',3,pq(1,1,igcm_dust_mass))
-             call WRITEDIAGFI(ngrid,'dustN','Dust number',
-     &                        'part/kg',3,pq(1,1,igcm_dust_number))
-             call WRITEDIAGFI(ngrid,'ccn','Nuclei mass mr',
-     &                        'kg/kg',3,pq(1,1,igcm_ccn_mass))
-             call WRITEDIAGFI(ngrid,'ccnN','Nuclei number',
-     &                        'part/kg',3,pq(1,1,igcm_ccn_number))
-      endif
-#endif
-
-         end if  ! (tracer.and.(dustbin.ne.0))
-
-
-c        ----------------------------------------------------------
-c        Thermospheric outputs
-c        ----------------------------------------------------------
-
-         if(callthermos) then 
-
-            call WRITEDIAGFI(ngrid,"q15um","15 um cooling","K/s",
-     $           3,zdtnlte)
-            call WRITEDIAGFI(ngrid,"quv","UV heating","K/s",
-     $           3,zdteuv)
-            call WRITEDIAGFI(ngrid,"cond","Thermal conduction","K/s",
-     $           3,zdtconduc)
-            call WRITEDIAGFI(ngrid,"qnir","NIR heating","K/s",
-     $           3,zdtnirco2)
-
-         endif  !(callthermos)
-
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-c        PBL OUTPUS
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-
-c        ----------------------------------------------------------
-c        Outputs of thermals
-c        ----------------------------------------------------------
-         if (calltherm) then
-
-!        call WRITEDIAGFI(ngrid,'dtke',
-!     &              'tendance tke thermiques','m**2/s**2',
-!     &                         3,dtke_th)
-!        call WRITEDIAGFI(ngrid,'d_u_ajs',
-!     &              'tendance u thermiques','m/s',
-!     &                         3,pdu_th*ptimestep)
-!        call WRITEDIAGFI(ngrid,'d_v_ajs',
-!     &              'tendance v thermiques','m/s',
-!     &                         3,pdv_th*ptimestep)
-!        if (tracer) then
-!        if (nq .eq. 2) then
-!        call WRITEDIAGFI(ngrid,'deltaq_th',
-!     &              'delta q thermiques','kg/kg',
-!     &                         3,ptimestep*pdq_th(:,:,2))
-!        endif
-!        endif
-
-        call WRITEDIAGFI(ngrid,'zmax_th',
-     &              'hauteur du thermique','m',
-     &                         2,zmax_th)
-        call WRITEDIAGFI(ngrid,'hfmax_th',
-     &              'maximum TH heat flux','K.m/s',
-     &                         2,hfmax_th)
-        call WRITEDIAGFI(ngrid,'wstar',
-     &              'maximum TH vertical velocity','m/s',
-     &                         2,wstar)
-
-         endif
-
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-c        END OF PBL OUTPUS
-c        ----------------------------------------------------------
-c        ----------------------------------------------------------
-
-
-c        ----------------------------------------------------------
-c        Output in netcdf file "diagsoil.nc" for subterranean
-c          variables (output every "ecritphy", as for writediagfi)
-c        ----------------------------------------------------------
-
-         ! Write soil temperature
-!        call writediagsoil(ngrid,"soiltemp","Soil temperature","K",
-!    &                     3,tsoil)
-         ! Write surface temperature
-!        call writediagsoil(ngrid,"tsurf","Surface temperature","K",
-!    &                     2,tsurf)
-
-c        ==========================================================
-c        END OF WRITEDIAGFI
-c        ==========================================================
-#endif
-! of ifdef MESOSCALE
-
-      ELSE     ! if(ngrid.eq.1)
-
-#ifndef MESOSCALE
-         write(*,'("Ls =",f11.6," tauref(",f4.0," Pa) =",f9.6)')
-     &    zls*180./pi,odpref,tauref
-c      ----------------------------------------------------------------------
-c      Output in grads file "g1d" (ONLY when using testphys1d)
-c      (output at every X physical timestep)
-c      ----------------------------------------------------------------------
-c
-c        CALL writeg1d(ngrid,1,fluxsurf_lw,'Fs_ir','W.m-2')
-c         CALL writeg1d(ngrid,1,tsurf,'tsurf','K')
-c         CALL writeg1d(ngrid,1,ps,'ps','Pa')
-         
-c         CALL writeg1d(ngrid,nlayer,zt,'T','K')
-c        CALL writeg1d(ngrid,nlayer,pu,'u','m.s-1')
-c        CALL writeg1d(ngrid,nlayer,pv,'v','m.s-1')
-c        CALL writeg1d(ngrid,nlayer,pw,'w','m.s-1')
-
-! THERMALS STUFF 1D
-         if(calltherm) then
-
-        call WRITEDIAGFI(ngrid,'lmax_th',
-     &              'hauteur du thermique','point',
-     &                         0,lmax_th_out)
-        call WRITEDIAGFI(ngrid,'zmax_th',
-     &              'hauteur du thermique','m',
-     &                         0,zmax_th)
-        call WRITEDIAGFI(ngrid,'hfmax_th',
-     &              'maximum TH heat flux','K.m/s',
-     &                         0,hfmax_th)
-        call WRITEDIAGFI(ngrid,'wstar',
-     &              'maximum TH vertical velocity','m/s',
-     &                         0,wstar)
-
-         co2col(:)=0.
-         if (tracer) then
-         do l=1,nlayer
-           do ig=1,ngrid
-             co2col(ig)=co2col(ig)+
-     &                  zq(ig,l,1)*(zplev(ig,l)-zplev(ig,l+1))/g
-         enddo
-         enddo
-
-         end if
-         call WRITEDIAGFI(ngrid,'co2col','integrated co2 mass'          &
-     &                                      ,'kg/m-2',0,co2col)
-         endif ! of if (calltherm)
-
-         call WRITEDIAGFI(ngrid,'w','vertical velocity'                 &
-     &                              ,'m/s',1,pw)
-         call WRITEDIAGFI(ngrid,"q2","q2","kg.m-3",1,q2)
-         call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",0,
-     &                  tsurf)
-         call WRITEDIAGFI(ngrid,"u","u wind","m/s",1,zu)
-         call WRITEDIAGFI(ngrid,"v","v wind","m/s",1,zv)
-
-         call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",1,zplay)
-         call WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",1,zplev)
-         call WRITEDIAGFI(ngrid,"rho","rho","kg.m-3",1,rho)
-         call WRITEDIAGFI(ngrid,"dtrad","rad. heat. rate",              &
-     &              "K.s-1",1,dtrad)
-        call WRITEDIAGFI(ngrid,'sw_htrt','sw heat. rate',
-     &                   'w.m-2',1,zdtsw)
-        call WRITEDIAGFI(ngrid,'lw_htrt','lw heat. rate',
-     &                   'w.m-2',1,zdtlw)
-         call WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness"
-     &                                   ,"kg.m-2",0,co2ice)
-
-! or output in diagfi.nc (for testphys1d)
-         call WRITEDIAGFI(ngrid,'ps','Surface pressure','Pa',0,ps)
-         call WRITEDIAGFI(ngrid,'temp','Temperature',
-     &                       'K',1,zt)
-     
-         if(tracer) then
-c           CALL writeg1d(ngrid,1,tau,'tau','SI')
-            do iq=1,nq
-c              CALL writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 
-               call WRITEDIAGFI(ngrid,trim(noms(iq)),
-     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
-            end do
-           if (doubleq) then
-             call WRITEDIAGFI(ngrid,'rdust','rdust',
-     &                        'm',1,rdust)
-           endif
-           if (water.AND.tifeedback) then
-             call WRITEDIAGFI(ngrid,"soiltemp",
-     &                              "Soil temperature","K",
-     &                              1,tsoil)
-             call WRITEDIAGFI(ngrid,'soilti',
-     &                       'Soil Thermal Inertia',
-     &                       'J.s-1/2.m-2.K-1',1,inertiesoil)
-           endif
-         end if
-         
-cccccccccccccccccc scavenging & water outputs 1D TN ccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         IF (water) THEN
-
-           if (.not.activice) then
-
-             tauTES=0
-             do l=1,nlayer
-               Qabsice = min(
-     &             max(0.4e6*rice(1,l)*(1.+nuice_ref)-0.05 ,0.),1.2
-     &                      )
-               opTES(1,l)= 0.75 * Qabsice *
-     &             zq(1,l,igcm_h2o_ice) *
-     &             (zplev(1,l) - zplev(1,l+1)) / g
-     &             / (rho_ice * rice(1,l) * (1.+nuice_ref))
-               tauTES=tauTES+ opTES(1,l)
-             enddo
-             CALL WRITEDIAGFI(ngrid,'tauTESap',
-     &                         'tau abs 825 cm-1',
-     &                         '',0,tauTES)
-           else
-
-             CALL WRITEDIAGFI(ngrid,'tauTES',
-     &                         'tau abs 825 cm-1',
-     &                         '',0,taucloudtes)
-           endif
-     
-           mtot = 0
-           icetot = 0
-           h2otot = qsurf(1,igcm_h2o_ice)
-
-           do l=1,nlayer
-             mtot = mtot +  zq(1,l,igcm_h2o_vap) 
-     &                 * (zplev(1,l) - zplev(1,l+1)) / g
-             icetot = icetot +  zq(1,l,igcm_h2o_ice) 
-     &                 * (zplev(1,l) - zplev(1,l+1)) / g
-           end do
-           h2otot = h2otot+mtot+icetot
-
-             CALL WRITEDIAGFI(ngrid,'h2otot',
-     &                         'h2otot',
-     &                         'kg/m2',0,h2otot)
-             CALL WRITEDIAGFI(ngrid,'mtot',
-     &                         'mtot',
-     &                         'kg/m2',0,mtot)
-             CALL WRITEDIAGFI(ngrid,'icetot',
-     &                         'icetot',
-     &                         'kg/m2',0,icetot)
-
-           if (scavenging) then
-
-             rave = 0
-             do l=1,nlayer
-cccc Column integrated effective ice radius
-cccc is weighted by total ice surface area (BETTER) 
-             rave = rave + tauscaling(1) *
-     &              zq(1,l,igcm_ccn_number) *
-     &              (zplev(1,l) - zplev(1,l+1)) / g * 
-     &              rice(1,l) * rice(1,l)*  (1.+nuice_ref)
-             enddo
-             rave=icetot*0.75/max(rave*pi*rho_ice,1.e-30) ! surface weight
-
-              Nccntot= 0
-              call watersat(ngrid*nlayer,zt,zplay,zqsat)
-               do l=1,nlayer
-                   Nccntot = Nccntot + 
-     &              zq(1,l,igcm_ccn_number)*tauscaling(1)
-     &              *(zplev(1,l) - zplev(1,l+1)) / g
-                   satu(1,l) = zq(1,l,igcm_h2o_vap)/zqsat(1,l)
-                   satu(1,l) = (max(satu(1,l),float(1))-1)
-!     &                      * zq(1,l,igcm_h2o_vap) *
-!     &                      (zplev(1,l) - zplev(1,l+1)) / g
-               enddo
-               call WRITEDIAGFI(ngrid,"satu","vap in satu","kg/kg",1,
-     &                    satu)
-               CALL WRITEDIAGFI(ngrid,'Nccntot',
-     &                         'Nccntot',
-     &                         'nbr/m2',0,Nccntot)
-
-             call WRITEDIAGFI(ngrid,'zdqsed_dustq'
-     & ,'sedimentation q','kg.m-2.s-1',1,zdqsed(1,:,igcm_dust_mass))
-             call WRITEDIAGFI(ngrid,'zdqsed_dustN'
-     &,'sedimentation N','Nbr.m-2.s-1',1,
-     &                                 zdqsed(1,:,igcm_dust_number))
-
-           else ! of if (scavenging)
-
-cccc Column integrated effective ice radius 
-cccc is weighted by total ice mass         (LESS GOOD)
-             rave = 0
-             do l=1,nlayer
-               rave = rave + zq(1,l,igcm_h2o_ice)
-     &              * (zplev(1,l) - zplev(1,l+1)) / g
-     &              *  rice(1,l) * (1.+nuice_ref)
-             enddo
-             rave=max(rave/max(icetot,1.e-30),1.e-30) ! mass weight
-           endif ! of if (scavenging)
-
-           CALL WRITEDIAGFI(ngrid,'reffice',
-     &                      'reffice',
-     &                      'm',0,rave)
-
-           do iq=1,nq
-             call WRITEDIAGFI(ngrid,trim(noms(iq))//'_s',
-     &            trim(noms(iq))//'_s','kg/kg',0,qsurf(1,iq))
-           end do
-     
-        call WRITEDIAGFI(ngrid,'zdqcloud_ice','cloud ice',
-     &            'kg.m-2.s-1',1,zdqcloud(1,:,igcm_h2o_ice))
-        call WRITEDIAGFI(ngrid,'zdqcloud_vap','cloud vap',
-     &            'kg.m-2.s-1',1,zdqcloud(1,:,igcm_h2o_vap))
-        call WRITEDIAGFI(ngrid,'zdqcloud','cloud ice',
-     &            'kg.m-2.s-1',1,zdqcloud(1,:,igcm_h2o_ice)
-     &                          +zdqcloud(1,:,igcm_h2o_vap))
-     
-          call WRITEDIAGFI(ngrid,"rice","ice radius","m",1,
-     &                    rice)
-         ENDIF ! of IF (water)
-         
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-         zlocal(1)=-log(zplay(1,1)/zplev(1,1))* Rnew(1,1)*zt(1,1)/g
-
-         do l=2,nlayer-1
-            tmean=zt(1,l)
-            if(zt(1,l).ne.zt(1,l-1))
-     &        tmean=(zt(1,l)-zt(1,l-1))/log(zt(1,l)/zt(1,l-1))
-              zlocal(l)= zlocal(l-1)
-     &        -log(zplay(1,l)/zplay(1,l-1))*rnew(1,l)*tmean/g
-         enddo
-         zlocal(nlayer)= zlocal(nlayer-1)-
-     &                   log(zplay(1,nlayer)/zplay(1,nlayer-1))*
-     &                   rnew(1,nlayer)*tmean/g
-#endif
-
-      END IF       ! if(ngrid.ne.1)
-
-      icount=icount+1
-      RETURN
-      END
Index: /trunk/LMDZ.MARS/libf/phymars/physiq_mod.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/physiq_mod.F	(revision 1549)
+++ /trunk/LMDZ.MARS/libf/phymars/physiq_mod.F	(revision 1549)
@@ -0,0 +1,2650 @@
+      MODULE physiq_mod
+
+      IMPLICIT NONE
+
+      CONTAINS
+
+      SUBROUTINE physiq(
+     $            ngrid,nlayer,nq
+     $            ,firstcall,lastcall
+     $            ,pday,ptime,ptimestep
+     $            ,pplev,pplay,pphi
+     $            ,pu,pv,pt,pq
+     $            ,flxw
+     $            ,pdu,pdv,pdt,pdq,pdpsrf,tracerdyn)
+
+      use tracer_mod, only: noms, mmol, igcm_co2, igcm_n2,
+     &                      igcm_co, igcm_o, igcm_h2o_vap, igcm_h2o_ice,
+     &                      igcm_ccn_mass, igcm_ccn_number,
+     &                      igcm_dust_mass, igcm_dust_number, igcm_h2o2,
+     &                      nuice_ref, rho_ice, rho_dust, ref_r0
+      use comsoil_h, only: inertiedat, ! soil thermal inertia
+     &                     tsoil, nsoilmx ! number of subsurface layers
+      use geometry_mod, only: longitude, latitude, cell_area
+      use comgeomfi_h, only: sinlon, coslon, sinlat, coslat
+      use surfdat_h, only: phisfi, albedodat, zmea, zstd, zsig, zgam,
+     &                     zthe, z0, albedo_h2o_ice,
+     &                     frost_albedo_threshold,
+     &                     tsurf, co2ice, emis,
+     &                     capcal, fluxgrd, qsurf
+      use comsaison_h, only: dist_sol, declin, mu0, fract
+      use slope_mod, only: theta_sl, psi_sl
+      use conc_mod, only: rnew, cpnew, mmean
+      use time_phylmdz_mod, only: iphysiq, day_step, ecritstart, daysec
+      use dimradmars_mod, only: tauscaling, aerosol,
+     &                          dtrad, fluxrad_sky, fluxrad, albedo,
+     &                          naerkind
+      use turb_mod, only: q2, wstar, ustar, sensibFlux, 
+     &                    zmax_th, hfmax_th, turb_resolved
+      use planete_h, only: aphelie, periheli, year_day, peri_day,
+     &                     obliquit
+      USE comcstfi_h, only: r, cpp, mugaz, g, rcp, pi, rad
+      use param_v4_h, only: nreact,n_avog, 
+     &                      fill_data_thermos, allocate_param_thermos
+      use iono_h, only: allocate_param_iono
+#ifdef MESOSCALE
+      use comsoil_h, only: mlayer,layer
+      use surfdat_h, only: z0_default
+      use comm_wrf
+#else
+      use planetwide_mod
+      use phyredem, only: physdem0, physdem1
+      use eofdump_mod, only: eofdump
+      USE comvert_mod, ONLY: ap,bp,aps,bps
+#endif
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   subject:
+c   --------
+c
+c   Organisation of the physical parametrisations of the LMD 
+c   martian atmospheric general circulation model.
+c
+c   The GCM can be run without or with tracer transport
+c   depending on the value of Logical "tracer" in file  "callphys.def"
+c   Tracers may be water vapor, ice OR chemical species OR dust particles
+c
+c   SEE comments in initracer.F about numbering of tracer species...
+c
+c   It includes:
+c
+c      1. Initialization:
+c      1.1 First call initializations
+c      1.2 Initialization for every call to physiq
+c      1.2.5 Compute mean mass and cp, R and thermal conduction coeff.
+c      2. Compute radiative transfer tendencies
+c         (longwave and shortwave) for CO2 and aerosols.
+c      3. Gravity wave and subgrid scale topography drag :
+c      4. Vertical diffusion (turbulent mixing):
+c      5. Convective adjustment
+c      6. Condensation and sublimation of carbon dioxide.
+c      7.  TRACERS :
+c       7a. water and water ice
+c       7b. call for photochemistry when tracers are chemical species
+c       7c. other scheme for tracer (dust) transport (lifting, sedimentation)
+c       7d. updates (CO2 pressure variations, surface budget)
+c      8. Contribution to tendencies due to thermosphere
+c      9. Surface and sub-surface temperature calculations
+c     10. Write outputs :
+c           - "startfi", "histfi" (if it's time)
+c           - Saving statistics (if "callstats = .true.")
+c           - Dumping eof (if "calleofdump = .true.")
+c           - Output any needed variables in "diagfi" 
+c     11. Diagnostic: mass conservation of tracers
+c 
+c   author: 
+c   ------- 
+c           Frederic Hourdin	15/10/93
+c           Francois Forget		1994
+c           Christophe Hourdin	02/1997 
+c           Subroutine completly rewritten by F.Forget (01/2000)
+c           Introduction of the photochemical module: S. Lebonnois (11/2002)
+c           Introduction of the thermosphere module: M. Angelats i Coll (2002)
+c           Water ice clouds: Franck Montmessin (update 06/2003)
+c           Radiatively active tracers: J.-B. Madeleine (10/2008-06/2009)
+c             Nb: See callradite.F for more information.
+c           Mesoscale lines: Aymeric Spiga (2007 - 2011) -- check MESOSCALE flags
+c           jul 2011 malv+fgg: Modified calls to NIR heating routine and 15 um cooling parameterization
+c           
+c   arguments:
+c   ----------
+c
+c   input:
+c   ------
+c    ecri                  period (in dynamical timestep) to write output
+c    ngrid                 Size of the horizontal grid.
+c                          All internal loops are performed on that grid.
+c    nlayer                Number of vertical layers.
+c    nq                    Number of advected fields
+c    firstcall             True at the first call
+c    lastcall              True at the last call
+c    pday                  Number of days counted from the North. Spring
+c                          equinoxe.
+c    ptime                 Universal time (0<ptime<1): ptime=0.5 at 12:00 UT
+c    ptimestep             timestep (s)
+c    pplay(ngrid,nlayer)   Pressure at the middle of the layers (Pa)
+c    pplev(ngrid,nlayer+1) intermediate pressure levels (pa)
+c    pphi(ngrid,nlayer)    Geopotential at the middle of the layers (m2s-2)
+c    pu(ngrid,nlayer)      u component of the wind (ms-1)
+c    pv(ngrid,nlayer)      v component of the wind (ms-1)
+c    pt(ngrid,nlayer)      Temperature (K)
+c    pq(ngrid,nlayer,nq)   Advected fields
+c    pudyn(ngrid,nlayer)    | 
+c    pvdyn(ngrid,nlayer)    | Dynamical temporal derivative for the
+c    ptdyn(ngrid,nlayer)    | corresponding variables
+c    pqdyn(ngrid,nlayer,nq) |
+c    flxw(ngrid,nlayer)      vertical mass flux (kg/s) at layer lower boundary
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayer)       |
+c    pdv(ngrid,nlayer)       |  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayer)       |  variables due to physical processes.
+c    pdq(ngrid,nlayer,nq)    |
+c    pdpsrf(ngrid)           |
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "callkeys.h"
+#include "comg1d.h"
+#include "nlteparams.h"
+#include "chimiedata.h"
+#include "netcdf.inc"
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER,INTENT(in) :: ngrid ! number of atmospheric columns
+      INTEGER,INTENT(in) :: nlayer ! number of atmospheric layers
+      INTEGER,INTENT(in) :: nq ! number of tracers
+      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) :: flxw(ngrid,nlayer) ! vertical mass flux (ks/s)
+                                            ! at lower boundary of layer
+
+c   outputs:
+c   --------
+c     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
+
+
+c Local saved variables:
+c ----------------------
+      INTEGER,SAVE :: day_ini ! Initial date of the run (sol since Ls=0)
+      INTEGER,SAVE :: icount     ! counter of calls to physiq during the run.
+#ifdef DUSTSTORM
+      REAL pq_tmp(ngrid, nlayer, 2) ! To compute tendencies due the dust bomb
+#endif
+c     Variables used by the water ice microphysical scheme:
+      REAL rice(ngrid,nlayer)    ! Water ice geometric mean radius (m)
+      REAL nuice(ngrid,nlayer)   ! Estimated effective variance
+                                     !   of the size distribution
+      real rsedcloud(ngrid,nlayer) ! Cloud sedimentation radius
+      real rhocloud(ngrid,nlayer)  ! Cloud density (kg.m-3)
+      REAL inertiesoil(ngrid,nsoilmx) ! Time varying subsurface
+                                      ! thermal inertia (J.s-1/2.m-2.K-1)
+                                      ! (used only when tifeedback=.true.)
+c     Variables used by the photochemistry
+      logical :: asis             ! true  : adaptative semi-implicit symmetric (asis) chemical solver
+                                  ! false : euler backward chemical solver
+      REAL surfdust(ngrid,nlayer) ! dust surface area (m2/m3, if photochemistry)
+      REAL surfice(ngrid,nlayer)  !  ice surface area (m2/m3, if photochemistry)
+c     Variables used by the slope model
+      REAL sl_ls, sl_lct, sl_lat
+      REAL sl_tau, sl_alb, sl_the, sl_psi
+      REAL sl_fl0, sl_flu
+      REAL sl_ra, sl_di0
+      REAL sky
+
+      REAL,PARAMETER :: stephan = 5.67e-08 ! Stephan Boltzman constant
+
+c Local variables :
+c -----------------
+
+      REAL CBRT
+      EXTERNAL CBRT
+
+!      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq,tapphys
+
+      REAL fluxsurf_lw(ngrid)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngrid,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngrid)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngrid,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngrid)           ! Reference column optical depth at odpref
+      real,parameter :: odpref=610. ! DOD reference pressure (Pa)
+      REAL tau(ngrid,naerkind)     ! Column dust optical depth at each point
+                                   ! AS: TBD: this one should be in a module !
+      REAL dsodust(ngrid,nlayer)   ! density-scaled opacity (in infrared) 
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngrid,nlayer)     ! altitude at the middle of the layers
+      REAL zzlev(ngrid,nlayer+1)   ! altitude at layer boundaries
+!      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngrid,nq)
+      REAL zdtlw(ngrid,nlayer)     ! (K/s)
+      REAL zdtsw(ngrid,nlayer)     ! (K/s)
+!      REAL cldtlw(ngrid,nlayer)     ! (K/s) LW heating rate for clear area
+!      REAL cldtsw(ngrid,nlayer)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngrid,nlayer) ! (K/s)
+      REAL zdtnlte(ngrid,nlayer)   ! (K/s)
+      REAL zdtsurf(ngrid)            ! (K/s)
+      REAL zdtcloud(ngrid,nlayer)
+      REAL zdvdif(ngrid,nlayer),zdudif(ngrid,nlayer)  ! (m.s-2)
+      REAL zdhdif(ngrid,nlayer), zdtsdif(ngrid)         ! (K/s)
+      REAL zdvadj(ngrid,nlayer),zduadj(ngrid,nlayer)  ! (m.s-2)
+      REAL zdhadj(ngrid,nlayer)                           ! (K/s)
+      REAL zdtgw(ngrid,nlayer)                            ! (K/s)
+      REAL zdugw(ngrid,nlayer),zdvgw(ngrid,nlayer)    ! (m.s-2)
+      REAL zdtc(ngrid,nlayer),zdtsurfc(ngrid)
+      REAL zdvc(ngrid,nlayer),zduc(ngrid,nlayer)
+
+      REAL zdqdif(ngrid,nlayer,nq), zdqsdif(ngrid,nq)
+      REAL zdqsed(ngrid,nlayer,nq), zdqssed(ngrid,nq)
+      REAL zdqdev(ngrid,nlayer,nq), zdqsdev(ngrid,nq)
+      REAL zdqadj(ngrid,nlayer,nq)
+      REAL zdqc(ngrid,nlayer,nq)
+      REAL zdqcloud(ngrid,nlayer,nq)
+      REAL zdqscloud(ngrid,nq)
+      REAL zdqchim(ngrid,nlayer,nq)
+      REAL zdqschim(ngrid,nq)
+
+      REAL zdteuv(ngrid,nlayer)    ! (K/s)
+      REAL zdtconduc(ngrid,nlayer) ! (K/s)
+      REAL zdumolvis(ngrid,nlayer)
+      REAL zdvmolvis(ngrid,nlayer)
+      real zdqmoldiff(ngrid,nlayer,nq)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngrid)
+      REAL zplanck(ngrid),zpopsk(ngrid,nlayer)
+      REAL zdum1(ngrid,nlayer)
+      REAL zdum2(ngrid,nlayer)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngrid,nlayer)
+      REAL zh(ngrid,nlayer)      ! potential temperature (K)
+      REAL pw(ngrid,nlayer) ! vertical velocity (m/s) (>0 when downwards)
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngrid), zt(ngrid,nlayer)
+      REAL zu(ngrid,nlayer),zv(ngrid,nlayer)
+      REAL zq(ngrid,nlayer,nq)
+      REAL fluxtop_sw_tot(ngrid), fluxsurf_sw_tot(ngrid)
+      character*2 str2
+!      character*5 str5
+      real zdtdif(ngrid,nlayer), zdtadj(ngrid,nlayer)
+      real rdust(ngrid,nlayer) ! dust geometric mean radius (m)
+      integer igmin, lmin
+      logical tdiag
+
+      real co2col(ngrid)        ! CO2 column
+      ! pplev and pplay are dynamical inputs and must not be modified in the physics.
+      ! instead, use zplay and zplev :
+      REAL zplev(ngrid,nlayer+1),zplay(ngrid,nlayer) 
+!      REAL zstress(ngrid),cd
+      real tmean, zlocal(nlayer)
+      real rho(ngrid,nlayer)  ! density
+      real vmr(ngrid,nlayer)  ! volume mixing ratio
+      real rhopart(ngrid,nlayer) ! number density of a given species
+      real colden(ngrid,nq)     ! vertical column of tracers
+      real mass(nq)             ! global mass of tracers (g)
+      REAL mtot(ngrid)          ! Total mass of water vapor (kg/m2)
+      REAL icetot(ngrid)        ! Total mass of water ice (kg/m2)
+      REAL Nccntot(ngrid)       ! Total number of ccn (nbr/m2)
+      REAL Mccntot(ngrid)       ! Total mass of ccn (kg/m2)
+      REAL rave(ngrid)          ! Mean water ice effective radius (m)
+      REAL opTES(ngrid,nlayer)  ! abs optical depth at 825 cm-1
+      REAL tauTES(ngrid)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! Water ice absorption coefficient
+      REAL taucloudtes(ngrid)  ! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+                               
+      REAL dqdustsurf(ngrid) ! surface q dust flux (kg/m2/s)
+      REAL dndustsurf(ngrid) ! surface n dust flux (number/m2/s)
+      REAL ndust(ngrid,nlayer) ! true n dust (kg/kg)
+      REAL qdust(ngrid,nlayer) ! true q dust (kg/kg)
+      REAL nccn(ngrid,nlayer)  ! true n ccn (kg/kg)
+      REAL qccn(ngrid,nlayer)  ! true q ccn (kg/kg)
+
+c Test 1d/3d scavenging
+      real h2otot(ngrid)
+      REAL satu(ngrid,nlayer)  ! satu ratio for output
+      REAL zqsat(ngrid,nlayer) ! saturation
+
+      REAL,SAVE :: time_phys
+
+! Added for new NLTE scheme
+
+      real co2vmr_gcm(ngrid,nlayer)
+      real n2vmr_gcm(ngrid,nlayer)
+      real ovmr_gcm(ngrid,nlayer)
+      real covmr_gcm(ngrid,nlayer)
+      integer ierr_nlte
+      real*8  varerr
+
+c Variables for PBL
+      REAL zz1(ngrid)
+      REAL lmax_th_out(ngrid)
+      REAL pdu_th(ngrid,nlayer),pdv_th(ngrid,nlayer)
+      REAL pdt_th(ngrid,nlayer),pdq_th(ngrid,nlayer,nq)
+      INTEGER lmax_th(ngrid),dimout,n_out,n
+      CHARACTER(50) zstring
+      REAL dtke_th(ngrid,nlayer+1)
+      REAL zcdv(ngrid), zcdh(ngrid)
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: T_out
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: u_out ! Interpolated teta and u at z_out
+      REAL u_out1(ngrid)
+      REAL T_out1(ngrid)
+      REAL, ALLOCATABLE, DIMENSION(:) :: z_out     ! height of interpolation between z0 and z1 [meters]
+      REAL tstar(ngrid)  ! friction velocity and friction potential temp
+      REAL L_mo(ngrid),vhf(ngrid),vvv(ngrid)
+!      REAL zu2(ngrid)
+
+c=======================================================================
+
+c 1. Initialisation:
+c -----------------
+
+c  1.1   Initialisation only at first call
+c  ---------------------------------------
+      IF (firstcall) THEN
+
+c        variables set to 0
+c        ~~~~~~~~~~~~~~~~~~
+         aerosol(:,:,:)=0
+         dtrad(:,:)=0
+
+#ifndef MESOSCALE
+         fluxrad(:)=0
+         wstar(:)=0.
+#endif
+
+c        read startfi 
+c        ~~~~~~~~~~~~
+#ifndef MESOSCALE
+! GCM. Read netcdf initial physical parameters.
+         CALL phyetat0 ("startfi.nc",0,0,
+     &         nsoilmx,ngrid,nlayer,nq,
+     &         day_ini,time_phys,
+     &         tsurf,tsoil,emis,q2,qsurf,co2ice,tauscaling)
+
+         if (pday.ne.day_ini) then
+           write(*,*) "PHYSIQ: ERROR: bad synchronization between ",
+     &                "physics and dynamics"
+           write(*,*) "dynamics day: ",pday
+           write(*,*) "physics day:  ",day_ini
+           stop
+         endif
+
+         write (*,*) 'In physiq day_ini =', day_ini
+
+#else
+! MESOSCALE. Supposedly everything is already set in modules.
+! So we just check. And we calculate day_ini + two param in dyn3d/control_mod.
+      print*,"check: rad,cpp,g,r,rcp,daysec"
+      print*,rad,cpp,g,r,rcp,daysec
+      PRINT*,'check: tsurf ',tsurf(1),tsurf(ngrid)
+      PRINT*,'check: tsoil ',tsoil(1,1),tsoil(ngrid,nsoilmx)
+      PRINT*,'check: inert ',inertiedat(1,1),inertiedat(ngrid,nsoilmx)
+      PRINT*,'check: midlayer,layer ', mlayer(:),layer(:)
+      PRINT*,'check: tracernames ', noms
+      PRINT*,'check: emis ',emis(1),emis(ngrid)
+      PRINT*,'check: q2 ',q2(1,1),q2(ngrid,nlayer+1)
+      PRINT*,'check: qsurf ',qsurf(1,1),qsurf(ngrid,nq)
+      PRINT*,'check: co2 ',co2ice(1),co2ice(ngrid)
+      day_step=daysec/ptimestep
+      PRINT*,'Call to LMD physics:',day_step,' per Martian day'
+      iphysiq=ptimestep
+      day_ini = pday
+#endif
+
+c        initialize tracers
+c        ~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(ngrid,nq,qsurf)
+         ENDIF  ! end tracer
+
+c        Initialize albedo and orbital calculation
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+         CALL surfini(ngrid,co2ice,qsurf,albedo)
+         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
+
+c        initialize soil 
+c        ~~~~~~~~~~~~~~~
+         IF (callsoil) THEN
+c           Thermal inertia feedback:
+            IF (tifeedback) THEN
+                CALL soil_tifeedback(ngrid,nsoilmx,qsurf,inertiesoil)
+                CALL soil(ngrid,nsoilmx,firstcall,inertiesoil,
+     s             ptimestep,tsurf,tsoil,capcal,fluxgrd)
+            ELSE
+                CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s             ptimestep,tsurf,tsoil,capcal,fluxgrd)
+            ENDIF ! of IF (tifeedback)
+         ELSE
+            PRINT*,
+     &     'PHYSIQ WARNING! Thermal conduction in the soil turned off'
+            DO ig=1,ngrid
+               capcal(ig)=1.e5
+               fluxgrd(ig)=0.
+            ENDDO
+         ENDIF
+         icount=1
+
+#ifndef MESOSCALE
+c        Initialize thermospheric parameters
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+         if (callthermos) then
+            call fill_data_thermos
+            call allocate_param_thermos(nlayer)
+            call allocate_param_iono(nlayer,nreact)
+            if(solvarmod.eq.0) call param_read
+            if(solvarmod.eq.1) call param_read_e107
+         endif
+#endif
+c        Initialize R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayer
+                  do ig=1,ngrid
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+
+         if(callnlte.and.nltemodel.eq.2) call nlte_setup
+         if(callnirco2.and.nircorr.eq.1) call NIR_leedat
+         if(thermochem) call chemthermos_readini
+
+        IF (tracer.AND.water.AND.(ngrid.NE.1)) THEN
+          write(*,*)"physiq: water_param Surface water ice albedo:", 
+     .                  albedo_h2o_ice
+        ENDIF
+
+#ifndef MESOSCALE
+         if (callslope) call getslopes(ngrid,phisfi)
+
+         if (ngrid.ne.1) then ! no need to create a restart file in 1d
+         call physdem0("restartfi.nc",longitude,latitude,
+     &                 nsoilmx,ngrid,nlayer,nq,
+     &                 ptimestep,pday,time_phys,cell_area,
+     &                 albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+         endif
+#endif
+                   
+      ENDIF        !  (end of "if firstcall")
+
+
+c ---------------------------------------------------
+c 1.2   Initializations done at every physical timestep:
+c ---------------------------------------------------
+c
+
+c     Initialize various variables
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      pdv(:,:)=0
+      pdu(:,:)=0
+      pdt(:,:)=0
+      pdq(:,:,:)=0
+      pdpsrf(:)=0
+      zflubid(:)=0
+      zdtsurf(:)=0
+      dqsurf(:,:)=0
+#ifdef DUSTSTORM
+      pq_tmp(:,:,:)=0
+#endif
+      igout=ngrid/2+1 
+
+
+      zday=pday+ptime ! compute time, in sols (and fraction thereof)
+
+c     Compute Solar Longitude (Ls) :
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (season) then
+         call solarlong(zday,zls)
+      else
+         call solarlong(float(day_ini),zls)
+      end if
+
+c     Initialize pressure levels
+c     ~~~~~~~~~~~~~~~~~~
+      zplev(:,:) = pplev(:,:)
+      zplay(:,:) = pplay(:,:)
+      ps(:) = pplev(:,1)
+
+
+c     Compute geopotential at interlayers
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     ponderation des altitudes au niveau des couches en dp/p
+
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zzlay(ig,l)=pphi(ig,l)/g
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+         zzlev(ig,1)=0.
+         zzlev(ig,nlayer+1)=1.e7    ! dummy top of last layer above 10000 km...
+      ENDDO
+      DO l=2,nlayer
+         DO ig=1,ngrid
+            z1=(zplay(ig,l-1)+zplev(ig,l))/(zplay(ig,l-1)-zplev(ig,l))
+            z2=(zplev(ig,l)+zplay(ig,l))/(zplev(ig,l)-zplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Compute potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DO l=1,nlayer
+         DO ig=1,ngrid 
+            zpopsk(ig,l)=(zplay(ig,l)/zplev(ig,1))**rcp
+            zh(ig,l)=pt(ig,l)/zpopsk(ig,l)
+         ENDDO
+      ENDDO
+
+#ifndef MESOSCALE
+c-----------------------------------------------------------------------
+c    1.2.5 Compute mean mass, cp, and R
+c    --------------------------------
+
+      if(photochem.or.callthermos) then
+         call concentrations(ngrid,nlayer,nq,
+     &                       zplay,pt,pdt,pq,pdq,ptimestep)
+      endif
+#endif
+
+      ! Compute vertical velocity (m/s) from vertical mass flux
+      ! w = F / (rho*area) and rho = P/(r*T)
+      ! but first linearly interpolate mass flux to mid-layers
+      do l=1,nlayer-1
+       pw(1:ngrid,l)=0.5*(flxw(1:ngrid,l)+flxw(1:ngrid,l+1))
+      enddo
+      pw(1:ngrid,nlayer)=0.5*flxw(1:ngrid,nlayer) ! since flxw(nlayer+1)=0
+      do l=1,nlayer
+       pw(1:ngrid,l)=(pw(1:ngrid,l)*r*pt(1:ngrid,l)) / 
+     &               (pplay(1:ngrid,l)*cell_area(1:ngrid))
+       ! NB: here we use r and not rnew since this diagnostic comes
+       ! from the dynamics
+      enddo
+
+c-----------------------------------------------------------------------
+c    2. Compute radiative tendencies :
+c------------------------------------
+
+
+      IF (callrad) THEN
+         IF( MOD(icount-1,iradia).EQ.0) THEN
+
+c          Local Solar zenith angle
+c          ~~~~~~~~~~~~~~~~~~~~~~~~
+           CALL orbite(zls,dist_sol,declin)
+
+           IF(diurnal) THEN
+               ztim1=SIN(declin)
+               ztim2=COS(declin)*COS(2.*pi*(zday-.5))
+               ztim3=-COS(declin)*SIN(2.*pi*(zday-.5))
+
+               CALL solang(ngrid,sinlon,coslon,sinlat,coslat,
+     s         ztim1,ztim2,ztim3, mu0,fract)
+
+           ELSE
+               CALL mucorr(ngrid,declin,latitude,mu0,fract,10000.,rad)
+           ENDIF
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           IF(callnlte) then
+              if(nltemodel.eq.0.or.nltemodel.eq.1) then
+                 CALL nltecool(ngrid,nlayer,nq,zplay,pt,pq,zdtnlte)
+              else if(nltemodel.eq.2) then
+                co2vmr_gcm(1:ngrid,1:nlayer)=
+     &                      pq(1:ngrid,1:nlayer,igcm_co2)*
+     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_co2)
+                n2vmr_gcm(1:ngrid,1:nlayer)=
+     &                      pq(1:ngrid,1:nlayer,igcm_n2)*
+     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_n2)
+                covmr_gcm(1:ngrid,1:nlayer)=
+     &                      pq(1:ngrid,1:nlayer,igcm_co)*
+     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_co)
+                ovmr_gcm(1:ngrid,1:nlayer)=
+     &                      pq(1:ngrid,1:nlayer,igcm_o)*
+     &                      mmean(1:ngrid,1:nlayer)/mmol(igcm_o)
+                 
+                 CALL nlte_tcool(ngrid,nlayer,zplay*9.869e-6,
+     $                pt,zzlay,co2vmr_gcm, n2vmr_gcm, covmr_gcm, 
+     $                ovmr_gcm,  zdtnlte,ierr_nlte,varerr )
+                 if(ierr_nlte.gt.0) then
+                    write(*,*)
+     $                'WARNING: nlte_tcool output with error message',
+     $                'ierr_nlte=',ierr_nlte,'varerr=',varerr
+                    write(*,*)'I will continue anyway'
+                 endif
+
+                 zdtnlte(1:ngrid,1:nlayer)=
+     &                             zdtnlte(1:ngrid,1:nlayer)/86400.
+              endif
+           else
+              zdtnlte(:,:)=0.
+           endif
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+     &          CALL nlthermeq(ngrid,nlayer,zplev,zplay)
+
+c          Note: Dustopacity.F has been transferred to callradite.F
+
+#ifdef DUSTSTORM
+!! specific case: save the quantity of dust before adding perturbation
+       if (firstcall) then
+        pq_tmp(1:ngrid,1:nlayer,1)=pq(1:ngrid,1:nlayer,igcm_dust_mass)
+        pq_tmp(1:ngrid,1:nlayer,2)=pq(1:ngrid,1:nlayer,igcm_dust_number)
+       endif
+#endif
+         
+c          Call main radiative transfer scheme
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c          Transfer through CO2 (except NIR CO2 absorption)
+c            and aerosols (dust and water ice)
+
+c          Radiative transfer
+c          ------------------
+
+           CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
+     $     emis,mu0,zplev,zplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     $     tauref,tau,aerosol,dsodust,tauscaling,taucloudtes,rdust,rice,
+     $     nuice,co2ice)
+
+
+#ifdef DUSTSTORM
+!! specific case: compute the added quantity of dust for perturbation
+       if (firstcall) then
+         pdq(1:ngrid,1:nlayer,igcm_dust_mass)= 
+     &      pdq(1:ngrid,1:nlayer,igcm_dust_mass)
+     &      - pq_tmp(1:ngrid,1:nlayer,1)
+     &      + pq(1:ngrid,1:nlayer,igcm_dust_mass)
+         pdq(1:ngrid,1:nlayer,igcm_dust_number)=
+     &      pdq(1:ngrid,1:nlayer,igcm_dust_number)
+     &      - pq_tmp(1:ngrid,1:nlayer,2)
+     &      + pq(1:ngrid,1:nlayer,igcm_dust_number)
+       endif
+#endif
+
+c          Outputs for basic check (middle of domain)
+c          ------------------------------------------
+           write(*,'("Ls =",f11.6," check lat =",f10.6,
+     &               " lon =",f11.6)')
+     &           zls*180./pi,latitude(igout)*180/pi,
+     &                       longitude(igout)*180/pi
+           write(*,'(" tauref(",f4.0," Pa) =",f9.6,
+     &             " tau(",f4.0," Pa) =",f9.6)')
+     &            odpref,tauref(igout),
+     &            odpref,tau(igout,1)*odpref/zplev(igout,1)
+c          ---------------------------------------------------------
+c          Call slope parameterization for direct and scattered flux
+c          ---------------------------------------------------------
+           IF(callslope) THEN
+            print *, 'Slope scheme is on and computing...'
+            DO ig=1,ngrid  
+              sl_the = theta_sl(ig)
+              IF (sl_the .ne. 0.) THEN
+                ztim1=fluxsurf_sw(ig,1)+fluxsurf_sw(ig,2)
+                DO l=1,2
+                 sl_lct = ptime*24. + 180.*longitude(ig)/pi/15.
+                 sl_ra  = pi*(1.0-sl_lct/12.)
+                 sl_lat = 180.*latitude(ig)/pi
+                 sl_tau = tau(ig,1) !il faudrait iaerdust(iaer)
+                 sl_alb = albedo(ig,l)
+                 sl_psi = psi_sl(ig)
+                 sl_fl0 = fluxsurf_sw(ig,l)
+                 sl_di0 = 0.
+                 if (mu0(ig) .gt. 0.) then
+                  sl_di0 = mu0(ig)*(exp(-sl_tau/mu0(ig)))
+                  sl_di0 = sl_di0*1370./dist_sol/dist_sol
+                  sl_di0 = sl_di0/ztim1
+                  sl_di0 = fluxsurf_sw(ig,l)*sl_di0
+                 endif
+                 ! you never know (roundup concern...)
+                 if (sl_fl0 .lt. sl_di0) sl_di0=sl_fl0
+                 !!!!!!!!!!!!!!!!!!!!!!!!!!
+                 CALL param_slope( mu0(ig), declin, sl_ra, sl_lat, 
+     &                             sl_tau, sl_alb, sl_the, sl_psi,
+     &                             sl_di0, sl_fl0, sl_flu )
+                 !!!!!!!!!!!!!!!!!!!!!!!!!!
+                 fluxsurf_sw(ig,l) = sl_flu
+                ENDDO
+              !!! compute correction on IR flux as well
+              sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
+              fluxsurf_lw(ig)= fluxsurf_lw(ig)*sky
+              ENDIF
+            ENDDO
+           ENDIF
+
+c          CO2 near infrared absorption
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           zdtnirco2(:,:)=0
+           if (callnirco2) then
+              call nirco2abs (ngrid,nlayer,zplay,dist_sol,nq,pq,
+     .                       mu0,fract,declin, zdtnirco2)
+           endif
+
+c          Radiative flux from the sky absorbed by the surface (W.m-2)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           DO ig=1,ngrid
+               fluxrad_sky(ig)=emis(ig)*fluxsurf_lw(ig)
+     $         +fluxsurf_sw(ig,1)*(1.-albedo(ig,1))
+     $         +fluxsurf_sw(ig,2)*(1.-albedo(ig,2))
+           ENDDO
+
+
+c          Net atmospheric radiative heating rate (K.s-1)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           IF(callnlte) THEN
+              CALL blendrad(ngrid, nlayer, zplay,
+     &             zdtsw, zdtlw, zdtnirco2, zdtnlte, dtrad)
+           ELSE
+              DO l=1,nlayer
+                 DO ig=1,ngrid
+                    dtrad(ig,l)=zdtsw(ig,l)+zdtlw(ig,l)
+     &                          +zdtnirco2(ig,l)
+                  ENDDO
+              ENDDO
+           ENDIF
+
+        ENDIF ! of if(mod(icount-1,iradia).eq.0)
+
+c    Transformation of the radiative tendencies:
+c    -------------------------------------------
+
+c          Net radiative surface flux (W.m-2)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+           DO ig=1,ngrid
+               zplanck(ig)=tsurf(ig)*tsurf(ig)
+               zplanck(ig)=emis(ig)*
+     $         stephan*zplanck(ig)*zplanck(ig)
+               fluxrad(ig)=fluxrad_sky(ig)-zplanck(ig)
+               IF(callslope) THEN
+                 sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
+                 fluxrad(ig)=fluxrad(ig)+(1.-sky)*zplanck(ig)
+               ENDIF
+           ENDDO
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
+            ENDDO
+         ENDDO
+
+      ENDIF ! of IF (callrad)
+
+c-----------------------------------------------------------------------
+c    3. Gravity wave and subgrid scale topography drag :
+c    -------------------------------------------------
+
+
+      IF(calllott)THEN
+
+        CALL calldrag_noro(ngrid,nlayer,ptimestep,
+     &                 zplay,zplev,pt,pu,pv,zdtgw,zdugw,zdvgw)
+ 
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            pdv(ig,l)=pdv(ig,l)+zdvgw(ig,l)
+            pdu(ig,l)=pdu(ig,l)+zdugw(ig,l)
+            pdt(ig,l)=pdt(ig,l)+zdtgw(ig,l)
+          ENDDO
+        ENDDO
+      ENDIF
+
+c-----------------------------------------------------------------------
+c    4. Vertical diffusion (turbulent mixing):
+c    -----------------------------------------
+
+      IF (calldifv) THEN
+
+         DO ig=1,ngrid
+            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
+         ENDDO
+
+         zdum1(:,:)=0
+         zdum2(:,:)=0
+         do l=1,nlayer
+            do ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            enddo
+         enddo
+
+c ----------------------
+c Treatment of a special case : using new surface layer (Richardson based)
+c without using the thermals in gcm and mesoscale can yield problems in
+c weakly unstable situations when winds are near to 0. For those cases, we add
+c a unit subgrid gustiness. Remember that thermals should be used we using the 
+c Richardson based surface layer model.
+        IF ( .not.calltherm 
+     .       .and. callrichsl 
+     .       .and. .not.turb_resolved) THEN
+          DO ig=1, ngrid
+             IF (zh(ig,1) .lt. tsurf(ig)) THEN
+               wstar(ig)=1.
+               hfmax_th(ig)=0.2
+             ELSE
+               wstar(ig)=0.
+               hfmax_th(ig)=0.
+             ENDIF      
+          ENDDO
+        ENDIF
+c ----------------------
+
+         IF (tke_heat_flux .ne. 0.) THEN
+             zz1(:)=(pt(:,1)+pdt(:,1)*ptimestep)*(r/g)*
+     &                 (-alog(zplay(:,1)/zplev(:,1)))
+             pdt(:,1)=pdt(:,1) + (tke_heat_flux/zz1(:))*zpopsk(:,1)
+         ENDIF
+
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        zplay,zplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif,wstar,zcdv,zcdh,hfmax_th,sensibFlux)
+
+
+          DO ig=1,ngrid
+             zdtsurf(ig)=zdtsurf(ig)+zdtsdif(ig)
+          ENDDO
+
+         IF (.not.turb_resolved) THEN
+          DO l=1,nlayer
+            DO ig=1,ngrid
+               pdv(ig,l)=pdv(ig,l)+zdvdif(ig,l)
+               pdu(ig,l)=pdu(ig,l)+zdudif(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhdif(ig,l)*zpopsk(ig,l)
+
+               zdtdif(ig,l)=zdhdif(ig,l)*zpopsk(ig,l) ! for diagnostic only
+            ENDDO
+          ENDDO
+
+          if (tracer) then
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdif(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+           DO iq=1, nq
+              DO ig=1,ngrid
+                 dqsurf(ig,iq)=dqsurf(ig,iq) + zdqsdif(ig,iq)
+              ENDDO
+           ENDDO
+          end if ! of if (tracer)
+         ELSE
+           write (*,*) '******************************************'
+           write (*,*) '** LES mode: the difv part is only used to'
+           write (*,*) '**  - provide HFX and UST to the dynamics'
+           write (*,*) '**  - update TSURF'
+           write (*,*) '******************************************'
+           !! Specific treatment for lifting in turbulent-resolving mode (AC)
+           IF (lifting .and. doubleq) THEN
+             !! lifted dust is injected in the first layer. 
+             !! Sedimentation must be called after turbulent mixing, i.e. on next step, after WRF. 
+             !! => lifted dust is not incremented before the sedimentation step.
+             zdqdif(1:ngrid,1,1:nq)=0.
+             zdqdif(1:ngrid,1,igcm_dust_number) = 
+     .                  -zdqsdif(1:ngrid,igcm_dust_number)
+             zdqdif(1:ngrid,1,igcm_dust_mass) = 
+     .                  -zdqsdif(1:ngrid,igcm_dust_mass)
+             zdqdif(1:ngrid,2:nlayer,1:nq) = 0.
+             DO iq=1, nq
+              IF ((iq .ne. igcm_dust_mass)
+     &        .and. (iq .ne. igcm_dust_number)) THEN
+                zdqsdif(:,iq)=0.
+              ENDIF
+             ENDDO
+           ELSE
+             zdqdif(1:ngrid,1:nlayer,1:nq) = 0.
+             zdqsdif(1:ngrid,1:nq) = 0.
+           ENDIF
+         ENDIF
+      ELSE    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s        (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+         IF (turb_resolved) THEN
+            write(*,*) 'Turbulent-resolving mode !' 
+            write(*,*) 'Please set calldifv to T in callphys.def'
+            STOP
+         ENDIF
+      ENDIF ! of IF (calldifv)
+
+c-----------------------------------------------------------------------
+c   5. Thermals :
+c   -----------------------------
+
+      if(calltherm .and. .not.turb_resolved) then
+ 
+        call calltherm_interface(ngrid,nlayer,nq,
+     $ tracer,igcm_co2,
+     $ zzlev,zzlay,
+     $ ptimestep,pu,pv,pt,pq,pdu,pdv,pdt,pdq,q2,
+     $ zplay,zplev,pphi,zpopsk,
+     $ pdu_th,pdv_th,pdt_th,pdq_th,lmax_th,zmax_th,
+     $ dtke_th,zdhdif,hfmax_th,wstar,sensibFlux)
+     
+         DO l=1,nlayer
+           DO ig=1,ngrid
+              pdu(ig,l)=pdu(ig,l)+pdu_th(ig,l)
+              pdv(ig,l)=pdv(ig,l)+pdv_th(ig,l)
+              pdt(ig,l)=pdt(ig,l)+pdt_th(ig,l)
+              q2(ig,l)=q2(ig,l)+dtke_th(ig,l)*ptimestep
+           ENDDO
+        ENDDO
+ 
+        DO ig=1,ngrid
+          q2(ig,nlayer+1)=q2(ig,nlayer+1)+dtke_th(ig,nlayer+1)*ptimestep
+        ENDDO      
+    
+        if (tracer) then
+        DO iq=1,nq
+         DO l=1,nlayer
+           DO ig=1,ngrid
+             pdq(ig,l,iq)=pdq(ig,l,iq)+pdq_th(ig,l,iq)
+           ENDDO
+         ENDDO
+        ENDDO
+        endif
+
+        lmax_th_out(:)=real(lmax_th(:))
+
+      else   !of if calltherm
+        lmax_th(:)=0
+        wstar(:)=0.
+        hfmax_th(:)=0.
+        lmax_th_out(:)=0.
+      end if
+
+c-----------------------------------------------------------------------
+c   5. Dry convective adjustment:
+c   -----------------------------
+
+      IF(calladj) THEN
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            ENDDO
+         ENDDO
+         zduadj(:,:)=0
+         zdvadj(:,:)=0
+         zdhadj(:,:)=0
+
+         CALL convadj(ngrid,nlayer,nq,ptimestep,
+     $                zplay,zplev,zpopsk,lmax_th,
+     $                pu,pv,zh,pq,
+     $                pdu,pdv,zdh,pdq,
+     $                zduadj,zdvadj,zdhadj,
+     $                zdqadj)
+
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdu(ig,l)=pdu(ig,l)+zduadj(ig,l)
+               pdv(ig,l)=pdv(ig,l)+zdvadj(ig,l)
+               pdt(ig,l)=pdt(ig,l)+zdhadj(ig,l)*zpopsk(ig,l)
+
+               zdtadj(ig,l)=zdhadj(ig,l)*zpopsk(ig,l) ! for diagnostic only
+            ENDDO
+         ENDDO
+
+         if(tracer) then 
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqadj(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         end if
+      ENDIF ! of IF(calladj)
+
+
+
+c-----------------------------------------------------------------------
+c   6. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if (tracer) then 
+
+c   6a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+           call watercloud(ngrid,nlayer,ptimestep,
+     &                zplev,zplay,pdpsrf,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdtcloud,
+     &                nq,tau,tauscaling,rdust,rice,nuice,
+     &                rsedcloud,rhocloud)
+     
+c Temperature variation due to latent heat release
+           if (activice) then
+               pdt(1:ngrid,1:nlayer) = 
+     &          pdt(1:ngrid,1:nlayer) + 
+     &          zdtcloud(1:ngrid,1:nlayer)
+           endif
+           
+! increment water vapour and ice atmospheric tracers tendencies
+           pdq(1:ngrid,1:nlayer,igcm_h2o_vap) = 
+     &       pdq(1:ngrid,1:nlayer,igcm_h2o_vap) + 
+     &       zdqcloud(1:ngrid,1:nlayer,igcm_h2o_vap)
+           pdq(1:ngrid,1:nlayer,igcm_h2o_ice) = 
+     &       pdq(1:ngrid,1:nlayer,igcm_h2o_ice) + 
+     &       zdqcloud(1:ngrid,1:nlayer,igcm_h2o_ice)
+
+! increment dust and ccn masses and numbers
+! We need to check that we have Nccn & Ndust > 0
+! This is due to single precision rounding problems
+           if (microphys) then
+             pdq(1:ngrid,1:nlayer,igcm_ccn_mass) = 
+     &         pdq(1:ngrid,1:nlayer,igcm_ccn_mass) + 
+     &         zdqcloud(1:ngrid,1:nlayer,igcm_ccn_mass)
+             pdq(1:ngrid,1:nlayer,igcm_ccn_number) = 
+     &         pdq(1:ngrid,1:nlayer,igcm_ccn_number) + 
+     &         zdqcloud(1:ngrid,1:nlayer,igcm_ccn_number)
+             where (pq(:,:,igcm_ccn_mass) + 
+     &       ptimestep*pdq(:,:,igcm_ccn_mass) < 0.)
+               pdq(:,:,igcm_ccn_mass) = 
+     &         - pq(:,:,igcm_ccn_mass)/ptimestep + 1.e-30
+               pdq(:,:,igcm_ccn_number) = 
+     &         - pq(:,:,igcm_ccn_number)/ptimestep + 1.e-30
+             end where
+             where (pq(:,:,igcm_ccn_number) + 
+     &       ptimestep*pdq(:,:,igcm_ccn_number) < 0.)
+               pdq(:,:,igcm_ccn_mass) = 
+     &         - pq(:,:,igcm_ccn_mass)/ptimestep + 1.e-30
+               pdq(:,:,igcm_ccn_number) = 
+     &         - pq(:,:,igcm_ccn_number)/ptimestep + 1.e-30
+             end where
+           endif
+
+           if (scavenging) then
+             pdq(1:ngrid,1:nlayer,igcm_dust_mass) = 
+     &         pdq(1:ngrid,1:nlayer,igcm_dust_mass) + 
+     &         zdqcloud(1:ngrid,1:nlayer,igcm_dust_mass)
+             pdq(1:ngrid,1:nlayer,igcm_dust_number) = 
+     &         pdq(1:ngrid,1:nlayer,igcm_dust_number) + 
+     &         zdqcloud(1:ngrid,1:nlayer,igcm_dust_number)
+             where (pq(:,:,igcm_dust_mass) + 
+     &       ptimestep*pdq(:,:,igcm_dust_mass) < 0.)
+               pdq(:,:,igcm_dust_mass) = 
+     &         - pq(:,:,igcm_dust_mass)/ptimestep + 1.e-30
+               pdq(:,:,igcm_dust_number) = 
+     &         - pq(:,:,igcm_dust_number)/ptimestep + 1.e-30
+             end where
+             where (pq(:,:,igcm_dust_number) + 
+     &       ptimestep*pdq(:,:,igcm_dust_number) < 0.)
+               pdq(:,:,igcm_dust_mass) = 
+     &         - pq(:,:,igcm_dust_mass)/ptimestep + 1.e-30
+               pdq(:,:,igcm_dust_number) = 
+     &         - pq(:,:,igcm_dust_number)/ptimestep + 1.e-30
+             end where
+           endif ! of if scavenging
+                      
+
+         END IF  ! of IF (water)
+
+c   6b. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, zplev,pu,pv,pt, tsurf,q2,
+     &                zdqdev,zdqsdev)
+ 
+           if (dustbin.ge.1) then
+              do iq=1,nq
+                 DO l=1,nlayer
+                    DO ig=1,ngrid
+                       pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdev(ig,l,iq)
+                    ENDDO
+                 ENDDO
+              enddo
+              do iq=1,nq
+                 DO ig=1,ngrid
+                    dqsurf(ig,iq)= dqsurf(ig,iq) + zdqsdev(ig,iq)
+                 ENDDO
+              enddo
+           endif  ! of if (dustbin.ge.1)
+
+         END IF ! of IF (callddevil)
+
+c        ------------- 
+c        Sedimentation :   acts also on water ice
+c        ------------- 
+         IF (sedimentation) THEN 
+           zdqsed(1:ngrid,1:nlayer,1:nq)=0
+           zdqssed(1:ngrid,1:nq)=0
+
+           call callsedim(ngrid,nlayer, ptimestep,
+     &                zplev,zzlev, zzlay, pt, pdt, rdust, rice,
+     &                rsedcloud,rhocloud,
+     &                pq, pdq, zdqsed, zdqssed,nq, 
+     &                tau,tauscaling)
+
+           DO iq=1, nq
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                    pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqsed(ig,l,iq)
+               ENDDO
+             ENDDO
+           ENDDO
+           DO iq=1, nq
+             DO ig=1,ngrid
+                dqsurf(ig,iq)= dqsurf(ig,iq) + zdqssed(ig,iq)
+             ENDDO
+           ENDDO
+         END IF   ! of IF (sedimentation)
+        
+c Add lifted dust to tendancies after sedimentation in the LES (AC)
+      IF (turb_resolved) THEN
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqdif(ig,l,iq)
+              ENDDO
+            ENDDO
+           ENDDO
+           DO iq=1, nq
+              DO ig=1,ngrid
+                 dqsurf(ig,iq)=dqsurf(ig,iq) + zdqsdif(ig,iq)
+              ENDDO
+           ENDDO
+      ENDIF
+
+c
+c   6c. Chemical species
+c     ------------------
+
+#ifndef MESOSCALE
+c        --------------
+c        photochemistry :
+c        --------------
+         IF (photochem .or. thermochem) then
+
+!           dust and ice surface area
+            call surfacearea(ngrid, nlayer, naerkind,
+     $                       ptimestep, zplay, zzlay, 
+     $                       pt, pq, pdq, nq, 
+     $                       rdust, rice, tau, tauscaling, 
+     $                       surfdust, surfice)
+!           call photochemistry
+
+            asis = .false.
+
+            if (asis) then
+            call calchim_asis(ngrid,nlayer,nq,
+     &                   ptimestep,zplay,zplev,pt,pdt,dist_sol,mu0,
+     $                   zzlev,zzlay,zday,pq,pdq,zdqchim,zdqschim,
+     $                   zdqcloud,zdqscloud,tauref,co2ice,
+     $                   pu,pdu,pv,pdv,surfdust,surfice)
+            else
+            call calchim(ngrid,nlayer,nq,
+     &                   ptimestep,zplay,zplev,pt,pdt,dist_sol,mu0,
+     $                   zzlev,zzlay,zday,pq,pdq,zdqchim,zdqschim,
+     $                   zdqcloud,zdqscloud,tauref,co2ice,
+     $                   pu,pdu,pv,pdv,surfdust,surfice)
+            end if
+
+           ! increment values of tracers:
+           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
+                      ! tracers is zero anyways
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,iq)=pdq(ig,l,iq)+zdqchim(ig,l,iq)
+               ENDDO
+             ENDDO
+           ENDDO ! of DO iq=1,nq
+           
+           ! add condensation tendency for H2O2
+           if (igcm_h2o2.ne.0) then
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o2)=pdq(ig,l,igcm_h2o2)
+     &                                +zdqcloud(ig,l,igcm_h2o2)
+               ENDDO
+             ENDDO
+           endif
+
+           ! increment surface values of tracers:
+           DO iq=1,nq ! loop on all tracers; tendencies for non-chemistry
+                      ! tracers is zero anyways
+             DO ig=1,ngrid
+               dqsurf(ig,iq)=dqsurf(ig,iq)+zdqschim(ig,iq)
+             ENDDO
+           ENDDO ! of DO iq=1,nq
+
+           ! add condensation tendency for H2O2
+           if (igcm_h2o2.ne.0) then
+             DO ig=1,ngrid
+               dqsurf(ig,igcm_h2o2)=dqsurf(ig,igcm_h2o2)
+     &                                +zdqscloud(ig,igcm_h2o2)
+             ENDDO
+           endif
+
+         END IF  ! of IF (photochem.or.thermochem)
+#endif
+
+c   6d. Updates
+c     ---------
+
+        DO iq=1, nq
+          DO ig=1,ngrid
+
+c       ---------------------------------
+c       Updating tracer budget on surface
+c       ---------------------------------
+            qsurf(ig,iq)=qsurf(ig,iq)+ptimestep*dqsurf(ig,iq)
+
+          ENDDO  ! (ig)
+        ENDDO    ! (iq)
+
+      endif !  of if (tracer) 
+
+#ifndef MESOSCALE
+c-----------------------------------------------------------------------
+c   7. THERMOSPHERE CALCULATION
+c-----------------------------------------------------------------------
+
+      if (callthermos) then
+        call thermosphere(ngrid,nlayer,nq,zplev,zplay,dist_sol,
+     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
+     &     pt,pq,pu,pv,pdt,pdq,
+     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
+
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            dtrad(ig,l)=dtrad(ig,l)+zdteuv(ig,l)
+            pdt(ig,l)=pdt(ig,l)+zdtconduc(ig,l)
+     &                         +zdteuv(ig,l)
+            pdv(ig,l)=pdv(ig,l)+zdvmolvis(ig,l)
+            pdu(ig,l)=pdu(ig,l)+zdumolvis(ig,l)
+            DO iq=1, nq
+              pdq(ig,l,iq)=pdq(ig,l,iq)+zdqmoldiff(ig,l,iq)
+            ENDDO
+          ENDDO
+        ENDDO
+
+      endif ! of if (callthermos)
+#endif
+
+c-----------------------------------------------------------------------
+c   8. Carbon dioxide condensation-sublimation:
+c     (should be the last atmospherical physical process to be computed)
+c   -------------------------------------------
+
+      IF (tituscap) THEN
+         !!! get the actual co2 seasonal cap from Titus observations
+         CALL geticecover( ngrid, 180.*zls/pi,
+     .                  180.*longitude/pi, 180.*latitude/pi, co2ice )
+         co2ice = co2ice * 10000.
+      ENDIF
+      
+      
+      pdpsrf(:) = 0
+
+      IF (callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,zplay,zplev,tsurf,pt,
+     $              pphi,pdt,pdu,pdv,zdtsurf,pu,pv,pq,pdq,
+     $              co2ice,albedo,emis,
+     $              zdtc,zdtsurfc,pdpsrf,zduc,zdvc,zdqc,
+     $              fluxsurf_sw,zls) 
+
+         DO l=1,nlayer
+           DO ig=1,ngrid
+             pdt(ig,l)=pdt(ig,l)+zdtc(ig,l)
+             pdv(ig,l)=pdv(ig,l)+zdvc(ig,l)
+             pdu(ig,l)=pdu(ig,l)+zduc(ig,l)
+           ENDDO
+         ENDDO
+         DO ig=1,ngrid
+            zdtsurf(ig) = zdtsurf(ig) + zdtsurfc(ig)
+         ENDDO
+
+         IF (tracer) THEN
+           DO iq=1, nq
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                pdq(ig,l,iq)=pdq(ig,l,iq)+ zdqc(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         ENDIF ! of IF (tracer)
+
+#ifndef MESOSCALE
+        ! update surface pressure
+        DO ig=1,ngrid
+          ps(ig) = zplev(ig,1) + pdpsrf(ig)*ptimestep
+        ENDDO
+        
+        ! update pressure levels
+        DO l=1,nlayer
+         DO ig=1,ngrid
+          zplay(ig,l) = aps(l) + bps(l)*ps(ig)
+          zplev(ig,l) = ap(l)  + bp(l)*ps(ig)
+         ENDDO
+        ENDDO
+        zplev(:,nlayer+1) = 0.
+        
+        ! update layers altitude
+        DO l=2,nlayer
+          DO ig=1,ngrid
+           z1=(zplay(ig,l-1)+zplev(ig,l))/(zplay(ig,l-1)-zplev(ig,l))
+           z2=(zplev(ig,l)+zplay(ig,l))/(zplev(ig,l)-zplay(ig,l))
+           zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+          ENDDO
+        ENDDO
+#endif
+      
+      ENDIF  ! of IF (callcond)
+      
+
+c-----------------------------------------------------------------------
+c   9. Surface  and sub-surface soil temperature
+c-----------------------------------------------------------------------
+c
+c
+c   9.1 Increment Surface temperature:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      DO ig=1,ngrid
+         tsurf(ig)=tsurf(ig)+ptimestep*zdtsurf(ig) 
+      ENDDO
+
+c  Prescribe a cold trap at south pole (except at high obliquity !!)
+c  Temperature at the surface is set there to be the temperature
+c  corresponding to equilibrium temperature between phases of CO2
+
+
+      IF (tracer.AND.water.AND.(ngrid.NE.1)) THEN
+!#ifndef MESOSCALE 
+!         if (caps.and.(obliquit.lt.27.)) then => now done in newcondens
+           ! NB: Updated surface pressure, at grid point 'ngrid', is
+           !     ps(ngrid)=zplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
+!           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
+!     &                     (zplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
+!           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*ps(ngrid)))
+!         endif
+!#endif
+c       -------------------------------------------------------------
+c       Change of surface albedo in case of ground frost
+c       everywhere except on the north permanent cap and in regions
+c       covered by dry ice. 
+c              ALWAYS PLACE these lines after newcondens !!!
+c       -------------------------------------------------------------
+         do ig=1,ngrid
+           if ((co2ice(ig).eq.0).and.
+     &        (qsurf(ig,igcm_h2o_ice).gt.frost_albedo_threshold)) then
+              albedo(ig,1) = albedo_h2o_ice
+              albedo(ig,2) = albedo_h2o_ice
+c              write(*,*) "frost thickness", qsurf(ig,igcm_h2o_ice)
+c              write(*,*) "physiq.F frost :"
+c     &        ,latitude(ig)*180./pi, longitude(ig)*180./pi
+           endif
+         enddo  ! of do ig=1,ngrid
+      ENDIF  ! of IF (tracer.AND.water.AND.(ngrid.NE.1))
+
+c
+c   9.2 Compute soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+c       Thermal inertia feedback
+        IF (tifeedback) THEN
+         CALL soil_tifeedback(ngrid,nsoilmx,qsurf,inertiesoil)
+         CALL soil(ngrid,nsoilmx,.false.,inertiesoil,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+        ELSE
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+        ENDIF
+      ENDIF
+      
+
+c-----------------------------------------------------------------------
+c  10. Write output files
+c  ----------------------
+
+c    -------------------------------
+c    Dynamical fields incrementation
+c    -------------------------------
+c (FOR OUTPUT ONLY : the actual model integration is performed in the dynamics)
+      ! temperature, zonal and meridional wind
+      DO l=1,nlayer
+        DO ig=1,ngrid
+          zt(ig,l)=pt(ig,l)  + pdt(ig,l)*ptimestep
+          zu(ig,l)=pu(ig,l)  + pdu(ig,l)*ptimestep
+          zv(ig,l)=pv(ig,l)  + pdv(ig,l)*ptimestep
+        ENDDO
+      ENDDO
+
+      ! tracers
+      DO iq=1, nq
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            zq(ig,l,iq)=pq(ig,l,iq) +pdq(ig,l,iq)*ptimestep
+          ENDDO
+        ENDDO
+      ENDDO
+
+      ! Density 
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            rho(ig,l) = zplay(ig,l)/(rnew(ig,l)*zt(ig,l))
+         ENDDO
+      ENDDO
+
+      ! Potential Temperature
+
+       DO ig=1,ngrid
+          DO l=1,nlayer
+              zh(ig,l) = zt(ig,l)*(zplev(ig,1)/zplay(ig,l))**rcp
+          ENDDO
+       ENDDO
+
+
+c    Compute surface stress : (NB: z0 is a common in surfdat.h)
+c     DO ig=1,ngrid
+c        cd = (0.4/log(zzlay(ig,1)/z0(ig)))**2
+c        zstress(ig) = rho(ig,1)*cd*(zu(ig,1)**2 + zv(ig,1)**2)
+c     ENDDO
+
+c     Sum of fluxes in solar spectral bands (for output only)
+      DO ig=1,ngrid
+             fluxtop_sw_tot(ig)=fluxtop_sw(ig,1) + fluxtop_sw(ig,2)
+             fluxsurf_sw_tot(ig)=fluxsurf_sw(ig,1) + fluxsurf_sw(ig,2)
+      ENDDO
+c ******* TEST ******************************************************
+      ztim1 = 999
+      DO l=1,nlayer
+        DO ig=1,ngrid
+           if (pt(ig,l).lt.ztim1) then
+               ztim1 = pt(ig,l)
+               igmin = ig
+               lmin = l 
+           end if
+        ENDDO
+      ENDDO
+      if(min(pt(igmin,lmin),zt(igmin,lmin)).lt.70.) then
+        write(*,*) 'PHYSIQ: stability WARNING :'
+        write(*,*) 'pt, zt Tmin = ', pt(igmin,lmin), zt(igmin,lmin),
+     &              'ig l =', igmin, lmin
+      end if
+c *******************************************************************
+
+c     ---------------------
+c     Outputs to the screen 
+c     ---------------------
+
+      IF (lwrite) THEN
+         PRINT*,'Global diagnostics for the physics'
+         PRINT*,'Variables and their increments x and dx/dt * dt'
+         WRITE(*,'(a6,a10,2a15)') 'Ts','dTs','ps','dps'
+         WRITE(*,'(2f10.5,2f15.5)')
+     s   tsurf(igout),zdtsurf(igout)*ptimestep,
+     s   zplev(igout,1),pdpsrf(igout)*ptimestep
+         WRITE(*,'(a4,a6,5a10)') 'l','u','du','v','dv','T','dT'
+         WRITE(*,'(i4,6f10.5)') (l,
+     s   pu(igout,l),pdu(igout,l)*ptimestep,
+     s   pv(igout,l),pdv(igout,l)*ptimestep,
+     s   pt(igout,l),pdt(igout,l)*ptimestep,
+     s   l=1,nlayer)
+      ENDIF ! of IF (lwrite)
+
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+c        INTERPOLATIONS IN THE SURFACE-LAYER
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+
+           n_out=0 ! number of elements in the z_out array.
+                   ! for z_out=[3.,2.,1.,0.5,0.1], n_out must be set
+                   ! to 5
+           IF (n_out .ne. 0) THEN
+
+           IF(.NOT. ALLOCATED(z_out)) ALLOCATE(z_out(n_out))
+           IF(.NOT. ALLOCATED(T_out)) ALLOCATE(T_out(ngrid,n_out))
+           IF(.NOT. ALLOCATED(u_out)) ALLOCATE(u_out(ngrid,n_out))
+
+           z_out(:)=[3.,2.,1.,0.5,0.1]
+           u_out(:,:)=0.
+           T_out(:,:)=0.
+
+           call pbl_parameters(ngrid,nlayer,ps,zplay,z0,
+     & g,zzlay,zzlev,zu,zv,wstar,hfmax_th,zmax_th,tsurf,zh,z_out,n_out,
+     & T_out,u_out,ustar,tstar,L_mo,vhf,vvv)
+                   ! pourquoi ustar recalcule ici? fait dans vdifc.
+
+#ifndef MESOSCALE
+            IF (ngrid .eq. 1) THEN
+               dimout=0
+            ELSE
+               dimout=2
+            ENDIF
+            DO n=1,n_out
+               write(zstring, '(F8.6)') z_out(n)
+               call WRITEDIAGFI(ngrid,'T_out_'//trim(zstring),
+     &   'potential temperature at z_out','K',dimout,T_out(:,n))
+               call WRITEDIAGFI(ngrid,'u_out_'//trim(zstring),
+     &   'horizontal velocity norm at z_out','m/s',dimout,u_out(:,n))
+            ENDDO
+            call WRITEDIAGFI(ngrid,'u_star',
+     &   'friction velocity','m/s',dimout,ustar)
+            call WRITEDIAGFI(ngrid,'teta_star',
+     &   'friction potential temperature','K',dimout,tstar)
+!            call WRITEDIAGFI(ngrid,'L',
+!     &   'Monin Obukhov length','m',dimout,L_mo)
+            call WRITEDIAGFI(ngrid,'vvv',
+     &   'Vertical velocity variance at zout','m',dimout,vvv)
+            call WRITEDIAGFI(ngrid,'vhf',
+     &   'Vertical heat flux at zout','m',dimout,vhf)
+#else
+         T_out1(:)=T_out(:,1)
+         u_out1(:)=u_out(:,1)
+#endif
+
+         ENDIF
+
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+c        END OF SURFACE LAYER INTERPOLATIONS
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+
+      IF (ngrid.NE.1) THEN
+
+#ifndef MESOSCALE
+c        -------------------------------------------------------------------
+c        Writing NetCDF file  "RESTARTFI" at the end of the run
+c        -------------------------------------------------------------------
+c        Note: 'restartfi' is stored just before dynamics are stored
+c              in 'restart'. Between now and the writting of 'restart',
+c              there will have been the itau=itau+1 instruction and
+c              a reset of 'time' (lastacll = .true. when itau+1= itaufin)
+c              thus we store for time=time+dtvr
+
+         IF(   ((ecritstart.GT.0) .and. 
+     .          (MOD(icount*iphysiq,ecritstart).EQ.0)) 
+     .    .or. lastcall  ) THEN
+         
+          ztime_fin = pday + ptime  + ptimestep/(float(iphysiq)*daysec)
+     .               - day_ini - time_phys
+          print*, pday,ptime,day_ini, time_phys
+          write(*,'(A,I7,A,F12.5)') 
+     .         'PHYSIQ: Ecriture du fichier restartfi ; icount=',
+     .          icount,' date=',ztime_fin
+            
+            
+          call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq,
+     .                ptimestep,ztime_fin,
+     .                tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
+          
+         ENDIF
+#endif
+
+c        -------------------------------------------------------------------
+c        Calculation of diagnostic variables written in both stats and
+c          diagfi files
+c        -------------------------------------------------------------------
+
+         if (tracer) then
+         
+           if(doubleq) then
+              do ig=1,ngrid 
+                dqdustsurf(ig) = 
+     &                zdqssed(ig,igcm_dust_mass)*tauscaling(ig)
+                dndustsurf(ig) = 
+     &                zdqssed(ig,igcm_dust_number)*tauscaling(ig)
+                ndust(ig,:) =
+     &                pq(ig,:,igcm_dust_number)*tauscaling(ig)
+                qdust(ig,:) =
+     &                pq(ig,:,igcm_dust_mass)*tauscaling(ig)
+              enddo
+              if (scavenging) then
+                do ig=1,ngrid 
+                  dqdustsurf(ig) = dqdustsurf(ig) + 
+     &                     zdqssed(ig,igcm_ccn_mass)*tauscaling(ig)
+                  dndustsurf(ig) = dndustsurf(ig) + 
+     &                     zdqssed(ig,igcm_ccn_number)*tauscaling(ig)
+                  nccn(ig,:) =
+     &                     pq(ig,:,igcm_ccn_number)*tauscaling(ig)
+                  qccn(ig,:) =
+     &                     pq(ig,:,igcm_ccn_mass)*tauscaling(ig)
+                enddo
+              endif
+           endif
+                    
+           if (water) then
+             mtot(:)=0
+             icetot(:)=0
+             rave(:)=0
+             tauTES(:)=0
+             do ig=1,ngrid 
+               do l=1,nlayer
+                 mtot(ig) = mtot(ig) + 
+     &                      zq(ig,l,igcm_h2o_vap) * 
+     &                      (zplev(ig,l) - zplev(ig,l+1)) / g
+                 icetot(ig) = icetot(ig) + 
+     &                        zq(ig,l,igcm_h2o_ice) * 
+     &                        (zplev(ig,l) - zplev(ig,l+1)) / g
+c                Computing abs optical depth at 825 cm-1 in each
+c                  layer to simulate NEW TES retrieval
+                 Qabsice = min(
+     &             max(0.4e6*rice(ig,l)*(1.+nuice_ref)-0.05 ,0.),1.2
+     &                        )
+                 opTES(ig,l)= 0.75 * Qabsice * 
+     &             zq(ig,l,igcm_h2o_ice) *
+     &             (zplev(ig,l) - zplev(ig,l+1)) / g
+     &             / (rho_ice * rice(ig,l) * (1.+nuice_ref))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+c              rave(ig)=rave(ig)/max(icetot(ig),1.e-30)       ! mass weight
+c               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
+             enddo
+             call watersat(ngrid*nlayer,zt,zplay,zqsat)
+             satu(:,:) = zq(:,:,igcm_h2o_vap)/zqsat(:,:)
+
+             if (scavenging) then
+               Nccntot(:)= 0
+               Mccntot(:)= 0
+               rave(:)=0
+               do ig=1,ngrid 
+                 do l=1,nlayer
+                    Nccntot(ig) = Nccntot(ig) + 
+     &              zq(ig,l,igcm_ccn_number)*tauscaling(ig)
+     &              *(zplev(ig,l) - zplev(ig,l+1)) / g
+                    Mccntot(ig) = Mccntot(ig) + 
+     &              zq(ig,l,igcm_ccn_mass)*tauscaling(ig)
+     &              *(zplev(ig,l) - zplev(ig,l+1)) / g
+cccc Column integrated effective ice radius 
+cccc is weighted by total ice surface area (BETTER than total ice mass) 
+                    rave(ig) = rave(ig) + 
+     &                      tauscaling(ig) *
+     &                      zq(ig,l,igcm_ccn_number) *
+     &                      (zplev(ig,l) - zplev(ig,l+1)) / g * 
+     &                      rice(ig,l) * rice(ig,l)*  (1.+nuice_ref)
+                 enddo
+               rave(ig)=(icetot(ig)/rho_ice+Mccntot(ig)/rho_dust)*0.75
+     &                  /max(pi*rave(ig),1.e-30) ! surface weight
+               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
+               enddo
+             else ! of if (scavenging)
+               rave(:)=0
+               do ig=1,ngrid 
+                 do l=1,nlayer
+                 rave(ig) = rave(ig) + 
+     &                      zq(ig,l,igcm_h2o_ice) *
+     &                      (zplev(ig,l) - zplev(ig,l+1)) / g * 
+     &                      rice(ig,l) * (1.+nuice_ref)
+                 enddo
+                 rave(ig) = max(rave(ig) / 
+     &             max(icetot(ig),1.e-30),1.e-30) ! mass weight
+               enddo
+             endif ! of if (scavenging)
+
+           endif ! of if (water)
+         endif ! of if (tracer)
+
+#ifndef MESOSCALE
+c        -----------------------------------------------------------------
+c        WSTATS: Saving statistics
+c        -----------------------------------------------------------------
+c        ("stats" stores and accumulates 8 key variables in file "stats.nc"
+c        which can later be used to make the statistic files of the run:
+c        "stats")          only possible in 3D runs !
+         
+       IF (callstats) THEN
+
+        call wstats(ngrid,"ps","Surface pressure","Pa",2,ps)
+        call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf)
+        call wstats(ngrid,"co2ice","CO2 ice cover",
+     &                "kg.m-2",2,co2ice)
+        call wstats(ngrid,"tauref","reference dod at 610 Pa","NU",
+     &                2,tauref)
+        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,"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,"rho","Atmospheric density","kg/m3",3,rho)
+        call wstats(ngrid,"pressure","Pressure","Pa",3,zplay)
+          call wstats(ngrid,"q2",
+     &                "Boundary layer eddy kinetic energy",
+     &                "m2.s-2",3,q2)
+          call wstats(ngrid,"emis","Surface emissivity","w.m-1",2,
+     &                emis)
+c          call wstats(ngrid,"ssurf","Surface stress","N.m-2",
+c    &                2,zstress)
+c          call wstats(ngrid,"sw_htrt","sw heat.rate",
+c    &                 "W.m-2",3,zdtsw)
+c          call wstats(ngrid,"lw_htrt","lw heat.rate",
+c    &                 "W.m-2",3,zdtlw)
+
+          if (calltherm) then
+            call wstats(ngrid,"zmax_th","Height of thermals",
+     &                "m",2,zmax_th)
+            call wstats(ngrid,"hfmax_th","Max thermals heat flux",
+     &                "K.m/s",2,hfmax_th)
+            call wstats(ngrid,"wstar",
+     &                "Max vertical velocity in thermals",
+     &                "m/s",2,wstar)
+          endif
+
+           if (tracer) then
+             if (water) then
+               vmr=zq(1:ngrid,1:nlayer,igcm_h2o_vap)
+     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_vap)
+               call wstats(ngrid,"vmr_h2ovap",
+     &                    "H2O vapor volume mixing ratio","mol/mol",
+     &                    3,vmr)
+               vmr=zq(1:ngrid,1:nlayer,igcm_h2o_ice)
+     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_ice)
+               call wstats(ngrid,"vmr_h2oice",
+     &                    "H2O ice volume mixing ratio","mol/mol",
+     &                    3,vmr)
+              ! also store vmr_ice*rice for better diagnostics of rice
+               vmr(1:ngrid,1:nlayer)=vmr(1:ngrid,1:nlayer)*
+     &                               rice(1:ngrid,1:nlayer)
+               call wstats(ngrid,"vmr_h2oice_rice",
+     &                "H2O ice mixing ratio times ice particule size",
+     &                    "(mol/mol)*m",
+     &                    3,vmr)
+               vmr=zqsat(1:ngrid,1:nlayer)
+     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_vap)
+               call wstats(ngrid,"vmr_h2osat",
+     &                    "saturation volume mixing ratio","mol/mol",
+     &                    3,vmr)
+               call wstats(ngrid,"h2o_ice_s",
+     &                    "surface h2o_ice","kg/m2",
+     &                    2,qsurf(1,igcm_h2o_ice))
+               call wstats(ngrid,'albedo',
+     &                         'albedo',
+     &                         '',2,albedo(1,1))
+               call wstats(ngrid,"mtot",
+     &                    "total mass of water vapor","kg/m2",
+     &                    2,mtot)
+               call wstats(ngrid,"icetot",
+     &                    "total mass of water ice","kg/m2",
+     &                    2,icetot)
+               call wstats(ngrid,"reffice",
+     &                    "Mean reff","m",
+     &                    2,rave)
+              call wstats(ngrid,"Nccntot",
+     &                    "condensation nuclei","Nbr/m2",
+     &                    2,Nccntot)
+              call wstats(ngrid,"Mccntot",
+     &                    "condensation nuclei mass","kg/m2",
+     &                    2,Mccntot)
+              call wstats(ngrid,"rice",
+     &                    "Ice particle size","m",
+     &                    3,rice)
+               if (.not.activice) then
+                 call wstats(ngrid,"tauTESap",
+     &                      "tau abs 825 cm-1","",
+     &                      2,tauTES)
+               else
+                 call wstats(ngrid,'tauTES',
+     &                   'tau abs 825 cm-1',
+     &                  '',2,taucloudtes)
+               endif
+
+             endif ! of if (water)
+             
+             
+           if (dustbin.ne.0) then
+          
+             call wstats(ngrid,'tau','taudust','SI',2,tau(1,1))
+             
+             if (doubleq) then
+c            call wstats(ngrid,'qsurf','qsurf',
+c     &                       'kg.m-2',2,qsurf(1,igcm_dust_mass))
+c            call wstats(ngrid,'Nsurf','N particles',
+c     &                       'N.m-2',2,qsurf(1,igcm_dust_number))
+c            call wstats(ngrid,'dqsdev','ddevil lift',
+c    &                       'kg.m-2.s-1',2,zdqsdev(1,1))
+c            call wstats(ngrid,'dqssed','sedimentation',
+c     &                       'kg.m-2.s-1',2,zdqssed(1,1))
+c            call wstats(ngrid,'dqsdif','diffusion',
+c     &                       'kg.m-2.s-1',2,zdqsdif(1,1))
+               call wstats(ngrid,'dqsdust',
+     &                        'deposited surface dust mass',
+     &                        'kg.m-2.s-1',2,dqdustsurf)
+               call wstats(ngrid,'dqndust',
+     &                        'deposited surface dust number',
+     &                        'number.m-2.s-1',2,dndustsurf)
+               call wstats(ngrid,'reffdust','reffdust',
+     &                        'm',3,rdust*ref_r0)
+               call wstats(ngrid,'dustq','Dust mass mr',
+     &                        'kg/kg',3,qdust)
+               call wstats(ngrid,'dustN','Dust number',
+     &                        'part/kg',3,ndust)
+             else
+               do iq=1,dustbin
+                 write(str2(1:2),'(i2.2)') iq
+                 call wstats(ngrid,'q'//str2,'mix. ratio',
+     &                         'kg/kg',3,zq(1,1,iq))
+                 call wstats(ngrid,'qsurf'//str2,'qsurf',
+     &                         'kg.m-2',2,qsurf(1,iq))
+               end do
+             endif ! (doubleq)
+
+             if (scavenging) then
+               call wstats(ngrid,'ccnq','CCN mass mr',
+     &                        'kg/kg',3,qccn)
+               call wstats(ngrid,'ccnN','CCN number',
+     &                        'part/kg',3,nccn)
+             endif ! (scavenging)
+          
+           endif ! (dustbin.ne.0)
+
+           if (thermochem .or. photochem) then
+              do iq=1,nq
+                 if (noms(iq) .ne. "dust_mass" .and.
+     $               noms(iq) .ne. "dust_number" .and.
+     $               noms(iq) .ne. "ccn_mass" .and.
+     $               noms(iq) .ne. "ccn_number") then
+
+!                   volume mixing ratio
+
+                    vmr(1:ngrid,1:nlayer)=zq(1:ngrid,1:nlayer,iq)
+     &                            *mmean(1:ngrid,1:nlayer)/mmol(iq)
+
+                    call wstats(ngrid,"vmr_"//trim(noms(iq)),
+     $                        "Volume mixing ratio","mol/mol",3,vmr)
+                    if ((noms(iq).eq."o")
+     $             .or. (noms(iq).eq."co2")
+     $             .or. (noms(iq).eq."o3")
+     $             .or. (noms(iq).eq."ar")
+     $             .or. (noms(iq).eq."o2")
+     $             .or. (noms(iq).eq."h2o_vap") ) then
+                      call writediagfi(ngrid,"vmr_"//trim(noms(iq)),
+     $                         "Volume mixing ratio","mol/mol",3,vmr)
+                    end if
+
+!                   number density (molecule.cm-3)
+
+                    rhopart(1:ngrid,1:nlayer)=zq(1:ngrid,1:nlayer,iq)
+     &                          *rho(1:ngrid,1:nlayer)*n_avog/
+     &                           (1000*mmol(iq))
+
+!                   call wstats(ngrid,"rho_"//trim(noms(iq)),
+!    $                     "Number density","cm-3",3,rhopart)
+!                   call writediagfi(ngrid,"rho_"//trim(noms(iq)),
+!    $                     "Number density","cm-3",3,rhopart)
+
+!                   vertical column (molecule.cm-2)
+
+                    do ig = 1,ngrid
+                       colden(ig,iq) = 0.                           
+                    end do
+                    do l=1,nlayer                                    
+                       do ig=1,ngrid                                  
+                          colden(ig,iq) = colden(ig,iq) + zq(ig,l,iq)
+     $                                   *(zplev(ig,l)-zplev(ig,l+1)) 
+     $                                   *6.022e22/(mmol(iq)*g)       
+                       end do                                        
+                    end do                                          
+
+                    call wstats(ngrid,"c_"//trim(noms(iq)),           
+     $                          "column","mol cm-2",2,colden(1,iq))  
+                    call writediagfi(ngrid,"c_"//trim(noms(iq)),
+     $                          "column","mol cm-2",2,colden(1,iq))
+
+!                   global mass (g)
+               
+                    call planetwide_sumval(colden(:,iq)/6.022e23
+     $                            *mmol(iq)*1.e4*cell_area(:),mass(iq))
+
+                    call writediagfi(ngrid,"mass_"//trim(noms(iq)),
+     $                              "global mass","g",0,mass(iq))
+
+                 end if ! of if (noms(iq) .ne. "dust_mass" ...)
+              end do ! of do iq=1,nq
+           end if ! of if (thermochem .or. photochem)
+
+           end if ! of if (tracer)
+
+           IF(lastcall) THEN
+             write (*,*) "Writing stats..."
+             call mkstats(ierr)
+           ENDIF
+
+         ENDIF !if callstats
+
+c        (Store EOF for Mars Climate database software)
+         IF (calleofdump) THEN
+            CALL eofdump(ngrid, nlayer, zu, zv, zt, rho, ps)
+         ENDIF
+#endif
+!endif of ifndef MESOSCALE
+
+#ifdef MESOSCALE
+      
+      !! see comm_wrf. 
+      !! not needed when an array is already in a shared module.
+      !! --> example : hfmax_th, zmax_th
+
+      !state  real  HR_SW     ikj   misc  1  -  h  "HR_SW"     "HEATING RATE SW"                 "K/s"
+      comm_HR_SW(1:ngrid,1:nlayer) = zdtsw(1:ngrid,1:nlayer)
+      !state  real  HR_LW     ikj   misc  1  -  h  "HR_LW"     "HEATING RATE LW"                 "K/s"
+      comm_HR_LW(1:ngrid,1:nlayer) = zdtlw(1:ngrid,1:nlayer)
+      !state  real  SWDOWNZ    ij   misc  1  -  h  "SWDOWNZ"   "DOWNWARD SW FLUX AT SURFACE"     "W m-2"
+      comm_SWDOWNZ(1:ngrid) = fluxsurf_sw_tot(1:ngrid)
+      !state  real  TAU_DUST   ij   misc  1  -  h  "TAU_DUST"  "REFERENCE VISIBLE DUST OPACITY"  ""
+      comm_TAU_DUST(1:ngrid) = tauref(1:ngrid)
+      !state  real  RDUST     ikj   misc  1  -  h  "RDUST"     "DUST RADIUS"                     "m"
+      comm_RDUST(1:ngrid,1:nlayer) = rdust(1:ngrid,1:nlayer)
+      !state  real  QSURFDUST  ij   misc  1  -  h  "QSURFDUST" "DUST MASS AT SURFACE"            "kg m-2"
+      IF (igcm_dust_mass .ne. 0) THEN
+        comm_QSURFDUST(1:ngrid) = qsurf(1:ngrid,igcm_dust_mass)
+      ELSE
+        comm_QSURFDUST(1:ngrid) = 0.
+      ENDIF
+      !state  real  MTOT       ij   misc  1  -  h  "MTOT"      "TOTAL MASS WATER VAPOR in pmic"  "pmic"
+      comm_MTOT(1:ngrid) = mtot(1:ngrid) * 1.e6 / rho_ice
+      !state  real  ICETOT     ij   misc  1  -  h  "ICETOT"    "TOTAL MASS WATER ICE"            "kg m-2"
+      comm_ICETOT(1:ngrid) = icetot(1:ngrid) * 1.e6 / rho_ice
+      !state  real  VMR_ICE   ikj   misc  1  -  h  "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"
+      IF (igcm_h2o_ice .ne. 0) THEN
+        comm_VMR_ICE(1:ngrid,1:nlayer) = 1.e6
+     .    * zq(1:ngrid,1:nlayer,igcm_h2o_ice)
+     .    * mmean(1:ngrid,1:nlayer) / mmol(igcm_h2o_ice)
+      ELSE
+        comm_VMR_ICE(1:ngrid,1:nlayer) = 0.
+      ENDIF
+      !state  real  TAU_ICE    ij   misc  1  -  h  "TAU_ICE"   "CLOUD OD at 825 cm-1 TES"        ""
+      if (activice) then
+        comm_TAU_ICE(1:ngrid) = taucloudtes(1:ngrid)
+      else
+        comm_TAU_ICE(1:ngrid) = tauTES(1:ngrid)
+      endif
+      !state  real  RICE      ikj   misc  1  -  h  "RICE"      "ICE RADIUS"                      "m"
+      comm_RICE(1:ngrid,1:nlayer) = rice(1:ngrid,1:nlayer)
+
+   
+      !! calculate sensible heat flux in W/m2 for outputs
+      !! -- the one computed in vdifc is not the real one
+      !! -- vdifc must have been called
+      if (.not.callrichsl) then
+        sensibFlux(1:ngrid) = zflubid(1:ngrid)
+     .         - capcal(1:ngrid)*zdtsdif(1:ngrid)
+      else
+        sensibFlux(1:ngrid) = 
+     &   (pplay(1:ngrid,1)/(r*pt(1:ngrid,1)))*cpp
+     &   *sqrt(pu(1:ngrid,1)*pu(1:ngrid,1)+pv(1:ngrid,1)*pv(1:ngrid,1)
+     &         +(log(1.+0.7*wstar(1:ngrid) + 2.3*wstar(1:ngrid)**2))**2)
+     &   *zcdh(1:ngrid)*(tsurf(1:ngrid)-zh(1:ngrid,1))
+      endif
+          
+#else
+#ifndef MESOINI
+
+c        ==========================================================
+c        WRITEDIAGFI: Outputs in netcdf file "DIAGFI", containing
+c          any variable for diagnostic (output with period
+c          "ecritphy", set in "run.def")
+c        ==========================================================
+c        WRITEDIAGFI can ALSO be called from any other subroutines
+c        for any variables !!
+c        call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
+c    &                  emis)
+c        call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay)
+c        call WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",3,zplev)
+         call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",2,
+     &                  tsurf)
+         call WRITEDIAGFI(ngrid,"ps","surface pressure","Pa",2,ps)
+         call WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness"
+     &                                         ,"kg.m-2",2,co2ice)
+
+         call WRITEDIAGFI(ngrid,"temp7","temperature in layer 7",
+     &                  "K",2,zt(1,7))
+         call WRITEDIAGFI(ngrid,"fluxsurf_lw","fluxsurf_lw","W.m-2",2,
+     &                  fluxsurf_lw)
+         call WRITEDIAGFI(ngrid,"fluxsurf_sw","fluxsurf_sw","W.m-2",2,
+     &                  fluxsurf_sw_tot)
+         call WRITEDIAGFI(ngrid,"fluxtop_lw","fluxtop_lw","W.m-2",2,
+     &                  fluxtop_lw)
+         call WRITEDIAGFI(ngrid,"fluxtop_sw","fluxtop_sw","W.m-2",2,
+     &                  fluxtop_sw_tot)
+         call WRITEDIAGFI(ngrid,"temp","temperature","K",3,zt)
+         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,"rho","density","none",3,rho)
+c        call WRITEDIAGFI(ngrid,"q2","q2","kg.m-3",3,q2)
+c        call WRITEDIAGFI(ngrid,'Teta','T potentielle','K',3,zh)
+         call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,zplay)
+c        call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2,
+c    &                  zstress)
+c        call WRITEDIAGFI(ngrid,'sw_htrt','sw heat. rate',
+c    &                   'w.m-2',3,zdtsw)
+c        call WRITEDIAGFI(ngrid,'lw_htrt','lw heat. rate',
+c    &                   'w.m-2',3,zdtlw)
+            if (.not.activice) then
+               CALL WRITEDIAGFI(ngrid,'tauTESap',
+     &                         'tau abs 825 cm-1',
+     &                         '',2,tauTES)
+             else
+               CALL WRITEDIAGFI(ngrid,'tauTES',
+     &                         'tau abs 825 cm-1',
+     &                         '',2,taucloudtes)
+             endif
+
+#else
+     !!! this is to ensure correct initialisation of mesoscale model
+        call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",2,
+     &                  tsurf)
+        call WRITEDIAGFI(ngrid,"ps","surface pressure","Pa",2,ps) 
+        call WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness","kg.m-2",2,
+     &                  co2ice)
+        call WRITEDIAGFI(ngrid,"temp","temperature","K",3,zt)
+        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,"emis","Surface emissivity","w.m-1",2,
+     &                  emis)
+        call WRITEDIAGFI(ngrid,"tsoil","Soil temperature",
+     &                       "K",3,tsoil)
+        call WRITEDIAGFI(ngrid,"inertiedat","Soil inertia",
+     &                       "K",3,inertiedat)
+#endif
+
+
+c        ----------------------------------------------------------
+c        Outputs of the CO2 cycle
+c        ----------------------------------------------------------
+
+         if (tracer.and.(igcm_co2.ne.0)) then
+!          call WRITEDIAGFI(ngrid,"co2_l1","co2 mix. ratio in 1st layer",
+!    &                     "kg/kg",2,zq(1,1,igcm_co2))
+          call WRITEDIAGFI(ngrid,"co2","co2 mass mixing ratio",
+     &                     "kg/kg",3,zq(1,1,igcm_co2))
+        
+         ! Compute co2 column
+         co2col(:)=0
+         do l=1,nlayer
+           do ig=1,ngrid
+             co2col(ig)=co2col(ig)+
+     &                  zq(ig,l,igcm_co2)*(zplev(ig,l)-zplev(ig,l+1))/g
+           enddo
+         enddo
+         call WRITEDIAGFI(ngrid,"co2col","CO2 column","kg.m-2",2,
+     &                  co2col)
+         endif ! of if (tracer.and.(igcm_co2.ne.0))
+
+c        ----------------------------------------------------------
+c        Outputs of the water cycle
+c        ----------------------------------------------------------
+         if (tracer) then
+           if (water) then
+
+#ifdef MESOINI
+            !!!! waterice = q01, voir readmeteo.F90
+            call WRITEDIAGFI(ngrid,'q01',noms(igcm_h2o_ice),
+     &                      'kg/kg',3,
+     &                       zq(1:ngrid,1:nlayer,igcm_h2o_ice))
+            !!!! watervapor = q02, voir readmeteo.F90
+            call WRITEDIAGFI(ngrid,'q02',noms(igcm_h2o_vap),
+     &                      'kg/kg',3,
+     &                       zq(1:ngrid,1:nlayer,igcm_h2o_vap))
+            !!!! surface waterice qsurf02 (voir readmeteo)
+            call WRITEDIAGFI(ngrid,'qsurf02','surface tracer',
+     &                      'kg.m-2',2,
+     &                       qsurf(1:ngrid,igcm_h2o_ice))
+#endif
+
+            CALL WRITEDIAGFI(ngrid,'mtot',
+     &                       'total mass of water vapor',
+     &                       'kg/m2',2,mtot)
+            CALL WRITEDIAGFI(ngrid,'icetot',
+     &                       'total mass of water ice',
+     &                       'kg/m2',2,icetot)
+            vmr=zq(1:ngrid,1:nlayer,igcm_h2o_ice)
+     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_ice)
+            call WRITEDIAGFI(ngrid,'vmr_h2oice','h2o ice vmr',
+     &                       'mol/mol',3,vmr)
+            vmr=zq(1:ngrid,1:nlayer,igcm_h2o_vap)
+     &      *mmean(1:ngrid,1:nlayer)/mmol(igcm_h2o_vap)
+            call WRITEDIAGFI(ngrid,'vmr_h2ovap','h2o vap vmr',
+     &                       'mol/mol',3,vmr)
+            CALL WRITEDIAGFI(ngrid,'reffice',
+     &                       'Mean reff',
+     &                       'm',2,rave)
+            call WRITEDIAGFI(ngrid,'saturation',
+     &           'h2o vap saturation ratio','dimless',3,satu)
+            if (scavenging) then
+              CALL WRITEDIAGFI(ngrid,"Nccntot",
+     &                    "condensation nuclei","Nbr/m2",
+     &                    2,Nccntot)
+              CALL WRITEDIAGFI(ngrid,"Mccntot",
+     &                    "mass condensation nuclei","kg/m2",
+     &                    2,Mccntot)
+            endif
+            call WRITEDIAGFI(ngrid,'rice','Ice particle size',
+     &                       'm',3,rice)
+            call WRITEDIAGFI(ngrid,'h2o_ice_s',
+     &                       'surface h2o_ice',
+     &                       'kg.m-2',2,qsurf(1,igcm_h2o_ice))
+            CALL WRITEDIAGFI(ngrid,'albedo',
+     &                         'albedo',
+     &                         '',2,albedo(1,1))
+              if (tifeedback) then
+                 call WRITEDIAGSOIL(ngrid,"soiltemp",
+     &                              "Soil temperature","K",
+     &                              3,tsoil)
+                 call WRITEDIAGSOIL(ngrid,'soilti',
+     &                       'Soil Thermal Inertia',
+     &                       'J.s-1/2.m-2.K-1',3,inertiesoil)
+              endif
+           endif !(water)
+
+
+           if (water.and..not.photochem) then
+             iq=nq
+c            write(str2(1:2),'(i2.2)') iq
+c            call WRITEDIAGFI(ngrid,'dqs'//str2,'dqscloud',
+c    &                       'kg.m-2',2,zdqscloud(1,iq))
+c            call WRITEDIAGFI(ngrid,'dqch'//str2,'var chim',
+c    &                       'kg/kg',3,zdqchim(1,1,iq))
+c            call WRITEDIAGFI(ngrid,'dqd'//str2,'var dif',
+c    &                       'kg/kg',3,zdqdif(1,1,iq))
+c            call WRITEDIAGFI(ngrid,'dqa'//str2,'var adj',
+c    &                       'kg/kg',3,zdqadj(1,1,iq))
+c            call WRITEDIAGFI(ngrid,'dqc'//str2,'var c',
+c    &                       'kg/kg',3,zdqc(1,1,iq))
+           endif  !(water.and..not.photochem)
+         endif
+
+c        ----------------------------------------------------------
+c        Outputs of the dust cycle
+c        ----------------------------------------------------------
+
+        call WRITEDIAGFI(ngrid,'tauref',
+     &                    'Dust ref opt depth','NU',2,tauref)
+
+         if (tracer.and.(dustbin.ne.0)) then
+
+          call WRITEDIAGFI(ngrid,'tau','taudust','SI',2,tau(1,1))
+
+#ifndef MESOINI
+           if (doubleq) then
+c            call WRITEDIAGFI(ngrid,'qsurf','qsurf',
+c     &                       'kg.m-2',2,qsurf(1,igcm_dust_mass))
+c            call WRITEDIAGFI(ngrid,'Nsurf','N particles',
+c     &                       'N.m-2',2,qsurf(1,igcm_dust_number))
+c            call WRITEDIAGFI(ngrid,'dqsdev','ddevil lift',
+c    &                       'kg.m-2.s-1',2,zdqsdev(1,1))
+c            call WRITEDIAGFI(ngrid,'dqssed','sedimentation',
+c     &                       'kg.m-2.s-1',2,zdqssed(1,1))
+c            call WRITEDIAGFI(ngrid,'dqsdif','diffusion',
+c     &                       'kg.m-2.s-1',2,zdqsdif(1,1))
+c             call WRITEDIAGFI(ngrid,'sedice','sedimented ice',
+c     &                       'kg.m-2.s-1',2,zdqssed(:,igcm_h2o_ice))
+c             call WRITEDIAGFI(ngrid,'subice','sublimated ice',
+c     &                       'kg.m-2.s-1',2,zdqsdif(:,igcm_h2o_ice))
+             call WRITEDIAGFI(ngrid,'dqsdust',
+     &                        'deposited surface dust mass',
+     &                        'kg.m-2.s-1',2,dqdustsurf)
+             call WRITEDIAGFI(ngrid,'dqndust',
+     &                        'deposited surface dust number',
+     &                        'number.m-2.s-1',2,dndustsurf)
+             call WRITEDIAGFI(ngrid,'reffdust','reffdust',
+     &                        'm',3,rdust*ref_r0)
+             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
+     &                        'kg/kg',3,qdust)
+             call WRITEDIAGFI(ngrid,'dustN','Dust number',
+     &                        'part/kg',3,ndust)
+             call WRITEDIAGFI(ngrid,'dsodust',
+     &                        'dust density scaled opacity',
+     &                        'm2.kg-1',3,dsodust)
+c             call WRITEDIAGFI(ngrid,"tauscaling",
+c     &                    "dust conversion factor"," ",2,tauscaling)
+           else
+             do iq=1,dustbin
+               write(str2(1:2),'(i2.2)') iq
+               call WRITEDIAGFI(ngrid,'q'//str2,'mix. ratio',
+     &                         'kg/kg',3,zq(1,1,iq))
+               call WRITEDIAGFI(ngrid,'qsurf'//str2,'qsurf',
+     &                         'kg.m-2',2,qsurf(1,iq))
+             end do
+           endif ! (doubleq)
+
+           if (scavenging) then
+             call WRITEDIAGFI(ngrid,'ccnq','CCN mass mr',
+     &                        'kg/kg',3,qccn)
+             call WRITEDIAGFI(ngrid,'ccnN','CCN number',
+     &                        'part/kg',3,nccn)
+           endif ! (scavenging)
+
+c          if (submicron) then
+c            call WRITEDIAGFI(ngrid,'dustsubm','subm mass mr',
+c    &                        'kg/kg',3,pq(1,1,igcm_dust_submicron))
+c          endif ! (submicron)
+
+#else
+!     !!! to initialize mesoscale we need scaled variables
+!     !!! because this must correspond to starting point for tracers
+!             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
+!     &           'kg/kg',3,pq(1:ngrid,1:nlayer,igcm_dust_mass))
+!             call WRITEDIAGFI(ngrid,'dustN','Dust number',
+!     &           'part/kg',3,pq(1:ngrid,1:nlayer,igcm_dust_number))
+!             call WRITEDIAGFI(ngrid,'ccn','Nuclei mass mr',
+!     &           'kg/kg',3,pq(1:ngrid,1:nlayer,igcm_ccn_mass))
+!             call WRITEDIAGFI(ngrid,'ccnN','Nuclei number',
+!     &           'part/kg',3,pq(1:ngrid,1:nlayer,igcm_ccn_number))
+      if (freedust) then
+             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
+     &                        'kg/kg',3,qdust)
+             call WRITEDIAGFI(ngrid,'dustN','Dust number',
+     &                        'part/kg',3,ndust)
+             call WRITEDIAGFI(ngrid,'ccn','CCN mass mr',
+     &                        'kg/kg',3,qccn)
+             call WRITEDIAGFI(ngrid,'ccnN','CCN number',
+     &                        'part/kg',3,nccn)
+      else
+             call WRITEDIAGFI(ngrid,'dustq','Dust mass mr',
+     &                        'kg/kg',3,pq(1,1,igcm_dust_mass))
+             call WRITEDIAGFI(ngrid,'dustN','Dust number',
+     &                        'part/kg',3,pq(1,1,igcm_dust_number))
+             call WRITEDIAGFI(ngrid,'ccn','Nuclei mass mr',
+     &                        'kg/kg',3,pq(1,1,igcm_ccn_mass))
+             call WRITEDIAGFI(ngrid,'ccnN','Nuclei number',
+     &                        'part/kg',3,pq(1,1,igcm_ccn_number))
+      endif
+#endif
+
+         end if  ! (tracer.and.(dustbin.ne.0))
+
+
+c        ----------------------------------------------------------
+c        Thermospheric outputs
+c        ----------------------------------------------------------
+
+         if(callthermos) then 
+
+            call WRITEDIAGFI(ngrid,"q15um","15 um cooling","K/s",
+     $           3,zdtnlte)
+            call WRITEDIAGFI(ngrid,"quv","UV heating","K/s",
+     $           3,zdteuv)
+            call WRITEDIAGFI(ngrid,"cond","Thermal conduction","K/s",
+     $           3,zdtconduc)
+            call WRITEDIAGFI(ngrid,"qnir","NIR heating","K/s",
+     $           3,zdtnirco2)
+
+         endif  !(callthermos)
+
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+c        PBL OUTPUS
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+
+c        ----------------------------------------------------------
+c        Outputs of thermals
+c        ----------------------------------------------------------
+         if (calltherm) then
+
+!        call WRITEDIAGFI(ngrid,'dtke',
+!     &              'tendance tke thermiques','m**2/s**2',
+!     &                         3,dtke_th)
+!        call WRITEDIAGFI(ngrid,'d_u_ajs',
+!     &              'tendance u thermiques','m/s',
+!     &                         3,pdu_th*ptimestep)
+!        call WRITEDIAGFI(ngrid,'d_v_ajs',
+!     &              'tendance v thermiques','m/s',
+!     &                         3,pdv_th*ptimestep)
+!        if (tracer) then
+!        if (nq .eq. 2) then
+!        call WRITEDIAGFI(ngrid,'deltaq_th',
+!     &              'delta q thermiques','kg/kg',
+!     &                         3,ptimestep*pdq_th(:,:,2))
+!        endif
+!        endif
+
+        call WRITEDIAGFI(ngrid,'zmax_th',
+     &              'hauteur du thermique','m',
+     &                         2,zmax_th)
+        call WRITEDIAGFI(ngrid,'hfmax_th',
+     &              'maximum TH heat flux','K.m/s',
+     &                         2,hfmax_th)
+        call WRITEDIAGFI(ngrid,'wstar',
+     &              'maximum TH vertical velocity','m/s',
+     &                         2,wstar)
+
+         endif
+
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+c        END OF PBL OUTPUS
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+
+
+c        ----------------------------------------------------------
+c        Output in netcdf file "diagsoil.nc" for subterranean
+c          variables (output every "ecritphy", as for writediagfi)
+c        ----------------------------------------------------------
+
+         ! Write soil temperature
+!        call writediagsoil(ngrid,"soiltemp","Soil temperature","K",
+!    &                     3,tsoil)
+         ! Write surface temperature
+!        call writediagsoil(ngrid,"tsurf","Surface temperature","K",
+!    &                     2,tsurf)
+
+c        ==========================================================
+c        END OF WRITEDIAGFI
+c        ==========================================================
+#endif
+! of ifdef MESOSCALE
+
+      ELSE     ! if(ngrid.eq.1)
+
+#ifndef MESOSCALE
+         write(*,'("Ls =",f11.6," tauref(",f4.0," Pa) =",f9.6)')
+     &    zls*180./pi,odpref,tauref
+c      ----------------------------------------------------------------------
+c      Output in grads file "g1d" (ONLY when using testphys1d)
+c      (output at every X physical timestep)
+c      ----------------------------------------------------------------------
+c
+c        CALL writeg1d(ngrid,1,fluxsurf_lw,'Fs_ir','W.m-2')
+c         CALL writeg1d(ngrid,1,tsurf,'tsurf','K')
+c         CALL writeg1d(ngrid,1,ps,'ps','Pa')
+         
+c         CALL writeg1d(ngrid,nlayer,zt,'T','K')
+c        CALL writeg1d(ngrid,nlayer,pu,'u','m.s-1')
+c        CALL writeg1d(ngrid,nlayer,pv,'v','m.s-1')
+c        CALL writeg1d(ngrid,nlayer,pw,'w','m.s-1')
+
+! THERMALS STUFF 1D
+         if(calltherm) then
+
+        call WRITEDIAGFI(ngrid,'lmax_th',
+     &              'hauteur du thermique','point',
+     &                         0,lmax_th_out)
+        call WRITEDIAGFI(ngrid,'zmax_th',
+     &              'hauteur du thermique','m',
+     &                         0,zmax_th)
+        call WRITEDIAGFI(ngrid,'hfmax_th',
+     &              'maximum TH heat flux','K.m/s',
+     &                         0,hfmax_th)
+        call WRITEDIAGFI(ngrid,'wstar',
+     &              'maximum TH vertical velocity','m/s',
+     &                         0,wstar)
+
+         co2col(:)=0.
+         if (tracer) then
+         do l=1,nlayer
+           do ig=1,ngrid
+             co2col(ig)=co2col(ig)+
+     &                  zq(ig,l,1)*(zplev(ig,l)-zplev(ig,l+1))/g
+         enddo
+         enddo
+
+         end if
+         call WRITEDIAGFI(ngrid,'co2col','integrated co2 mass'          &
+     &                                      ,'kg/m-2',0,co2col)
+         endif ! of if (calltherm)
+
+         call WRITEDIAGFI(ngrid,'w','vertical velocity'                 &
+     &                              ,'m/s',1,pw)
+         call WRITEDIAGFI(ngrid,"q2","q2","kg.m-3",1,q2)
+         call WRITEDIAGFI(ngrid,"tsurf","Surface temperature","K",0,
+     &                  tsurf)
+         call WRITEDIAGFI(ngrid,"u","u wind","m/s",1,zu)
+         call WRITEDIAGFI(ngrid,"v","v wind","m/s",1,zv)
+
+         call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",1,zplay)
+         call WRITEDIAGFI(ngrid,"pplev","Pressure","Pa",1,zplev)
+         call WRITEDIAGFI(ngrid,"rho","rho","kg.m-3",1,rho)
+         call WRITEDIAGFI(ngrid,"dtrad","rad. heat. rate",              &
+     &              "K.s-1",1,dtrad)
+        call WRITEDIAGFI(ngrid,'sw_htrt','sw heat. rate',
+     &                   'w.m-2',1,zdtsw)
+        call WRITEDIAGFI(ngrid,'lw_htrt','lw heat. rate',
+     &                   'w.m-2',1,zdtlw)
+         call WRITEDIAGFI(ngrid,"co2ice","co2 ice thickness"
+     &                                   ,"kg.m-2",0,co2ice)
+
+! or output in diagfi.nc (for testphys1d)
+         call WRITEDIAGFI(ngrid,'ps','Surface pressure','Pa',0,ps)
+         call WRITEDIAGFI(ngrid,'temp','Temperature',
+     &                       'K',1,zt)
+     
+         if(tracer) then
+c           CALL writeg1d(ngrid,1,tau,'tau','SI')
+            do iq=1,nq
+c              CALL writeg1d(ngrid,nlayer,zq(1,1,iq),noms(iq),'kg/kg') 
+               call WRITEDIAGFI(ngrid,trim(noms(iq)),
+     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
+            end do
+           if (doubleq) then
+             call WRITEDIAGFI(ngrid,'rdust','rdust',
+     &                        'm',1,rdust)
+           endif
+           if (water.AND.tifeedback) then
+             call WRITEDIAGFI(ngrid,"soiltemp",
+     &                              "Soil temperature","K",
+     &                              1,tsoil)
+             call WRITEDIAGFI(ngrid,'soilti',
+     &                       'Soil Thermal Inertia',
+     &                       'J.s-1/2.m-2.K-1',1,inertiesoil)
+           endif
+         end if
+         
+cccccccccccccccccc scavenging & water outputs 1D TN ccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+         IF (water) THEN
+
+           if (.not.activice) then
+
+             tauTES=0
+             do l=1,nlayer
+               Qabsice = min(
+     &             max(0.4e6*rice(1,l)*(1.+nuice_ref)-0.05 ,0.),1.2
+     &                      )
+               opTES(1,l)= 0.75 * Qabsice *
+     &             zq(1,l,igcm_h2o_ice) *
+     &             (zplev(1,l) - zplev(1,l+1)) / g
+     &             / (rho_ice * rice(1,l) * (1.+nuice_ref))
+               tauTES=tauTES+ opTES(1,l)
+             enddo
+             CALL WRITEDIAGFI(ngrid,'tauTESap',
+     &                         'tau abs 825 cm-1',
+     &                         '',0,tauTES)
+           else
+
+             CALL WRITEDIAGFI(ngrid,'tauTES',
+     &                         'tau abs 825 cm-1',
+     &                         '',0,taucloudtes)
+           endif
+     
+           mtot = 0
+           icetot = 0
+           h2otot = qsurf(1,igcm_h2o_ice)
+
+           do l=1,nlayer
+             mtot = mtot +  zq(1,l,igcm_h2o_vap) 
+     &                 * (zplev(1,l) - zplev(1,l+1)) / g
+             icetot = icetot +  zq(1,l,igcm_h2o_ice) 
+     &                 * (zplev(1,l) - zplev(1,l+1)) / g
+           end do
+           h2otot = h2otot+mtot+icetot
+
+             CALL WRITEDIAGFI(ngrid,'h2otot',
+     &                         'h2otot',
+     &                         'kg/m2',0,h2otot)
+             CALL WRITEDIAGFI(ngrid,'mtot',
+     &                         'mtot',
+     &                         'kg/m2',0,mtot)
+             CALL WRITEDIAGFI(ngrid,'icetot',
+     &                         'icetot',
+     &                         'kg/m2',0,icetot)
+
+           if (scavenging) then
+
+             rave = 0
+             do l=1,nlayer
+cccc Column integrated effective ice radius
+cccc is weighted by total ice surface area (BETTER) 
+             rave = rave + tauscaling(1) *
+     &              zq(1,l,igcm_ccn_number) *
+     &              (zplev(1,l) - zplev(1,l+1)) / g * 
+     &              rice(1,l) * rice(1,l)*  (1.+nuice_ref)
+             enddo
+             rave=icetot*0.75/max(rave*pi*rho_ice,1.e-30) ! surface weight
+
+              Nccntot= 0
+              call watersat(ngrid*nlayer,zt,zplay,zqsat)
+               do l=1,nlayer
+                   Nccntot = Nccntot + 
+     &              zq(1,l,igcm_ccn_number)*tauscaling(1)
+     &              *(zplev(1,l) - zplev(1,l+1)) / g
+                   satu(1,l) = zq(1,l,igcm_h2o_vap)/zqsat(1,l)
+                   satu(1,l) = (max(satu(1,l),float(1))-1)
+!     &                      * zq(1,l,igcm_h2o_vap) *
+!     &                      (zplev(1,l) - zplev(1,l+1)) / g
+               enddo
+               call WRITEDIAGFI(ngrid,"satu","vap in satu","kg/kg",1,
+     &                    satu)
+               CALL WRITEDIAGFI(ngrid,'Nccntot',
+     &                         'Nccntot',
+     &                         'nbr/m2',0,Nccntot)
+
+             call WRITEDIAGFI(ngrid,'zdqsed_dustq'
+     & ,'sedimentation q','kg.m-2.s-1',1,zdqsed(1,:,igcm_dust_mass))
+             call WRITEDIAGFI(ngrid,'zdqsed_dustN'
+     &,'sedimentation N','Nbr.m-2.s-1',1,
+     &                                 zdqsed(1,:,igcm_dust_number))
+
+           else ! of if (scavenging)
+
+cccc Column integrated effective ice radius 
+cccc is weighted by total ice mass         (LESS GOOD)
+             rave = 0
+             do l=1,nlayer
+               rave = rave + zq(1,l,igcm_h2o_ice)
+     &              * (zplev(1,l) - zplev(1,l+1)) / g
+     &              *  rice(1,l) * (1.+nuice_ref)
+             enddo
+             rave=max(rave/max(icetot,1.e-30),1.e-30) ! mass weight
+           endif ! of if (scavenging)
+
+           CALL WRITEDIAGFI(ngrid,'reffice',
+     &                      'reffice',
+     &                      'm',0,rave)
+
+           do iq=1,nq
+             call WRITEDIAGFI(ngrid,trim(noms(iq))//'_s',
+     &            trim(noms(iq))//'_s','kg/kg',0,qsurf(1,iq))
+           end do
+     
+        call WRITEDIAGFI(ngrid,'zdqcloud_ice','cloud ice',
+     &            'kg.m-2.s-1',1,zdqcloud(1,:,igcm_h2o_ice))
+        call WRITEDIAGFI(ngrid,'zdqcloud_vap','cloud vap',
+     &            'kg.m-2.s-1',1,zdqcloud(1,:,igcm_h2o_vap))
+        call WRITEDIAGFI(ngrid,'zdqcloud','cloud ice',
+     &            'kg.m-2.s-1',1,zdqcloud(1,:,igcm_h2o_ice)
+     &                          +zdqcloud(1,:,igcm_h2o_vap))
+     
+          call WRITEDIAGFI(ngrid,"rice","ice radius","m",1,
+     &                    rice)
+         ENDIF ! of IF (water)
+         
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+         zlocal(1)=-log(zplay(1,1)/zplev(1,1))* Rnew(1,1)*zt(1,1)/g
+
+         do l=2,nlayer-1
+            tmean=zt(1,l)
+            if(zt(1,l).ne.zt(1,l-1))
+     &        tmean=(zt(1,l)-zt(1,l-1))/log(zt(1,l)/zt(1,l-1))
+              zlocal(l)= zlocal(l-1)
+     &        -log(zplay(1,l)/zplay(1,l-1))*rnew(1,l)*tmean/g
+         enddo
+         zlocal(nlayer)= zlocal(nlayer-1)-
+     &                   log(zplay(1,nlayer)/zplay(1,nlayer-1))*
+     &                   rnew(1,nlayer)*tmean/g
+#endif
+
+      END IF       ! if(ngrid.ne.1)
+
+      icount=icount+1
+
+      END SUBROUTINE physiq
+
+      END MODULE physiq_mod
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F	(revision 1548)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F	(revision 1549)
@@ -13,4 +13,5 @@
       USE iniphysiq_mod, ONLY: iniphysiq
       USE mod_const_mpi, ONLY: comm_lmdz
+      USE physiq_mod, ONLY: physiq
       IMPLICIT NONE
 
@@ -67,5 +68,5 @@
       REAL du(llm),dv(llm),dtemp(llm)
       REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
-      REAL dpsurf    
+      REAL dpsurf(1)    
       REAL,allocatable :: dq(:,:)
 
@@ -439,5 +440,5 @@
 c       ----------------------------------------------------------
 
-           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           psurf=psurf+dtphys*dpsurf(1)   ! evolution de la pression de surface
            DO ilevel=1,nlevel
              plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
Index: /trunk/LMDZ.TITAN/libf/phytitan/gr_fi_ecrit.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/gr_fi_ecrit.F90	(revision 1549)
+++ /trunk/LMDZ.TITAN/libf/phytitan/gr_fi_ecrit.F90	(revision 1549)
@@ -0,0 +1,24 @@
+SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
+  IMPLICIT none
+  !
+  ! Tranformer une variable de la grille physique a
+  ! la grille d'ecriture
+  !
+  ! WARNING: This only works on the full global grid
+  !          (ie for GCM in serial mode)
+  INTEGER nfield,nlon,iim,jjmp1, jjm
+  REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
+  !
+  INTEGER i, n, ig
+  !
+  jjm = jjmp1 - 1
+  DO n = 1, nfield
+     DO i=1,iim
+        ecrit(i,n) = fi(1,n)
+        ecrit(i+jjm*iim,n) = fi(nlon,n)
+     ENDDO
+     DO ig = 1, nlon - 2
+        ecrit(iim+ig,n) = fi(1+ig,n)
+     ENDDO
+  ENDDO
+END SUBROUTINE gr_fi_ecrit
Index: unk/LMDZ.TITAN/libf/phytitan/physiq.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/physiq.F	(revision 1548)
+++ 	(revision )
@@ -1,1660 +1,0 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/physiq.F,v 1.8 2005/02/24 09:58:18 fairhead Exp $
-!
-c
-      SUBROUTINE physiq (nlon,nlev,nqmax,
-     .            debut,lafin,rjourvrai,gmtime,pdtphys,
-     .            paprs,pplay,ppk,pphi,pphis,presnivs,
-     .            u,v,t,qx,
-     .            flxmw,
-     .            d_u, d_v, d_t, d_qx, d_ps)
-
-c======================================================================
-c
-c Modifications pour la physique de Titan
-c     S. Lebonnois (LMD/CNRS) Juin 2013: Parallelisation
-c
-c ---------------------------------------------------------------------
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c
-c Objet: Moniteur general de la physique du modele
-cAA      Modifications quant aux traceurs :
-cAA                  -  uniformisation des parametrisations ds phytrac
-cAA                  -  stockage des moyennes des champs necessaires
-cAA                     en mode traceur off-line 
-c    modif   ( P. Le Van ,  12/10/98 )
-c
-c  Arguments:
-c
-c nlon----input-I-nombre de points horizontaux
-c nlev----input-I-nombre de couches verticales
-c nqmax---input-I-nombre de traceurs
-c debut---input-L-variable logique indiquant le premier passage
-c lafin---input-L-variable logique indiquant le dernier passage
-c rjour---input-R-numero du jour de l'experience
-c gmtime--input-R-temps universel dans la journee (0 a RDAY s)
-c pdtphys-input-R-pas d'integration pour la physique (seconde)
-c paprs---input-R-pression pour chaque inter-couche (en Pa)
-c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-c ppk  ---input-R-fonction d'Exner au milieu de couche
-c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
-c pphis---input-R-geopotentiel du sol
-c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
-c u-------input-R-vitesse dans la direction X (de O a E) en m/s
-c v-------input-R-vitesse Y (de S a N) en m/s
-c t-------input-R-temperature (K)
-c qx------input-R-mass mixing ratio traceurs (kg/kg) 
-c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
-c flxmw---input-R-flux de masse vertical en kg/s
-c
-c d_u-----output-R-tendance physique de "u" (m/s/s)
-c d_v-----output-R-tendance physique de "v" (m/s/s)
-c d_t-----output-R-tendance physique de "t" (K/s)
-c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
-c d_ps----output-R-tendance physique de la pression au sol
-c======================================================================
-      USE ioipsl
-!      USE histcom ! not needed; histcom is included in ioipsl
-      USE infotrac
-      use dimphy
-      USE geometry_mod, ONLY: longitude, latitude, ! in radians
-     &                        longitude_deg, latitude_deg, ! in degrees
-     &                        cell_area, dx, dy
-      use cpdet_mod, only: cpdet, t2tpot
-      USE mod_phys_lmdz_para, only : is_parallel,jj_nb
-      USE phys_state_var_mod ! Variables sauvegardees de la physique
-      USE iophy
-      USE common_mod, only: rmcbar,xfbar,ncount,
-     &      flxesp_i,tau_drop,tau_aer,solesp,precip,
-     &      evapch4,occcld_m,occcld,satch4,satc2h6,satc2h2,rmcloud,
-     &      TauHID,TauHVD,TauGID,TauGVD,TauCID,TauCVD,NSPECV,NSPECI,
-     &      common_init
-
-      USE moyzon_mod
-      USE write_field_phy
-      USE time_phylmdz_mod, only: itau_phy,day_ref,annee_ref,nday
-      USE logic_mod, only: iflag_trac,moyzon_ch,moyzon_mu
-      USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
-      IMPLICIT none
-c======================================================================
-c   CLEFS CPP POUR LES IO
-c   =====================
-#define histday
-#define histmth
-#define histins
-c======================================================================
-#include "dimensions.h"
-      integer jjmp1
-      parameter (jjmp1=jjm+1-1/jjm)
-#include "dimsoil.h"
-#include "clesphys.h"
-#include "iniprint.h"
-#include "tabcontrol.h"
-#include "comorbit.h"
-#include "microtab.h"
-#include "itemps.h"
-c======================================================================
-      LOGICAL ok_journe ! sortir le fichier journalier
-      save ok_journe
-c      PARAMETER (ok_journe=.true.)
-c
-      LOGICAL ok_mensuel ! sortir le fichier mensuel
-      save ok_mensuel
-c      PARAMETER (ok_mensuel=.true.)
-c
-      LOGICAL ok_instan ! sortir le fichier instantane
-      save ok_instan
-c      PARAMETER (ok_instan=.true.)
-c
-c======================================================================
-c
-c Variables argument:
-c
-      INTEGER nlon
-      INTEGER nlev
-      INTEGER nqmax
-      REAL rjourvrai
-      REAL gmtime
-      REAL pdtphys
-      LOGICAL debut, lafin
-      REAL paprs(klon,klev+1)
-      REAL pplay(klon,klev)
-      REAL pphi(klon,klev)
-      REAL pphis(klon)
-      REAL presnivs(klev)
-
-! ADAPTATION GCM POUR CP(T)
-      REAL ppk(klon,klev)
-
-      REAL u(klon,klev)
-      REAL v(klon,klev)
-      REAL t(klon,klev)
-      REAL qx(klon,klev,nqmax)
-
-      REAL d_u_dyn(klon,klev)
-      REAL d_t_dyn(klon,klev)
-
-      REAL flxmw(klon,klev)
-
-      REAL d_u(klon,klev)
-      REAL d_v(klon,klev)
-      REAL d_t(klon,klev)
-      REAL d_qx(klon,klev,nqmax)
-      REAL d_ps(klon)
-
-c Variables propres a la physique
-c
-      REAL,save,allocatable :: rlev(:,:) ! altitude a chaque niveau (interface inferieure de la couche) 
-      INTEGER,save :: itap        ! compteur pour la physique
-      REAL delp(klon,klev)        ! epaisseur d'une couche
-      REAL omega(klon,klev)
-      
-      INTEGER igwd,idx(klon),itest(klon)
-c
-c  Diagnostiques 2D de drag_noro, lift_noro et gw_nonoro
-
-      REAL zulow(klon),zvlow(klon)
-      REAL zustrdr(klon), zvstrdr(klon)
-      REAL zustrli(klon), zvstrli(klon)
-      REAL zustrhi(klon), zvstrhi(klon)
-
-c Pour calcul GW drag oro et nonoro: CALCUL de N2:
-      real zdzlev(klon,klev)
-      real ztlev(klon,klev),zpklev(klon,klev)
-      real ztetalay(klon,klev),ztetalev(klon,klev)
-      real zdtetalev(klon,klev)
-      real zn2(klon,klev) ! BV^2 at plev
-
-c Pour les bilans de moment angulaire, 
-      integer bilansmc
-c Pour le transport de ballons
-      integer ballons
-c j'ai aussi besoin
-c du stress de couche limite a la surface:
-
-      REAL zustrcl(klon),zvstrcl(klon) 
-
-c et du stress total c de la physique:
-
-      REAL zustrph(klon),zvstrph(klon) 
-
-c Variables locales:
-c
-      REAL cdragh(klon) ! drag coefficient pour T and Q
-      REAL cdragm(klon) ! drag coefficient pour vent
-c
-cAA  Pour  TRACEURS
-cAA
-      REAL,save,allocatable :: source(:,:)
-      integer nmicro
-      save    nmicro
-      character*8 nom
-      REAL qaer(klon,klev,nqmax)
-
-      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
-      REAL yu1(klon)            ! vents dans la premiere couche U
-      REAL yv1(klon)            ! vents dans la premiere couche V
-
-      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
-      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
-      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
-      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
-      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
-c
-
-c======================================================================
-c
-c Declaration des procedures appelees
-c
-      EXTERNAL ajsec     ! ajustement sec
-      EXTERNAL clmain    ! couche limite 
-      EXTERNAL hgardfou  ! verifier les temperatures
-      EXTERNAL orbite    ! calculer l'orbite 
-      EXTERNAL phyetat0  ! lire l'etat initial de la physique
-      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
-      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
-      EXTERNAL suphec    ! initialiser certaines constantes
-c     EXTERNAL transp    ! transport total de l'eau et de l'energie
-      EXTERNAL abort_gcm
-      EXTERNAL printflag
-      EXTERNAL zenang
-      EXTERNAL diagetpq
-      EXTERNAL conf_phys
-      EXTERNAL diagphy
-      EXTERNAL mucorr
-      EXTERNAL phytrac
-c
-c Variables locales
-c
-CXXX PB 
-      REAL fluxt(klon,klev)   ! flux turbulent de chaleur
-      REAL fluxu(klon,klev)   ! flux turbulent de vitesse u
-      REAL fluxv(klon,klev)   ! flux turbulent de vitesse v
-c
-      REAL flux_dyn(klon,klev)  ! flux de chaleur produit par la dynamique
-      REAL flux_ajs(klon,klev)  ! flux de chaleur ajustement sec
-      REAL flux_ec(klon,klev)   ! flux de chaleur Ec
-c
-      REAL    dtimerad
-      INTEGER itaprad
-      SAVE itaprad,dtimerad
-      REAL zdtime
-c
-c CHIMIE
-
-      REAL    dtimechim
-      INTEGER itapchim,appel_chim
-      SAVE itapchim,dtimechim
-
-c ORBITE
-
-      REAL dist, rmu0(klon), fract(klon), pdecli
-      REAL rmu0bar(klon), fractbar(klon)
-      REAL zday
-      REAL zls,zlsdeg,zlsm1
-      save zlsm1
-c
-      INTEGER i, k, iq, ig, j, ll, l
-c
-      REAL zphi(klon,klev)
-      REAL zzlev(klon,klev+1),zzlay(klon,klev),z1,z2
-c
-c Variables du changement
-c
-c ajs: ajustement sec
-c vdf: couche limite (Vertical DiFfusion)
-c mph: microphysique
-c kim: chimie
-      REAL d_t_ajs(klon,klev), d_tr_ajs(klon,klev,nqmax)
-      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
-c
-      REAL d_ts(klon)
-c
-      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
-      REAL d_t_vdf(klon,klev), d_tr_vdf(klon,klev,nqmax)
-c
-      REAL d_tr_mph(klon,klev,nqmax),d_tr_kim(klon,klev,nqmax)
-
-CMOD LOTT: Tendances Orography Sous-maille
-      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
-      REAL d_t_oro(klon,klev)
-      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
-      REAL d_t_lif(klon,klev)
-C          Tendances Ondes de G non oro (runs strato).
-      REAL d_u_hin(klon,klev), d_v_hin(klon,klev)
-      REAL d_t_hin(klon,klev)
-
-c
-c Variables liees a l'ecriture de la bande histoire physique
-c
-      INTEGER ecrit_mth
-      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
-c
-      INTEGER ecrit_day
-      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
-c
-      INTEGER ecrit_ins
-      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
-c
-      integer itau_w   ! pas de temps ecriture = itap + itau_phy
-
-c Variables locales pour effectuer les appels en serie
-c
-      REAL t_seri(klon,klev)
-      REAL u_seri(klon,klev), v_seri(klon,klev)
-c
-      REAL tr_seri(klon,klev,nqmax)
-      REAL d_tr(klon,klev,nqmax)
-c
-c pour ioipsl
-      INTEGER nid_day, nid_mth, nid_ins
-      SAVE nid_day, nid_mth, nid_ins
-      INTEGER nhori, nvert, idayref
-      REAL zsto, zout, zsto1, zsto2, zero
-      parameter (zero=0.0e0)
-      real zjulian
-      save zjulian
-      REAL tmpout(klon,klev)  ! pour sorties
-
-      CHARACTER*1  str1
-      CHARACTER*2  str2
-      character*20 modname
-      character*80 abort_message
-      logical ok_sync
-
-      character*30 nom_fichier
-      character*10 varname
-      character*40 vartitle
-      character*20 varunits
-C     Variables liees au bilan d'energie et d'enthalpi
-      REAL ztsol(klon)
-      REAL      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
-     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
-      SAVE      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
-     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
-      REAL      d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
-      REAL      d_h_vcol_phy
-      REAL      fs_bound, fq_bound
-      SAVE      d_h_vcol_phy
-      REAL      zero_v(klon),zero_v2(klon,klev)
-      CHARACTER*15 ztit
-      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
-      SAVE      ip_ebil
-      DATA      ip_ebil/2/
-      INTEGER   if_ebil ! level for energy conserv. dignostics
-      SAVE      if_ebil
-c+jld ec_conser
-      REAL d_t_ec(klon,klev)    ! tendance du a la conversion Ec -> E thermique
-c-jld ec_conser
-
-c TEST VENUS...
-      REAL mang(klon,klev)    ! moment cinetique
-      REAL mangtot            ! moment cinetique total
-
-c Temporaire avant de trouver mieux :
-c Recuperation des TAU du TR
-      REAL t_tauhvd(klon,klev),t_khvd(klon,klev)
-      REAL t_tcld(klon,klev),t_kcld(klon,klev)
-      REAL t_kcvd(klon,klev)
-
-       REAL ch4(klon,jjm+1),dch4(jjm+1)
-       INTEGER ig0
-       integer ich4
-       common/ch4ind/ich4
-
-c     flux de chaleur latente d'evaporation CH4
-      REAL fclat(klon)
-c     reservoir de surface
-      REAL,save,allocatable :: reservoir(:)
-
-c Declaration des constantes et des fonctions thermodynamiques
-c
-#include "YOMCST.h"
-
-c======================================================================
-c INITIALISATIONS
-c================
-
-      modname = 'physiq'
-      ok_sync=.TRUE.
-
-      bilansmc = 0
-      ballons  = 0
-! NE FONCTIONNENT PAS ENCORE EN PARALLELE !!!
-      if (is_parallel) then
-        bilansmc = 0
-        ballons  = 0
-      endif
-
-      IF (if_ebil.ge.1) THEN
-        DO i=1,klon
-          zero_v(i)=0.
-        END DO 
-        DO i=1,klon
-         DO j=1,klev
-          zero_v2(i,j)=0.
-         END DO 
-        END DO 
-      END IF 
-      
-c PREMIER APPEL SEULEMENT
-c========================
-      IF (debut) THEN
-         allocate(rlev(klon,klevp1))
-         allocate(source(klon,nqmax))
-         allocate(reservoir(klon))
-
-         CALL suphec ! initialiser constantes et parametres phys.
-
-         IF (if_ebil.ge.1) d_h_vcol_phy=0.
-c
-c appel a la lecture du physiq.def 
-c
-         call conf_phys(ok_mensuel,ok_journe,
-     .                  ok_instan,
-     .                  if_ebil)
-
-         call phys_state_var_init
-         call common_init
-c
-c Initialiser les compteurs:
-c
-         itap    = 0
-         itaprad = 0
-         itapchim    = 1
-
-c init rnuabar
-         ncount(:,:) = 0
-         rmcbar  = 0.
-         xfbar   = 0.
-         
-c         
-c Lecture startphy.nc :
-c
-         CALL phyetat0 ("startphy.nc")
-
-c dtime est defini dans tabcontrol.h et lu dans startphy
-c pdtphys est calcule a partir des nouvelles conditions:
-c Reinitialisation du pas de temps physique quand changement
-         IF (ABS(dtime-pdtphys).GT.0.001) THEN
-            WRITE(lunout,*) 'Pas physique a change',dtime,
-     .                        pdtphys
-c           abort_message='Pas physique n est pas correct '
-c           call abort_gcm(modname,abort_message,1)
-c----------------
-c pour initialiser convenablement le time_counter, il faut tenir compte
-c du changement de dtime en changeant itau_phy (point de depart)
-            itau_phy = NINT(itau_phy*dtime/pdtphys)
-c----------------
-            dtime=pdtphys
-         ENDIF
-
-         radpas  = NINT( RDAY/pdtphys/nbapp_rad)
-         chimpas =   radpas*nbapp_rad/nbapp_chim
-
-         CALL printflag( ok_mensuel,ok_journe,ok_instan )
-c
-c Initialiser les pas de temps:
-c
-      dtimerad = dtime*REAL(radpas)  ! pas de temps du rayonnement (s)
-c      PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
-            
-      dtimechim = dtime*REAL(chimpas)  ! pas de temps de la chimie (s)
-c      PRINT*,'dtimechim,dtime,chimpas',dtimechim,dtime,chimpas
-
-
-c INITIALISATION ORBITE
-
-         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
-
-c---------
-c FLOTT
-       IF (ok_orodr) THEN
-         DO i=1,klon
-         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
-         ENDDO
-         CALL SUGWD(klon,klev,paprs,pplay)
-         DO i=1,klon
-         zuthe(i)=0.
-         zvthe(i)=0.
-         if(zstd(i).gt.10.)then
-           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
-           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
-         endif
-         ENDDO
-       ENDIF
-
-      if (bilansmc.eq.1) then
-C  OUVERTURE D'UN FICHIER FORMATTE POUR STOCKER LES COMPOSANTES
-C  DU BILAN DE MOMENT ANGULAIRE.
-      open(27,file='aaam_bud.out',form='formatted')
-      open(28,file='fields_2d.out',form='formatted')
-      write(*,*)'Ouverture de aaam_bud.out (FL Vous parle)'
-      write(*,*)'Ouverture de fields_2d.out (FL Vous parle)'
-      endif !bilansmc
-
-c--------------SLEBONNOIS
-C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
-C  DES BALLONS
-      if (ballons.eq.1) then
-      open(30,file='ballons-lat.out',form='formatted')
-      open(31,file='ballons-lon.out',form='formatted')
-      open(32,file='ballons-u.out',form='formatted')
-      open(33,file='ballons-v.out',form='formatted')
-      open(34,file='ballons-alt.out',form='formatted')
-      write(*,*)'Ouverture des ballons*.out'
-      endif !ballons
-c-------------
-
-c---------
-C TRACEURS
-C source dans couche limite
-         source = 0.0 ! pas de source, pour l'instant
-C
-c Si microphysique offline, pas besoin d'avoir de traceurs microphysiques
-c car on lit les profils verticaux des qaer dans une look-up table pour 
-c le rayonnement. 
-
-c  calcul de nmicro
-c !!!! Les traceurs microphysiques doivent etre toujours en premiers!!
-
-      nmicro = 0
-      do iq=1,nqmax
-         nom = tname(iq)
-c        print*,iq,"nom=",nom,"tname=",tname(iq)
-         print*,iq,"nom=",nom
-         if (nom(1:1).eq."q") then
-	   nmicro = nmicro+1
-	 endif
-      enddo
-      print*,"nmicro=",nmicro
-
-c --------------
-c Verifications:
-c --------------
-         IF ((nmicro.eq.0).and.(microfi.eq.1)) THEN
-           abort_message="MICROPHYSIQUE ONLINE, MAIS NMICRO=0..."
-           call abort_gcm(modname,abort_message,1) 
-         ENDIF
-         IF (microfi.lt.1.and.clouds.eq.1) THEN
-          write(lunout,*)"microfi.lt.1.and.clouds.eq.1"
-          abort_message = 
-     &    "Impossible de faire des nuages sans microphysique..."
-          call abort_gcm(modname,abort_message,1)
-         ENDIF
-         IF (nlon .NE. klon) THEN
-            WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, 
-     .                      klon
-            abort_message='nlon et klon ne sont pas coherents'
-            call abort_gcm(modname,abort_message,1)
-         ENDIF
-         IF (nlev .NE. klev) THEN
-            WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev,
-     .                       klev
-            abort_message='nlev et klev ne sont pas coherents'
-            call abort_gcm(modname,abort_message,1)
-         ENDIF
-
-         IF (((moyzon_mu).and.(microfi.ne.1)).or.
-     .       ((.not.moyzon_mu).and.(microfi.eq.1))) THEN
-           abort_message="Microphysic 2D and moyzon_mu not compatible"
-           write(lunout,*) "moyzon_mu=",moyzon_mu
-           write(lunout,*) "microfi=",microfi
-           call abort_gcm(modname,abort_message,1) 
-         ENDIF
-         IF (((moyzon_ch).and.(.not.chimi)).or.
-     .       ((.not.moyzon_ch).and.(chimi))) THEN
-           abort_message="Chemistry and moyzon_ch not compatible"
-           write(lunout,*) "moyzon_ch=",moyzon_ch
-           write(lunout,*) "chimi=",chimi
-           call abort_gcm(modname,abort_message,1) 
-         ENDIF
-
-         IF (dtime*REAL(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
-     $    THEN 
-           WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
-           WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
-           abort_message='Nbre d appels au rayonnement insuffisant'
-           call abort_gcm(modname,abort_message,1)
-         ENDIF
-c
-         WRITE(lunout,*)"Clef pour la convection seche, iflag_ajs=",
-     .                   iflag_ajs
-c
-         ecrit_mth = NINT(RDAY/dtime) *nday  ! tous les nday jours
-         IF (ok_mensuel) THEN
-         WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 
-     .                   ecrit_mth
-         ENDIF
-
-         ecrit_day = NINT(RDAY/dtime *1.0)  ! tous les jours
-         IF (ok_journe) THEN
-         WRITE(lunout,*)'La frequence de sortie journaliere est de ',
-     .                   ecrit_day
-         ENDIF
-
-         ecrit_ins = NINT(RDAY/dtime*ecriphy)  ! Fraction de jour reglable
-         IF (ok_instan) THEN
-         WRITE(lunout,*)'La frequence de sortie instant. est de ', 
-     .                   ecrit_ins
-         ENDIF
-
-c Initialisation des sorties 
-c===========================
-
-#ifdef CPP_IOIPSL
-
-#ifdef histday
-#include "ini_histday.h"
-#endif
-
-#ifdef histmth
-#include "ini_histmth.h"
-#endif
-
-#ifdef histins
-#include "ini_histins.h"
-#endif
-
-#endif
-
-c
-c Initialiser les valeurs de u pour calculs tendances
-c (pour T, c'est fait dans phyetat0)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         u_ancien(i,k) = u(i,k)
-      ENDDO
-      ENDDO
-
-      ENDIF ! debut
-c====================================================================
-c======================================================================
-
-c   Creer un reservoir de surface infini 
-c
-      reservoir(:) = 2.
-
-c Mettre a zero des variables de sortie (pour securite)
-c
-      DO i = 1, klon
-         d_ps(i) = 0.0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_u(i,k) = 0.0
-         d_v(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO iq = 1, nqmax
-      DO k = 1, klev
-      DO i = 1, klon
-         d_qx(i,k,iq) = 0.0
-      ENDDO
-      ENDDO
-      ENDDO
-c
-c Ne pas affecter les valeurs entrees de u, v, h, et q
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k)  = t(i,k)
-         u_seri(i,k)  = u(i,k)
-         v_seri(i,k)  = v(i,k)
-      ENDDO
-      ENDDO
-      DO iq = 1, nqmax
-      DO  k = 1, klev
-      DO  i = 1, klon
-         tr_seri(i,k,iq) = qx(i,k,iq)
-      ENDDO
-      ENDDO
-      ENDDO
-C
-      DO i = 1, klon
-          ztsol(i) = ftsol(i)
-      ENDDO
-C
-      IF (if_ebil.ge.1) THEN 
-        ztit='after dynamic'
-        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-C     Comme les tendances de la physique sont ajoute dans la dynamique,
-C     on devrait avoir que la variation d'entalpie par la dynamique
-C     est egale a la variation de la physique au pas de temps precedent.
-C     Donc la somme de ces 2 variations devrait etre nulle.
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , zero_v, zero_v, zero_v, zero_v, zero_v
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol+d_h_vcol_phy, d_qt, 0.
-     s      , fs_bound, fq_bound )
-      END IF 
-
-c====================================================================
-c Diagnostiquer la tendance dynamique
-c
-      IF (ancien_ok) THEN
-         DO k = 1, klev
-         DO i = 1, klon
-            d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
-            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
-         ENDDO
-         ENDDO
-
-! ADAPTATION GCM POUR CP(T)
-         do i=1,klon
-          flux_dyn(i,1) = 0.0
-          do j=2,klev
-            flux_dyn(i,j) = flux_dyn(i,j-1)
-     . +cpdet(t_seri(i,j-1))/RG*d_t_dyn(i,j-1)*(paprs(i,j-1)-paprs(i,j))
-          enddo
-         enddo
-         
-      ELSE
-         DO k = 1, klev
-         DO i = 1, klon
-            d_u_dyn(i,k) = 0.0
-            d_t_dyn(i,k) = 0.0
-         ENDDO
-         ENDDO
-         ancien_ok = .TRUE.
-      ENDIF
-c====================================================================
-c
-c Calcule de vitesse verticale a partir de flux de masse verticale
-      DO k = 1, klev
-       DO i = 1, klon
-        omega(i,k) = RG*flxmw(i,k) / cell_area(i)
-       END DO
-      END DO
-
-c Ajouter le geopotentiel du sol:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         zphi(i,k) = pphi(i,k) + pphis(i)
-      ENDDO
-      ENDDO
-
-c     call WriteField_phy('physiq_pphi',pphi,klev)
-c     call WriteField_phy('physiq_pphis',pphis,1)
-
-c   calcul du geopotentiel aux niveaux intercouches
-c   ponderation des altitudes au niveau des couches en dp/p
-
-      DO l=1,klev
-         DO i=1,klon
-c           zzlay(i,l)=zphi(i,l)/RG
-c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
-            zzlay(i,l)=RG*RA*RA/(RG*RA-zphi(i,l))-RA
-         ENDDO
-      ENDDO
-      DO i=1,klon
-c        zzlev(i,1)=0.
-c CORRECTION 13/01/2011  
-c (correspond a la position de la surface en ce point vs RA)
-         zzlev(i,1)=pphis(i)/RG
-      ENDDO
-      DO l=2,klev
-         DO i=1,klon
-            z1=(pplay(i,l-1)+paprs(i,l))/(pplay(i,l-1)-paprs(i,l))
-            z2=(paprs(i,l)  +pplay(i,l))/(paprs(i,l)  -pplay(i,l))
-            zzlev(i,l)=(z1*zzlay(i,l-1)+z2*zzlay(i,l))/(z1+z2)
-         ENDDO
-      ENDDO
-      DO i=1,klon
-         zzlev(i,klev+1)=zzlay(i,klev)+(zzlay(i,klev)-zzlev(i,klev))
-      ENDDO
-
-! zonal averages needed
-      if (moyzon_ch.or.moyzon_mu) then
-
-c      zzlaybar(1,:)=(zphibar(1,:)+zphisbar(1))/RG
-c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
-       zzlaybar(1,:)=RG*RA*RA/(RG*RA-(zphibar(1,:)+zphisbar(1)))-RA
-       zzlevbar(1,1)=zphisbar(1)/RG
-       DO l=2,klev
-            z1=(zplaybar(1,l-1)+zplevbar(1,l))/
-     .            (zplevbar(1,l-1)-zplevbar(1,l))
-            z2=(zplevbar(1,l)  +zplaybar(1,l))/
-     .            (zplevbar(1,l)  -zplaybar(1,l))
-            zzlevbar(1,l)=(z1*zzlaybar(1,l-1)+z2*zzlaybar(1,l))/(z1+z2)
-       ENDDO
-       zzlevbar(1,klev+1)=zzlaybar(1,klev)+
-     .            (zzlaybar(1,klev)-zzlevbar(1,klev))
-
-       DO i=2,klon
-        if (latitude(i).ne.latitude(i-1)) then
-         DO l=1,klev
-c         zzlaybar(i,l)=(zphibar(i,l)+zphisbar(i))/RG
-c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
-          zzlaybar(i,l)=RG*RA*RA/(RG*RA-(zphibar(i,l)+zphisbar(i)))-RA
-         ENDDO
-         zzlevbar(i,1)=zphisbar(i)/RG
-         DO l=2,klev
-            z1=(zplaybar(i,l-1)+zplevbar(i,l))/
-     .            (zplevbar(i,l-1)-zplevbar(i,l))
-            z2=(zplevbar(i,l)  +zplaybar(i,l))/
-     .            (zplevbar(i,l)  -zplaybar(i,l))
-            zzlevbar(i,l)=(z1*zzlaybar(i,l-1)+z2*zzlaybar(i,l))/(z1+z2)
-         ENDDO
-         zzlevbar(i,klev+1)=zzlaybar(i,klev)+
-     .              (zzlaybar(i,klev)-zzlevbar(i,klev))
-        else
-         zzlaybar(i,:)=zzlaybar(i-1,:)
-         zzlevbar(i,:)=zzlevbar(i-1,:)
-        endif
-       ENDDO
-
-      endif  ! moyzon
-
-c     call WriteField_phy('physiq_zphi',zphi,klev)
-c     call WriteField_phy('physiq_zzlay',zzlay,klev)
-c     call WriteField_phy('physiq_zzlev',zzlev,klev+1)
-c- - - - - - - - - - - - - - - -
-c DIAGNOSTIQUE GRILLE VERTICALE
-c- - - - - - - - - - - - - - - -
-c     print*,"DIAGNOSTIQUE GRILLE VERTICALE"
-c     i=klon/2
-c     print*,"Niveau  Pression  Altitude    (lev puis lay)"
-c     do l=1,klev
-c      print*,l,paprs(i,l),zzlev(i,l)
-c      print*,l,pplay(i,l),zzlay(i,l)
-c     enddo
-c     print*,klev+1,paprs(i,klev+1),zzlev(i,klev+1)
-c     stop
-
-c====================================================================
-c
-c Verifier les temperatures
-c
-      CALL hgardfou(t_seri,ftsol,'debutphy')
-c====================================================================
-c
-c Incrementer le compteur de la physique
-c
-      itap   = itap + 1
-
-c====================================================================
-c
-c Epaisseurs couches
-
-      DO k = 1, klev
-      DO i = 1, klon
-         delp(i,k) = paprs(i,k)-paprs(i,k+1)
-      ENDDO
-      ENDDO
-
-c====================================================================
-c Orbite et eclairement
-c====================================================================
-
-c Pour TITAN:
-c  calcul de la longitude solaire
-          CALL solarlong(rjourvrai+gmtime,zls)
-          zlsdeg = zls*180./RPI      ! zls est en radians !!
-          print*,'Ls',zlsdeg
-
-      CALL orbite(zls,dist,pdecli) 
-      IF (debut) zlsm1=zls
-
-c dans zenang, Ls en degres ; dans mucorr, Ls en radians
-      call mucorr(klon,zls,latitude_deg,rmu0bar,fractbar)
-      IF (cycle_diurne) THEN
-        zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
-        CALL zenang(zlsdeg,gmtime,zdtime,latitude_deg,longitude_deg,
-     &              rmu0,fract)
-      ELSE
-        rmu0  = rmu0bar
-        fract = fractbar
-      ENDIF
-      
-c====================================================================
-c Appeler la diffusion verticale (programme de couche limite)
-c====================================================================
-
-c-------------------------------
-c TEST: on ne tient pas compte des calculs de clmain mais on force
-c l'equilibre radiatif du sol
-      if (1.eq.0) then
-              if (debut) then
-                print*,"ATTENTION, CLMAIN SHUNTEE..."
-              endif
-
-      DO i = 1, klon
-         sens(i) = 0.0e0 ! flux de chaleur sensible au sol
-         fder(i) = 0.0e0
-         dlw(i)  = 0.0e0
-      ENDDO
-
-c Incrementer la temperature du sol
-c
-      DO i = 1, klon
-         d_ts(i)  = dtime * radsol(i)/22000. !valeur calculee par GCM pour I=200
-         ftsol(i) = ftsol(i) + d_ts(i)
-         do j=1,nsoilmx
-           ftsoil(i,j)=ftsol(i)
-         enddo
-      ENDDO
-
-c-------------------------------
-      else
-c-------------------------------
-
-      fder = dlw
-
-c     print*,"radsol avant clmain=",radsol(klon/2)
-c     print*,"solsw avant clmain=",solsw(klon/2)
-c     print*,"sollw avant clmain=",sollw(klon/2)
-
-! ADAPTATION GCM POUR CP(T)
-
-      CALL clmain(dtime,itap,
-     e            t_seri,u_seri,v_seri,
-     e            rmu0, 
-     e            ftsol,
-     $            ftsoil,
-     $            paprs,pplay,ppk,radsol,falbe,
-     e            solsw, sollw, sollwdown, fder,
-     e            longitude_deg, latitude_deg, dx, dy,   
-     e            debut, lafin,
-     s            d_t_vdf,d_u_vdf,d_v_vdf,d_ts,
-     s            fluxt,fluxu,fluxv,cdragh,cdragm,
-     s            dsens,
-     s            ycoefh,yu1,yv1) 
-
-c     print*,"radsol apres clmain=",radsol(klon/2)
-c     print*,"solsw apres clmain=",solsw(klon/2)
-c     print*,"sollw apres clmain=",sollw(klon/2)
-
-CXXX Incrementation des flux
-      DO i = 1, klon
-         sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
-         fder(i) = dlw(i) + dsens(i) 
-      ENDDO
-CXXX
-
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
-         d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
-         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
-         d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
-         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
-         d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
-      ENDDO
-      ENDDO
-
-c     call WriteField_phy('physiq_dtvdf',d_t_vdf,klev)
-c     call WriteField_phy('physiq_duvdf',d_u_vdf,klev)
-c     call WriteField_phy('physiq_dvvdf',d_v_vdf,klev)
-
-C TRACEURS
-
-      d_tr_vdf = 0.
-      if (iflag_trac.eq.1) then
-         DO iq=1, nqmax
-             CALL cltrac(dtime,ycoefh,t_seri,
-     s               tr_seri(1,1,iq),source,
-     e               paprs, pplay,delp,
-     s               d_tr_vdf(1,1,iq))
-             tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
-             d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
-         ENDDO
-      endif
-
-      IF (if_ebil.ge.2) THEN 
-        ztit='after clmain'
-        CALL diagetpq(cell_area,ztit,ip_ebil,2,1,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-         call diagphy(cell_area,ztit,ip_ebil
-     e      , zero_v, zero_v, zero_v, zero_v, sens
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-      END IF 
-C
-c
-c Incrementer la temperature du sol
-c
-c     print*,'Tsol avant clmain:',ftsol(1)
-      DO i = 1, klon
-         ftsol(i) = ftsol(i) + d_ts(i)
-      ENDDO
-c     print*,'DTsol apres clmain:',d_ts(klon/2)
-c     print*,'Tsol apres clmain:',ftsol(1)
-
-c Calculer la derive du flux infrarouge
-c
-      DO i = 1, klon
-            dlw(i) = - 4.0*emis*RSIGMA*ftsol(i)**3 
-      ENDDO
-
-c-------------------------------
-      endif  ! fin du TEST
-
-c
-c Appeler l'ajustement sec
-c
-c===================================================================
-c Convection seche 
-c===================================================================
-c
-      d_t_ajs(:,:)=0.
-      d_u_ajs(:,:)=0.
-      d_v_ajs(:,:)=0.
-      d_tr_ajs(:,:,:)=0.
-c
-      IF(prt_level>9)WRITE(lunout,*)
-     .    'AVANT LA CONVECTION SECHE , iflag_ajs='
-     s   ,iflag_ajs
-
-      if(iflag_ajs.eq.0) then
-c  Rien
-c  ====
-         IF(prt_level>9)WRITE(lunout,*)'pas de convection'
-
-      else if(iflag_ajs.eq.1) then
-
-c  Ajustement sec
-c  ==============
-         IF(prt_level>9)WRITE(lunout,*)'ajsec'
-
-! ADAPTATION GCM POUR CP(T)
-         CALL ajsec(paprs, pplay, ppk, t_seri, u_seri, v_seri, nqmax,
-     .              tr_seri, d_t_ajs, d_u_ajs, d_v_ajs, d_tr_ajs)
-
-! ADAPTATION GCM POUR CP(T)
-         do i=1,klon
-          flux_ajs(i,1) = 0.0
-          do j=2,klev
-            flux_ajs(i,j) = flux_ajs(i,j-1)
-     .        + cpdet(t_seri(i,j-1))/RG*d_t_ajs(i,j-1)/dtime
-     .                                 *delp(i,j-1)
-          enddo
-         enddo
-         
-         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
-         d_t_ajs(:,:)= d_t_ajs(:,:)/dtime          ! K/s
-         u_seri(:,:) = u_seri(:,:) + d_u_ajs(:,:)
-         d_u_ajs(:,:)= d_u_ajs(:,:)/dtime          ! (m/s)/s
-         v_seri(:,:) = v_seri(:,:) + d_v_ajs(:,:)
-         d_v_ajs(:,:)= d_v_ajs(:,:)/dtime          ! (m/s)/s
-      if (iflag_trac.eq.1) then
-           tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
-           d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime  ! /s
-      endif
-
-c     call WriteField_phy('physiq_dtajs',d_t_ajs,klev)
-c     call WriteField_phy('physiq_duajs',d_u_ajs,klev)
-c     call WriteField_phy('physiq_dvajs',d_v_ajs,klev)
-
-      endif
-c
-      IF (if_ebil.ge.2) THEN 
-        ztit='after dry_adjust'
-        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , zero_v, zero_v, zero_v, zero_v, sens
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-      END IF 
-
-c====================================================================
-c   MICROPHYSIQUE ET CHIMIE
-c====================================================================
-
-      d_tr_mph(:,:,:)=0.
-      d_tr_kim(:,:,:)=0.
-      
-c on recupere tr_seri inchange, d_tr_micro, d_tr_chim, tous les trois sur nqmax
-c on recupere aussi qaer pour le mettre dans les sorties
-c  si microfi=1, sortie de qaer(1:nmicro)
-c  si nmicro != nqmax et si chimi, sortie de tr_seri(nmicro+1:nqmax) 
-
-c faire un test comme pour rayonnement, avec chimi en plus comme flag, 
-c pour voir si chimie appelee -> bouleen, qui passe dans phytrac.
-c faut aussi le pas de temps chimique: dtimechim, a passer..
-
-      appel_chim = 0
-      IF (MOD(itapchim,chimpas).EQ.0) THEN
-c             print*,'CHIMIE ', 
-c    $             ' (itapchim=',itapchim,'/chimpas=',chimpas,')'
-       appel_chim = 1
-       itapchim = 0
-      ENDIF
-      itapchim = itapchim + 1
-
-      if (iflag_trac.eq.1) then
-c        call WriteField_phy('physiq_qaer01',
-c    .                          qaer(:,:,1),klev)
-c        call WriteField_phy('physiq_qaer10',
-c    .                          qaer(:,:,10),klev)
-c        call WriteField_phy('physiq_tr_seri01',
-c    .                          tr_seri(:,:,1),klev)
-c        call WriteField_phy('physiq_tr_seri10',
-c    .                          tr_seri(:,:,10),klev)
-
-c         call begintime(tt0)
-c in phytrac call, mu0 and fract are only used in brume
-c so we need to pass either rmu0 ou rmu0bar depending on
-c moyzon_mu
-       if (moyzon_mu) then
-         call phytrac (debut,lafin,
-     .                 nqmax,nmicro,dtime,appel_chim,dtimechim,
-     .                 paprs,pplay,delp,t,rmu0bar,fractbar,pdecli,zls,
-     .                 yu1,yv1,zzlev,zzlay,ftsol,
-     .                 tr_seri,qaer,d_tr_mph,d_tr_kim,
-     .                 fclat,reservoir)
-       else
-         call phytrac (debut,lafin,
-     .                 nqmax,nmicro,dtime,appel_chim,dtimechim,
-     .                 paprs,pplay,delp,t,rmu0,fract,pdecli,zls,
-     .                 yu1,yv1,zzlev,zzlay,ftsol,
-     .                 tr_seri,qaer,d_tr_mph,d_tr_kim,
-     .                 fclat,reservoir)
-       endif
-
-c         call endtime(tt0,tt1)
-c         ttphytra=ttphytra+tt1
-
-c ----- ICI on ajuste radsol en tenant compte du flux de chaleur latente 
-c       d'evaporation du reservoir.
-c       NOTE : c'est pas tres elegant mais ca permet d'eviter d'aller
-c              toucher a clmain.
-        if (clouds.eq.1) then
-          radsol(:) = radsol(:)+fclat(:)    !test pas de flx de chaleur latente
-        endif
-
-        if (microfi.ge.1) then
-         tr_seri(:,:,1:nmicro) = tr_seri(:,:,1:nmicro)
-     .                        + d_tr_mph(:,:,1:nmicro)*dtime
-c        call WriteField_phy('physiq_d_tr_mph01',
-c    .                          d_tr_mph(:,:,1),klev)
-c        call WriteField_phy('physiq_d_tr_mph10',
-c    .                          d_tr_mph(:,:,10),klev)
-	endif
-c       PAS ELEGANT mais je n'ai pas trouve d'autres solutions :
-c       Il semblerait qu'il y ait un probleme lorsque les tendances de traceurs
-c       retourne des traceurs nuls et il y a parfois des valeurs negatives qui trainent.
-c       Pour ne diffuser le probleme, on force les valeurs negatives a ZERO.
-        DO iq=1,nmicro
-          DO i=1,klon
-            DO l=1,klev
-              if (tr_seri(i,l,iq).lt.0.) then
-                 tr_seri(i,l,iq) = 0.
-              endif
-            ENDDO
-          ENDDO
-        ENDDO
-
-c condensation:
-c       NE PAS OUBLIER LA CONDENSATION DES NUAGES !!!!
-        if ((clouds.eq.1.or.(chimi)).and.nqmax.gt.nmicro) then
-          tr_seri(:,:,nmicro+1:nqmax) = tr_seri(:,:,nmicro+1:nqmax)
-     .                         + d_tr_mph(:,:,nmicro+1:nqmax)*dtime
-        endif
-
-c chimie:
-        if ((chimi).and.(nqmax.gt.nmicro)) then
-         tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_kim(:,:,:)*dtime
-	endif
-
-      endif  !iflag_trac=1
-
-c       ch4=0.
-c       do l=1,llm
-c         ch4(1,l) = tr_seri(1,l,ich4)
-c         do j=2,jjm
-c           ig0=1+(j-2)*iim
-c           do i=1,iim
-c             ch4(j,l)= ch4(j,l)  + tr_seri(ig0+i,l,ich4)/iim
-c           enddo
-c         enddo
-c         ch4(jjm+1,l) = tr_seri(klon,l,ich4)
-c       enddo
-c       do j=1,jjm+1
-c         write(501,*) j,ch4(j,1)
-c       enddo
-c       do l=1,llm
-c         write(502,'(I3,49(ES24.17,1X))') l, 
-c     &   (ch4(j,l),j=1,jjm+1)
-c       enddo
-c       write(501,*) ""
-c       write(502,*) ""
-
-c------------------
-c test condensation
-c     do i=1,nqmax 
-c       if(tname(i).eq."HCN") then
-c          print*,"HCN="
-c          do k=1,klev
-c           print*,k,tr_seri(klon/2,k,i),d_tr_mph(klon/2,k,i)*dtime
-c    v      ,d_tr_kim(klon/2,k,i)*dtime
-c          enddo
-c          stop
-c       endif
-c     enddo
-c------------------
-
-c====================================================================
-c RAYONNEMENT
-c====================================================================
-
-      IF (MOD(itaprad,radpas).EQ.0) THEN
-c             print*,'RAYONNEMENT ', 
-c    $             ' (itaprad=',itaprad,'/radpas=',radpas,')'
-
-c ATTENTION, (klon/2) ne marche pas toujours............
-c     print*,"radsol avant radlwsw=",radsol(klon/2)
-c     print*,"solsw avant radlwsw=",solsw(klon/2)
-c     print*,"sollw avant radlwsw=",sollw(klon/2)
-c     print*,"avant radlwsw"
-
-c   ----------------
-c   Calcul du rayon moyen des gouttes et des fractions volumique pour le TR
-c  ----------------
-      IF (clouds.eq.1) THEN
-        DO i=1,klon
-          DO j=1,klev
-            rmcbar(i,j)=rmcbar(i,j)/MAX(REAL(ncount(i,j)),1.)
-            xfbar(i,j,:)=xfbar(i,j,:)/MAX(REAL(ncount(i,j)),1.)
-          ENDDO 
-        ENDDO
-      ENDIF
-     
-c      call begintime(tt0)
-      CALL radlwsw
-     e            (dist, rmu0, fract, zzlev,
-     e             paprs, pplay,ftsol, t_seri, nqmax, nmicro,
-     c             tr_seri, qaer)
-c     print*,"apres radlwsw"
-
-c      call endtime(tt0,tt1)
-c      ttrad=ttrad+tt1
-
-c     print*,"apres radlwsw"
-c     mise a zero du rayon moyen des gouttes et des fractions volumique 
-      IF (clouds.eq.1) THEN
-        rmcbar(:,:)  = 0.
-        xfbar(:,:,:) = 0.
-        ncount(:,:)  = 0
-      ENDIF
-
-      itaprad = 0
-      DO k = 1, klev
-       DO i = 1, klon
-         dtrad(i,k) = heat(i,k)-cool(i,k)     !K/s
-       ENDDO
-      ENDDO
-
-c     call WriteField_phy('physiq_heat',heat,klev)
-c     call WriteField_phy('physiq_cool',cool,klev)
-
-      ENDIF
-      itaprad = itaprad + 1
-c====================================================================
-c
-c Ajouter la tendance des rayonnements (tous les pas)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + dtrad(i,k) * dtime
-      ENDDO
-      ENDDO
- 
-      IF (if_ebil.ge.2) THEN 
-        ztit='after rad'
-        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , topsw, toplw, solsw, sollw, zero_v
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-      END IF 
-c
-
-c====================================================================
-c   Calcul  des gravity waves  FLOTT
-c====================================================================
-c
-      if (ok_orodr.or.ok_gw_nonoro) then
-c  CALCUL DE N2
-       do i=1,klon
-        do k=2,klev
-	  ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
-	  zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
-	enddo
-       enddo
-       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
-       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
-       do i=1,klon
-        do k=2,klev
-	  zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
-	  zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
-          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
-          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
-	enddo
-        zn2(i,1) = 1.e-12  ! securite
-       enddo
-
-      endif
-      
-c ----------------------------ORODRAG
-      IF (ok_orodr) THEN
-c
-c  selection des points pour lesquels le shema est actif:
-        igwd=0
-        DO i=1,klon
-        itest(i)=0
-c        IF ((zstd(i).gt.10.0)) THEN
-        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
-          itest(i)=1
-          igwd=igwd+1
-          idx(igwd)=i
-        ENDIF
-        ENDDO
-c        igwdim=MAX(1,igwd)
-c
-c A ADAPTER POUR VENUS!!!
-        CALL drag_noro(klon,klev,dtime,paprs,pplay,pphi,zn2,
-     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
-     e                   igwd,idx,itest,
-     e                   t_seri, u_seri, v_seri,
-     s                   zulow, zvlow, zustrdr, zvstrdr,
-     s                   d_t_oro, d_u_oro, d_v_oro)
-
-c       print*,"d_u_oro=",d_u_oro(klon/2,:)
-c  ajout des tendances
-           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
-           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
-           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
-           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
-           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
-           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
-c    
-      ELSE
-         d_t_oro = 0.
-         d_u_oro = 0.
-         d_v_oro = 0.
-	 zustrdr = 0.
-	 zvstrdr = 0.
-c
-      ENDIF ! fin de test sur ok_orodr
-c
-c ----------------------------OROLIFT
-      IF (ok_orolf) THEN
-       print*,"ok_orolf NOT IMPLEMENTED !"
-       stop
-c
-c  selection des points pour lesquels le shema est actif:
-        igwd=0
-        DO i=1,klon
-        itest(i)=0
-        IF ((zpic(i)-zmea(i)).GT.100.) THEN
-          itest(i)=1
-          igwd=igwd+1
-          idx(igwd)=i
-        ENDIF
-        ENDDO
-c        igwdim=MAX(1,igwd)
-c
-c A ADAPTER POUR VENUS ET TITAN!!!
-c            CALL lift_noro(klon,klev,dtime,paprs,pplay,
-c     e                   latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval,
-c     e                   igwd,idx,itest,
-c     e                   t_seri, u_seri, v_seri,
-c     s                   zulow, zvlow, zustrli, zvstrli,
-c     s                   d_t_lif, d_u_lif, d_v_lif               )
-
-c
-c  ajout des tendances
-           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
-           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
-           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
-           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
-           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
-           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
-c
-      ELSE
-         d_t_lif = 0.
-         d_u_lif = 0.
-         d_v_lif = 0.
-         zustrli = 0.
-         zvstrli = 0.
-c
-      ENDIF ! fin de test sur ok_orolf
-
-c ---------------------------- NON-ORO GRAVITY WAVES
-       IF(ok_gw_nonoro) then
-
-        abort_message="Option non developpee pour Titan"
-        call abort_gcm(modname,abort_message,1)
-c A FAIRE POUR TITAN
-c      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
-c     e               t_seri, u_seri, v_seri,
-c     o               zustrhi,zvstrhi,
-c     o               d_t_hin, d_u_hin, d_v_hin)
-
-c  ajout des tendances
-
-c         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
-c         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
-c         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
-c         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
-c         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
-c         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
-
-      ELSE
-         d_t_hin = 0.
-         d_u_hin = 0.
-         d_v_hin = 0.
-         zustrhi = 0.
-         zvstrhi = 0.
-
-      ENDIF ! fin de test sur ok_gw_nonoro
-
-c====================================================================
-c Transport de ballons 
-c====================================================================
-      if (ballons.eq.1) then
-         CALL ballon(30,pdtphys,rjourvrai,gmtime,
-     &               latitude_deg,longitude_deg,
-c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
-     C               t,pplay,u,v,zphi)   ! alt above planet average radius
-      endif !ballons
-
-c====================================================================
-c Bilan de mmt angulaire
-c====================================================================
-      if (bilansmc.eq.1) then
-CMODDEB FLOTT
-C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
-C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
-
-      DO i = 1, klon
-        zustrph(i)=0.
-        zvstrph(i)=0.
-        zustrcl(i)=0.
-        zvstrcl(i)=0.
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-      ENDDO
-      ENDDO
-
-      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
-     C               ra,rg,romega,
-     C               latitude_deg,longitude_deg,pphis,
-     C               zustrdr,zustrli,zustrcl,
-     C               zvstrdr,zvstrli,zvstrcl,
-     C               paprs,u,v)
-                     
-CCMODFIN FLOTT
-      endif !bilansmc
-
-c====================================================================
-c====================================================================
-c Calculer le transport de l'eau et de l'energie (diagnostique)
-c
-c  A REVOIR POUR VENUS ET TITAN...
-c
-c     CALL transp (paprs,ftsol,
-c    e                   t_seri, q_seri, u_seri, v_seri, zphi,
-c    s                   ve, vq, ue, uq)
-c
-c====================================================================
-c+jld ec_conser
-      DO k = 1, klev
-      DO i = 1, klon
-        d_t_ec(i,k)=0.5/cpdet(t_seri(i,k))
-     $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
-        t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
-        d_t_ec(i,k) = d_t_ec(i,k)/dtime
-       END DO 
-      END DO 
-         do i=1,klon
-          flux_ec(i,1) = 0.0
-          do j=2,klev
-            flux_ec(i,j) = flux_ec(i,j-1)
-     . +cpdet(t_seri(i,j-1))/RG*d_t_ec(i,j-1)*delp(i,j-1)
-          enddo
-         enddo
-         
-c-jld ec_conser
-c====================================================================
-      IF (if_ebil.ge.1) THEN 
-        ztit='after physic'
-        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-C     Comme les tendances de la physique sont ajoute dans la dynamique,
-C     on devrait avoir que la variation d'entalpie par la dynamique
-C     est egale a la variation de la physique au pas de temps precedent.
-C     Donc la somme de ces 2 variations devrait etre nulle.
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , topsw, toplw, solsw, sollw, sens
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-C
-      d_h_vcol_phy=d_h_vcol
-C
-      END IF 
-C
-c=======================================================================
-c   SORTIES
-c=======================================================================
-
-c Convertir les incrementations en tendances
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
-         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
-         d_t(i,k) = ( t_seri(i,k) - t(i,k) ) / dtime
-      ENDDO
-      ENDDO
-c
-      DO iq = 1, nqmax
-      DO  k = 1, klev
-      DO  i = 1, klon
-         d_qx(i,k,iq) = ( tr_seri(i,k,iq) - qx(i,k,iq) ) / dtime
-      ENDDO
-      ENDDO
-      ENDDO
-      
-c------------------------
-c Calcul moment cinetique
-c------------------------
-c TEST...
-c     mangtot = 0.0
-c     DO k = 1, klev
-c     DO i = 1, klon
-c       mang(i,k) = RA*cos(latitude(i))
-c    .     *(u_seri(i,k)+RA*cos(latitude(i))*ROMEGA)
-c    .     *cell_area(i)*(paprs(i,k)-paprs(i,k+1))/RG
-c       mangtot=mangtot+mang(i,k)
-c     ENDDO
-c     ENDDO
-c     print*,"Moment cinetique total = ",mangtot
-c
-c------------------------
-c
-c Sauvegarder les valeurs de t et u a la fin de la physique:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         u_ancien(i,k) = u_seri(i,k)
-         t_ancien(i,k) = t_seri(i,k)
-      ENDDO
-      ENDDO
-c
-c=============================================================
-c   Ecriture des sorties
-c=============================================================
-      
-#ifdef CPP_IOIPSL
-
-#ifdef histday
-#include "write_histday.h"
-#endif
-
-#ifdef histmth
-#include "write_histmth.h"
-#endif
-
-#ifdef histins
-#include "write_histins.h"
-#endif
-
-#endif
-
-c====================================================================
-c Si c'est la fin, il faut conserver l'etat de redemarrage
-c====================================================================
-c
-      IF (lafin) THEN
-         itau_phy = itau_phy + itap
-         lsinit   = zlsdeg
-         CALL phyredem ("restartphy.nc")
-     
-c--------------FLOTT
-CMODEB LOTT
-C  FERMETURE DU FICHIER FORMATTE CONTENANT LES COMPOSANTES
-C  DU BILAN DE MOMENT ANGULAIRE.
-      if (bilansmc.eq.1) then
-        write(*,*)'Fermeture de aaam_bud.out (FL Vous parle)'
-        close(27)                                     
-        close(28)                                     
-      endif !bilansmc
-CMODFIN
-c-------------
-c--------------SLEBONNOIS
-C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
-C  DES BALLONS
-      if (ballons.eq.1) then
-        write(*,*)'Fermeture des ballons*.out'
-        close(30)                                     
-        close(31)                                     
-        close(32)                                     
-        close(33)                                     
-        close(34)                                     
-      endif !ballons
-c-------------
-      ENDIF
-      
-      RETURN
-      END
-
-
-
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-
-      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
-      IMPLICIT none
-c
-c Tranformer une variable de la grille physique a
-c la grille d'ecriture
-c
-      INTEGER nfield,nlon,iim,jjmp1, jjm
-      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
-c
-      INTEGER i, n, ig
-c
-      jjm = jjmp1 - 1
-      DO n = 1, nfield
-         DO i=1,iim
-            ecrit(i,n) = fi(1,n)
-            ecrit(i+jjm*iim,n) = fi(nlon,n)
-         ENDDO
-         DO ig = 1, nlon - 2
-           ecrit(iim+ig,n) = fi(1+ig,n)
-         ENDDO
-      ENDDO
-      RETURN
-      END
Index: /trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F	(revision 1549)
+++ /trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F	(revision 1549)
@@ -0,0 +1,1632 @@
+!
+! $Id: $
+!
+      MODULE physiq_mod
+
+      IMPLICIT NONE
+
+      CONTAINS
+
+      SUBROUTINE physiq (nlon,nlev,nqmax,
+     .            debut,lafin,rjourvrai,gmtime,pdtphys,
+     .            paprs,pplay,ppk,pphi,pphis,presnivs,
+     .            u,v,t,qx,
+     .            flxmw,
+     .            d_u, d_v, d_t, d_qx, d_ps)
+
+c======================================================================
+c
+c Modifications pour la physique de Titan
+c     S. Lebonnois (LMD/CNRS) Juin 2013: Parallelisation
+c
+c ---------------------------------------------------------------------
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c
+c Objet: Moniteur general de la physique du modele
+cAA      Modifications quant aux traceurs :
+cAA                  -  uniformisation des parametrisations ds phytrac
+cAA                  -  stockage des moyennes des champs necessaires
+cAA                     en mode traceur off-line 
+c    modif   ( P. Le Van ,  12/10/98 )
+c
+c  Arguments:
+c
+c nlon----input-I-nombre de points horizontaux
+c nlev----input-I-nombre de couches verticales
+c nqmax---input-I-nombre de traceurs
+c debut---input-L-variable logique indiquant le premier passage
+c lafin---input-L-variable logique indiquant le dernier passage
+c rjour---input-R-numero du jour de l'experience
+c gmtime--input-R-temps universel dans la journee (0 a RDAY s)
+c pdtphys-input-R-pas d'integration pour la physique (seconde)
+c paprs---input-R-pression pour chaque inter-couche (en Pa)
+c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
+c ppk  ---input-R-fonction d'Exner au milieu de couche
+c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
+c pphis---input-R-geopotentiel du sol
+c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
+c u-------input-R-vitesse dans la direction X (de O a E) en m/s
+c v-------input-R-vitesse Y (de S a N) en m/s
+c t-------input-R-temperature (K)
+c qx------input-R-mass mixing ratio traceurs (kg/kg) 
+c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
+c flxmw---input-R-flux de masse vertical en kg/s
+c
+c d_u-----output-R-tendance physique de "u" (m/s/s)
+c d_v-----output-R-tendance physique de "v" (m/s/s)
+c d_t-----output-R-tendance physique de "t" (K/s)
+c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
+c d_ps----output-R-tendance physique de la pression au sol
+c======================================================================
+      USE ioipsl
+!      USE histcom ! not needed; histcom is included in ioipsl
+      USE infotrac
+      use dimphy
+      USE geometry_mod, ONLY: longitude, latitude, ! in radians
+     &                        longitude_deg, latitude_deg, ! in degrees
+     &                        cell_area, dx, dy
+      use cpdet_mod, only: cpdet, t2tpot
+      USE mod_phys_lmdz_para, only : is_parallel,jj_nb
+      USE phys_state_var_mod ! Variables sauvegardees de la physique
+      USE iophy
+      USE common_mod, only: rmcbar,xfbar,ncount,
+     &      flxesp_i,tau_drop,tau_aer,solesp,precip,
+     &      evapch4,occcld_m,occcld,satch4,satc2h6,satc2h2,rmcloud,
+     &      TauHID,TauHVD,TauGID,TauGVD,TauCID,TauCVD,NSPECV,NSPECI,
+     &      common_init
+
+      USE moyzon_mod
+      USE write_field_phy
+      USE time_phylmdz_mod, only: itau_phy,day_ref,annee_ref,nday
+      USE logic_mod, only: iflag_trac,moyzon_ch,moyzon_mu
+      USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
+      IMPLICIT none
+c======================================================================
+c   CLEFS CPP POUR LES IO
+c   =====================
+#define histday
+#define histmth
+#define histins
+c======================================================================
+#include "dimensions.h"
+      integer jjmp1
+      parameter (jjmp1=jjm+1-1/jjm)
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "iniprint.h"
+#include "tabcontrol.h"
+#include "comorbit.h"
+#include "microtab.h"
+#include "itemps.h"
+c======================================================================
+      LOGICAL ok_journe ! sortir le fichier journalier
+      save ok_journe
+c      PARAMETER (ok_journe=.true.)
+c
+      LOGICAL ok_mensuel ! sortir le fichier mensuel
+      save ok_mensuel
+c      PARAMETER (ok_mensuel=.true.)
+c
+      LOGICAL ok_instan ! sortir le fichier instantane
+      save ok_instan
+c      PARAMETER (ok_instan=.true.)
+c
+c======================================================================
+c
+c Variables argument:
+c
+      INTEGER nlon
+      INTEGER nlev
+      INTEGER nqmax
+      REAL rjourvrai
+      REAL gmtime
+      REAL pdtphys
+      LOGICAL debut, lafin
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL pphi(klon,klev)
+      REAL pphis(klon)
+      REAL presnivs(klev)
+
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)
+
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL t(klon,klev)
+      REAL qx(klon,klev,nqmax)
+
+      REAL d_u_dyn(klon,klev)
+      REAL d_t_dyn(klon,klev)
+
+      REAL flxmw(klon,klev)
+
+      REAL d_u(klon,klev)
+      REAL d_v(klon,klev)
+      REAL d_t(klon,klev)
+      REAL d_qx(klon,klev,nqmax)
+      REAL d_ps(klon)
+
+c Variables propres a la physique
+c
+      REAL,save,allocatable :: rlev(:,:) ! altitude a chaque niveau (interface inferieure de la couche) 
+      INTEGER,save :: itap        ! compteur pour la physique
+      REAL delp(klon,klev)        ! epaisseur d'une couche
+      REAL omega(klon,klev)
+      
+      INTEGER igwd,idx(klon),itest(klon)
+c
+c  Diagnostiques 2D de drag_noro, lift_noro et gw_nonoro
+
+      REAL zulow(klon),zvlow(klon)
+      REAL zustrdr(klon), zvstrdr(klon)
+      REAL zustrli(klon), zvstrli(klon)
+      REAL zustrhi(klon), zvstrhi(klon)
+
+c Pour calcul GW drag oro et nonoro: CALCUL de N2:
+      real zdzlev(klon,klev)
+      real ztlev(klon,klev),zpklev(klon,klev)
+      real ztetalay(klon,klev),ztetalev(klon,klev)
+      real zdtetalev(klon,klev)
+      real zn2(klon,klev) ! BV^2 at plev
+
+c Pour les bilans de moment angulaire, 
+      integer bilansmc
+c Pour le transport de ballons
+      integer ballons
+c j'ai aussi besoin
+c du stress de couche limite a la surface:
+
+      REAL zustrcl(klon),zvstrcl(klon) 
+
+c et du stress total c de la physique:
+
+      REAL zustrph(klon),zvstrph(klon) 
+
+c Variables locales:
+c
+      REAL cdragh(klon) ! drag coefficient pour T and Q
+      REAL cdragm(klon) ! drag coefficient pour vent
+c
+cAA  Pour  TRACEURS
+cAA
+      REAL,save,allocatable :: source(:,:)
+      integer nmicro
+      save    nmicro
+      character*8 nom
+      REAL qaer(klon,klev,nqmax)
+
+      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
+      REAL yu1(klon)            ! vents dans la premiere couche U
+      REAL yv1(klon)            ! vents dans la premiere couche V
+
+      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
+      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
+      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
+      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
+      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
+c
+
+c======================================================================
+c
+c Declaration des procedures appelees
+c
+      EXTERNAL ajsec     ! ajustement sec
+      EXTERNAL clmain    ! couche limite 
+      EXTERNAL hgardfou  ! verifier les temperatures
+      EXTERNAL orbite    ! calculer l'orbite 
+      EXTERNAL phyetat0  ! lire l'etat initial de la physique
+      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
+      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
+      EXTERNAL suphec    ! initialiser certaines constantes
+c     EXTERNAL transp    ! transport total de l'eau et de l'energie
+      EXTERNAL abort_gcm
+      EXTERNAL printflag
+      EXTERNAL zenang
+      EXTERNAL diagetpq
+      EXTERNAL conf_phys
+      EXTERNAL diagphy
+      EXTERNAL mucorr
+      EXTERNAL phytrac
+c
+c Variables locales
+c
+CXXX PB 
+      REAL fluxt(klon,klev)   ! flux turbulent de chaleur
+      REAL fluxu(klon,klev)   ! flux turbulent de vitesse u
+      REAL fluxv(klon,klev)   ! flux turbulent de vitesse v
+c
+      REAL flux_dyn(klon,klev)  ! flux de chaleur produit par la dynamique
+      REAL flux_ajs(klon,klev)  ! flux de chaleur ajustement sec
+      REAL flux_ec(klon,klev)   ! flux de chaleur Ec
+c
+      REAL    dtimerad
+      INTEGER itaprad
+      SAVE itaprad,dtimerad
+      REAL zdtime
+c
+c CHIMIE
+
+      REAL    dtimechim
+      INTEGER itapchim,appel_chim
+      SAVE itapchim,dtimechim
+
+c ORBITE
+
+      REAL dist, rmu0(klon), fract(klon), pdecli
+      REAL rmu0bar(klon), fractbar(klon)
+      REAL zday
+      REAL zls,zlsdeg,zlsm1
+      save zlsm1
+c
+      INTEGER i, k, iq, ig, j, ll, l
+c
+      REAL zphi(klon,klev)
+      REAL zzlev(klon,klev+1),zzlay(klon,klev),z1,z2
+c
+c Variables du changement
+c
+c ajs: ajustement sec
+c vdf: couche limite (Vertical DiFfusion)
+c mph: microphysique
+c kim: chimie
+      REAL d_t_ajs(klon,klev), d_tr_ajs(klon,klev,nqmax)
+      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
+c
+      REAL d_ts(klon)
+c
+      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
+      REAL d_t_vdf(klon,klev), d_tr_vdf(klon,klev,nqmax)
+c
+      REAL d_tr_mph(klon,klev,nqmax),d_tr_kim(klon,klev,nqmax)
+
+CMOD LOTT: Tendances Orography Sous-maille
+      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
+      REAL d_t_oro(klon,klev)
+      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
+      REAL d_t_lif(klon,klev)
+C          Tendances Ondes de G non oro (runs strato).
+      REAL d_u_hin(klon,klev), d_v_hin(klon,klev)
+      REAL d_t_hin(klon,klev)
+
+c
+c Variables liees a l'ecriture de la bande histoire physique
+c
+      INTEGER ecrit_mth
+      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
+c
+      INTEGER ecrit_day
+      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
+c
+      INTEGER ecrit_ins
+      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
+c
+      integer itau_w   ! pas de temps ecriture = itap + itau_phy
+
+c Variables locales pour effectuer les appels en serie
+c
+      REAL t_seri(klon,klev)
+      REAL u_seri(klon,klev), v_seri(klon,klev)
+c
+      REAL tr_seri(klon,klev,nqmax)
+      REAL d_tr(klon,klev,nqmax)
+c
+c pour ioipsl
+      INTEGER nid_day, nid_mth, nid_ins
+      SAVE nid_day, nid_mth, nid_ins
+      INTEGER nhori, nvert, idayref
+      REAL zsto, zout, zsto1, zsto2, zero
+      parameter (zero=0.0e0)
+      real zjulian
+      save zjulian
+      REAL tmpout(klon,klev)  ! pour sorties
+
+      CHARACTER*1  str1
+      CHARACTER*2  str2
+      character*20 modname
+      character*80 abort_message
+      logical ok_sync
+
+      character*30 nom_fichier
+      character*10 varname
+      character*40 vartitle
+      character*20 varunits
+C     Variables liees au bilan d'energie et d'enthalpi
+      REAL ztsol(klon)
+      REAL      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      SAVE      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      REAL      d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
+      REAL      d_h_vcol_phy
+      REAL      fs_bound, fq_bound
+      SAVE      d_h_vcol_phy
+      REAL      zero_v(klon),zero_v2(klon,klev)
+      CHARACTER*15 ztit
+      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
+      SAVE      ip_ebil
+      DATA      ip_ebil/2/
+      INTEGER   if_ebil ! level for energy conserv. dignostics
+      SAVE      if_ebil
+c+jld ec_conser
+      REAL d_t_ec(klon,klev)    ! tendance du a la conversion Ec -> E thermique
+c-jld ec_conser
+
+c TEST VENUS...
+      REAL mang(klon,klev)    ! moment cinetique
+      REAL mangtot            ! moment cinetique total
+
+c Temporaire avant de trouver mieux :
+c Recuperation des TAU du TR
+      REAL t_tauhvd(klon,klev),t_khvd(klon,klev)
+      REAL t_tcld(klon,klev),t_kcld(klon,klev)
+      REAL t_kcvd(klon,klev)
+
+       REAL ch4(klon,jjm+1),dch4(jjm+1)
+       INTEGER ig0
+       integer ich4
+       common/ch4ind/ich4
+
+c     flux de chaleur latente d'evaporation CH4
+      REAL fclat(klon)
+c     reservoir de surface
+      REAL,save,allocatable :: reservoir(:)
+
+c Declaration des constantes et des fonctions thermodynamiques
+c
+#include "YOMCST.h"
+
+c======================================================================
+c INITIALISATIONS
+c================
+
+      modname = 'physiq'
+      ok_sync=.TRUE.
+
+      bilansmc = 0
+      ballons  = 0
+! NE FONCTIONNENT PAS ENCORE EN PARALLELE !!!
+      if (is_parallel) then
+        bilansmc = 0
+        ballons  = 0
+      endif
+
+      IF (if_ebil.ge.1) THEN
+        DO i=1,klon
+          zero_v(i)=0.
+        END DO 
+        DO i=1,klon
+         DO j=1,klev
+          zero_v2(i,j)=0.
+         END DO 
+        END DO 
+      END IF 
+      
+c PREMIER APPEL SEULEMENT
+c========================
+      IF (debut) THEN
+         allocate(rlev(klon,klevp1))
+         allocate(source(klon,nqmax))
+         allocate(reservoir(klon))
+
+         CALL suphec ! initialiser constantes et parametres phys.
+
+         IF (if_ebil.ge.1) d_h_vcol_phy=0.
+c
+c appel a la lecture du physiq.def 
+c
+         call conf_phys(ok_mensuel,ok_journe,
+     .                  ok_instan,
+     .                  if_ebil)
+
+         call phys_state_var_init
+         call common_init
+c
+c Initialiser les compteurs:
+c
+         itap    = 0
+         itaprad = 0
+         itapchim    = 1
+
+c init rnuabar
+         ncount(:,:) = 0
+         rmcbar  = 0.
+         xfbar   = 0.
+         
+c         
+c Lecture startphy.nc :
+c
+         CALL phyetat0 ("startphy.nc")
+
+c dtime est defini dans tabcontrol.h et lu dans startphy
+c pdtphys est calcule a partir des nouvelles conditions:
+c Reinitialisation du pas de temps physique quand changement
+         IF (ABS(dtime-pdtphys).GT.0.001) THEN
+            WRITE(lunout,*) 'Pas physique a change',dtime,
+     .                        pdtphys
+c           abort_message='Pas physique n est pas correct '
+c           call abort_gcm(modname,abort_message,1)
+c----------------
+c pour initialiser convenablement le time_counter, il faut tenir compte
+c du changement de dtime en changeant itau_phy (point de depart)
+            itau_phy = NINT(itau_phy*dtime/pdtphys)
+c----------------
+            dtime=pdtphys
+         ENDIF
+
+         radpas  = NINT( RDAY/pdtphys/nbapp_rad)
+         chimpas =   radpas*nbapp_rad/nbapp_chim
+
+         CALL printflag( ok_mensuel,ok_journe,ok_instan )
+c
+c Initialiser les pas de temps:
+c
+      dtimerad = dtime*REAL(radpas)  ! pas de temps du rayonnement (s)
+c      PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
+            
+      dtimechim = dtime*REAL(chimpas)  ! pas de temps de la chimie (s)
+c      PRINT*,'dtimechim,dtime,chimpas',dtimechim,dtime,chimpas
+
+
+c INITIALISATION ORBITE
+
+         CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit)
+
+c---------
+c FLOTT
+       IF (ok_orodr) THEN
+         DO i=1,klon
+         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
+         ENDDO
+         CALL SUGWD(klon,klev,paprs,pplay)
+         DO i=1,klon
+         zuthe(i)=0.
+         zvthe(i)=0.
+         if(zstd(i).gt.10.)then
+           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
+           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
+         endif
+         ENDDO
+       ENDIF
+
+      if (bilansmc.eq.1) then
+C  OUVERTURE D'UN FICHIER FORMATTE POUR STOCKER LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      open(27,file='aaam_bud.out',form='formatted')
+      open(28,file='fields_2d.out',form='formatted')
+      write(*,*)'Ouverture de aaam_bud.out (FL Vous parle)'
+      write(*,*)'Ouverture de fields_2d.out (FL Vous parle)'
+      endif !bilansmc
+
+c--------------SLEBONNOIS
+C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+      open(30,file='ballons-lat.out',form='formatted')
+      open(31,file='ballons-lon.out',form='formatted')
+      open(32,file='ballons-u.out',form='formatted')
+      open(33,file='ballons-v.out',form='formatted')
+      open(34,file='ballons-alt.out',form='formatted')
+      write(*,*)'Ouverture des ballons*.out'
+      endif !ballons
+c-------------
+
+c---------
+C TRACEURS
+C source dans couche limite
+         source = 0.0 ! pas de source, pour l'instant
+C
+c Si microphysique offline, pas besoin d'avoir de traceurs microphysiques
+c car on lit les profils verticaux des qaer dans une look-up table pour 
+c le rayonnement. 
+
+c  calcul de nmicro
+c !!!! Les traceurs microphysiques doivent etre toujours en premiers!!
+
+      nmicro = 0
+      do iq=1,nqmax
+         nom = tname(iq)
+c        print*,iq,"nom=",nom,"tname=",tname(iq)
+         print*,iq,"nom=",nom
+         if (nom(1:1).eq."q") then
+	   nmicro = nmicro+1
+	 endif
+      enddo
+      print*,"nmicro=",nmicro
+
+c --------------
+c Verifications:
+c --------------
+         IF ((nmicro.eq.0).and.(microfi.eq.1)) THEN
+           abort_message="MICROPHYSIQUE ONLINE, MAIS NMICRO=0..."
+           call abort_gcm(modname,abort_message,1) 
+         ENDIF
+         IF (microfi.lt.1.and.clouds.eq.1) THEN
+          write(lunout,*)"microfi.lt.1.and.clouds.eq.1"
+          abort_message = 
+     &    "Impossible de faire des nuages sans microphysique..."
+          call abort_gcm(modname,abort_message,1)
+         ENDIF
+         IF (nlon .NE. klon) THEN
+            WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, 
+     .                      klon
+            abort_message='nlon et klon ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+         IF (nlev .NE. klev) THEN
+            WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev,
+     .                       klev
+            abort_message='nlev et klev ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+
+         IF (((moyzon_mu).and.(microfi.ne.1)).or.
+     .       ((.not.moyzon_mu).and.(microfi.eq.1))) THEN
+           abort_message="Microphysic 2D and moyzon_mu not compatible"
+           write(lunout,*) "moyzon_mu=",moyzon_mu
+           write(lunout,*) "microfi=",microfi
+           call abort_gcm(modname,abort_message,1) 
+         ENDIF
+         IF (((moyzon_ch).and.(.not.chimi)).or.
+     .       ((.not.moyzon_ch).and.(chimi))) THEN
+           abort_message="Chemistry and moyzon_ch not compatible"
+           write(lunout,*) "moyzon_ch=",moyzon_ch
+           write(lunout,*) "chimi=",chimi
+           call abort_gcm(modname,abort_message,1) 
+         ENDIF
+
+         IF (dtime*REAL(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
+     $    THEN 
+           WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
+           WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
+           abort_message='Nbre d appels au rayonnement insuffisant'
+           call abort_gcm(modname,abort_message,1)
+         ENDIF
+c
+         WRITE(lunout,*)"Clef pour la convection seche, iflag_ajs=",
+     .                   iflag_ajs
+c
+         ecrit_mth = NINT(RDAY/dtime) *nday  ! tous les nday jours
+         IF (ok_mensuel) THEN
+         WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 
+     .                   ecrit_mth
+         ENDIF
+
+         ecrit_day = NINT(RDAY/dtime *1.0)  ! tous les jours
+         IF (ok_journe) THEN
+         WRITE(lunout,*)'La frequence de sortie journaliere est de ',
+     .                   ecrit_day
+         ENDIF
+
+         ecrit_ins = NINT(RDAY/dtime*ecriphy)  ! Fraction de jour reglable
+         IF (ok_instan) THEN
+         WRITE(lunout,*)'La frequence de sortie instant. est de ', 
+     .                   ecrit_ins
+         ENDIF
+
+c Initialisation des sorties 
+c===========================
+
+#ifdef CPP_IOIPSL
+
+#ifdef histday
+#include "ini_histday.h"
+#endif
+
+#ifdef histmth
+#include "ini_histmth.h"
+#endif
+
+#ifdef histins
+#include "ini_histins.h"
+#endif
+
+#endif
+
+c
+c Initialiser les valeurs de u pour calculs tendances
+c (pour T, c'est fait dans phyetat0)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u(i,k)
+      ENDDO
+      ENDDO
+
+      ENDIF ! debut
+c====================================================================
+c======================================================================
+
+c   Creer un reservoir de surface infini 
+c
+      reservoir(:) = 2.
+
+c Mettre a zero des variables de sortie (pour securite)
+c
+      DO i = 1, klon
+         d_ps(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO k = 1, klev
+      DO i = 1, klon
+         d_qx(i,k,iq) = 0.0
+      ENDDO
+      ENDDO
+      ENDDO
+c
+c Ne pas affecter les valeurs entrees de u, v, h, et q
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k)  = t(i,k)
+         u_seri(i,k)  = u(i,k)
+         v_seri(i,k)  = v(i,k)
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         tr_seri(i,k,iq) = qx(i,k,iq)
+      ENDDO
+      ENDDO
+      ENDDO
+C
+      DO i = 1, klon
+          ztsol(i) = ftsol(i)
+      ENDDO
+C
+      IF (if_ebil.ge.1) THEN 
+        ztit='after dynamic'
+        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol+d_h_vcol_phy, d_qt, 0.
+     s      , fs_bound, fq_bound )
+      END IF 
+
+c====================================================================
+c Diagnostiquer la tendance dynamique
+c
+      IF (ancien_ok) THEN
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
+            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
+         ENDDO
+         ENDDO
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_dyn(i,1) = 0.0
+          do j=2,klev
+            flux_dyn(i,j) = flux_dyn(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_dyn(i,j-1)*(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+      ELSE
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = 0.0
+            d_t_dyn(i,k) = 0.0
+         ENDDO
+         ENDDO
+         ancien_ok = .TRUE.
+      ENDIF
+c====================================================================
+c
+c Calcule de vitesse verticale a partir de flux de masse verticale
+      DO k = 1, klev
+       DO i = 1, klon
+        omega(i,k) = RG*flxmw(i,k) / cell_area(i)
+       END DO
+      END DO
+
+c Ajouter le geopotentiel du sol:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         zphi(i,k) = pphi(i,k) + pphis(i)
+      ENDDO
+      ENDDO
+
+c     call WriteField_phy('physiq_pphi',pphi,klev)
+c     call WriteField_phy('physiq_pphis',pphis,1)
+
+c   calcul du geopotentiel aux niveaux intercouches
+c   ponderation des altitudes au niveau des couches en dp/p
+
+      DO l=1,klev
+         DO i=1,klon
+c           zzlay(i,l)=zphi(i,l)/RG
+c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
+            zzlay(i,l)=RG*RA*RA/(RG*RA-zphi(i,l))-RA
+         ENDDO
+      ENDDO
+      DO i=1,klon
+c        zzlev(i,1)=0.
+c CORRECTION 13/01/2011  
+c (correspond a la position de la surface en ce point vs RA)
+         zzlev(i,1)=pphis(i)/RG
+      ENDDO
+      DO l=2,klev
+         DO i=1,klon
+            z1=(pplay(i,l-1)+paprs(i,l))/(pplay(i,l-1)-paprs(i,l))
+            z2=(paprs(i,l)  +pplay(i,l))/(paprs(i,l)  -pplay(i,l))
+            zzlev(i,l)=(z1*zzlay(i,l-1)+z2*zzlay(i,l))/(z1+z2)
+         ENDDO
+      ENDDO
+      DO i=1,klon
+         zzlev(i,klev+1)=zzlay(i,klev)+(zzlay(i,klev)-zzlev(i,klev))
+      ENDDO
+
+! zonal averages needed
+      if (moyzon_ch.or.moyzon_mu) then
+
+c      zzlaybar(1,:)=(zphibar(1,:)+zphisbar(1))/RG
+c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
+       zzlaybar(1,:)=RG*RA*RA/(RG*RA-(zphibar(1,:)+zphisbar(1)))-RA
+       zzlevbar(1,1)=zphisbar(1)/RG
+       DO l=2,klev
+            z1=(zplaybar(1,l-1)+zplevbar(1,l))/
+     .            (zplevbar(1,l-1)-zplevbar(1,l))
+            z2=(zplevbar(1,l)  +zplaybar(1,l))/
+     .            (zplevbar(1,l)  -zplaybar(1,l))
+            zzlevbar(1,l)=(z1*zzlaybar(1,l-1)+z2*zzlaybar(1,l))/(z1+z2)
+       ENDDO
+       zzlevbar(1,klev+1)=zzlaybar(1,klev)+
+     .            (zzlaybar(1,klev)-zzlevbar(1,klev))
+
+       DO i=2,klon
+        if (latitude(i).ne.latitude(i-1)) then
+         DO l=1,klev
+c         zzlaybar(i,l)=(zphibar(i,l)+zphisbar(i))/RG
+c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
+          zzlaybar(i,l)=RG*RA*RA/(RG*RA-(zphibar(i,l)+zphisbar(i)))-RA
+         ENDDO
+         zzlevbar(i,1)=zphisbar(i)/RG
+         DO l=2,klev
+            z1=(zplaybar(i,l-1)+zplevbar(i,l))/
+     .            (zplevbar(i,l-1)-zplevbar(i,l))
+            z2=(zplevbar(i,l)  +zplaybar(i,l))/
+     .            (zplevbar(i,l)  -zplaybar(i,l))
+            zzlevbar(i,l)=(z1*zzlaybar(i,l-1)+z2*zzlaybar(i,l))/(z1+z2)
+         ENDDO
+         zzlevbar(i,klev+1)=zzlaybar(i,klev)+
+     .              (zzlaybar(i,klev)-zzlevbar(i,klev))
+        else
+         zzlaybar(i,:)=zzlaybar(i-1,:)
+         zzlevbar(i,:)=zzlevbar(i-1,:)
+        endif
+       ENDDO
+
+      endif  ! moyzon
+
+c     call WriteField_phy('physiq_zphi',zphi,klev)
+c     call WriteField_phy('physiq_zzlay',zzlay,klev)
+c     call WriteField_phy('physiq_zzlev',zzlev,klev+1)
+c- - - - - - - - - - - - - - - -
+c DIAGNOSTIQUE GRILLE VERTICALE
+c- - - - - - - - - - - - - - - -
+c     print*,"DIAGNOSTIQUE GRILLE VERTICALE"
+c     i=klon/2
+c     print*,"Niveau  Pression  Altitude    (lev puis lay)"
+c     do l=1,klev
+c      print*,l,paprs(i,l),zzlev(i,l)
+c      print*,l,pplay(i,l),zzlay(i,l)
+c     enddo
+c     print*,klev+1,paprs(i,klev+1),zzlev(i,klev+1)
+c     stop
+
+c====================================================================
+c
+c Verifier les temperatures
+c
+      CALL hgardfou(t_seri,ftsol,'debutphy')
+c====================================================================
+c
+c Incrementer le compteur de la physique
+c
+      itap   = itap + 1
+
+c====================================================================
+c
+c Epaisseurs couches
+
+      DO k = 1, klev
+      DO i = 1, klon
+         delp(i,k) = paprs(i,k)-paprs(i,k+1)
+      ENDDO
+      ENDDO
+
+c====================================================================
+c Orbite et eclairement
+c====================================================================
+
+c Pour TITAN:
+c  calcul de la longitude solaire
+          CALL solarlong(rjourvrai+gmtime,zls)
+          zlsdeg = zls*180./RPI      ! zls est en radians !!
+          print*,'Ls',zlsdeg
+
+      CALL orbite(zls,dist,pdecli) 
+      IF (debut) zlsm1=zls
+
+c dans zenang, Ls en degres ; dans mucorr, Ls en radians
+      call mucorr(klon,zls,latitude_deg,rmu0bar,fractbar)
+      IF (cycle_diurne) THEN
+        zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
+        CALL zenang(zlsdeg,gmtime,zdtime,latitude_deg,longitude_deg,
+     &              rmu0,fract)
+      ELSE
+        rmu0  = rmu0bar
+        fract = fractbar
+      ENDIF
+      
+c====================================================================
+c Appeler la diffusion verticale (programme de couche limite)
+c====================================================================
+
+c-------------------------------
+c TEST: on ne tient pas compte des calculs de clmain mais on force
+c l'equilibre radiatif du sol
+      if (1.eq.0) then
+              if (debut) then
+                print*,"ATTENTION, CLMAIN SHUNTEE..."
+              endif
+
+      DO i = 1, klon
+         sens(i) = 0.0e0 ! flux de chaleur sensible au sol
+         fder(i) = 0.0e0
+         dlw(i)  = 0.0e0
+      ENDDO
+
+c Incrementer la temperature du sol
+c
+      DO i = 1, klon
+         d_ts(i)  = dtime * radsol(i)/22000. !valeur calculee par GCM pour I=200
+         ftsol(i) = ftsol(i) + d_ts(i)
+         do j=1,nsoilmx
+           ftsoil(i,j)=ftsol(i)
+         enddo
+      ENDDO
+
+c-------------------------------
+      else
+c-------------------------------
+
+      fder = dlw
+
+c     print*,"radsol avant clmain=",radsol(klon/2)
+c     print*,"solsw avant clmain=",solsw(klon/2)
+c     print*,"sollw avant clmain=",sollw(klon/2)
+
+! ADAPTATION GCM POUR CP(T)
+
+      CALL clmain(dtime,itap,
+     e            t_seri,u_seri,v_seri,
+     e            rmu0, 
+     e            ftsol,
+     $            ftsoil,
+     $            paprs,pplay,ppk,radsol,falbe,
+     e            solsw, sollw, sollwdown, fder,
+     e            longitude_deg, latitude_deg, dx, dy,   
+     e            debut, lafin,
+     s            d_t_vdf,d_u_vdf,d_v_vdf,d_ts,
+     s            fluxt,fluxu,fluxv,cdragh,cdragm,
+     s            dsens,
+     s            ycoefh,yu1,yv1) 
+
+c     print*,"radsol apres clmain=",radsol(klon/2)
+c     print*,"solsw apres clmain=",solsw(klon/2)
+c     print*,"sollw apres clmain=",sollw(klon/2)
+
+CXXX Incrementation des flux
+      DO i = 1, klon
+         sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
+         fder(i) = dlw(i) + dsens(i) 
+      ENDDO
+CXXX
+
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
+         d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
+         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
+         d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
+         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
+         d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
+      ENDDO
+      ENDDO
+
+c     call WriteField_phy('physiq_dtvdf',d_t_vdf,klev)
+c     call WriteField_phy('physiq_duvdf',d_u_vdf,klev)
+c     call WriteField_phy('physiq_dvvdf',d_v_vdf,klev)
+
+C TRACEURS
+
+      d_tr_vdf = 0.
+      if (iflag_trac.eq.1) then
+         DO iq=1, nqmax
+             CALL cltrac(dtime,ycoefh,t_seri,
+     s               tr_seri(1,1,iq),source,
+     e               paprs, pplay,delp,
+     s               d_tr_vdf(1,1,iq))
+             tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
+             d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
+         ENDDO
+      endif
+
+      IF (if_ebil.ge.2) THEN 
+        ztit='after clmain'
+        CALL diagetpq(cell_area,ztit,ip_ebil,2,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+         call diagphy(cell_area,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+C
+c
+c Incrementer la temperature du sol
+c
+c     print*,'Tsol avant clmain:',ftsol(1)
+      DO i = 1, klon
+         ftsol(i) = ftsol(i) + d_ts(i)
+      ENDDO
+c     print*,'DTsol apres clmain:',d_ts(klon/2)
+c     print*,'Tsol apres clmain:',ftsol(1)
+
+c Calculer la derive du flux infrarouge
+c
+      DO i = 1, klon
+            dlw(i) = - 4.0*emis*RSIGMA*ftsol(i)**3 
+      ENDDO
+
+c-------------------------------
+      endif  ! fin du TEST
+
+c
+c Appeler l'ajustement sec
+c
+c===================================================================
+c Convection seche 
+c===================================================================
+c
+      d_t_ajs(:,:)=0.
+      d_u_ajs(:,:)=0.
+      d_v_ajs(:,:)=0.
+      d_tr_ajs(:,:,:)=0.
+c
+      IF(prt_level>9)WRITE(lunout,*)
+     .    'AVANT LA CONVECTION SECHE , iflag_ajs='
+     s   ,iflag_ajs
+
+      if(iflag_ajs.eq.0) then
+c  Rien
+c  ====
+         IF(prt_level>9)WRITE(lunout,*)'pas de convection'
+
+      else if(iflag_ajs.eq.1) then
+
+c  Ajustement sec
+c  ==============
+         IF(prt_level>9)WRITE(lunout,*)'ajsec'
+
+! ADAPTATION GCM POUR CP(T)
+         CALL ajsec(paprs, pplay, ppk, t_seri, u_seri, v_seri, nqmax,
+     .              tr_seri, d_t_ajs, d_u_ajs, d_v_ajs, d_tr_ajs)
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_ajs(i,1) = 0.0
+          do j=2,klev
+            flux_ajs(i,j) = flux_ajs(i,j-1)
+     .        + cpdet(t_seri(i,j-1))/RG*d_t_ajs(i,j-1)/dtime
+     .                                 *delp(i,j-1)
+          enddo
+         enddo
+         
+         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
+         d_t_ajs(:,:)= d_t_ajs(:,:)/dtime          ! K/s
+         u_seri(:,:) = u_seri(:,:) + d_u_ajs(:,:)
+         d_u_ajs(:,:)= d_u_ajs(:,:)/dtime          ! (m/s)/s
+         v_seri(:,:) = v_seri(:,:) + d_v_ajs(:,:)
+         d_v_ajs(:,:)= d_v_ajs(:,:)/dtime          ! (m/s)/s
+      if (iflag_trac.eq.1) then
+           tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
+           d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime  ! /s
+      endif
+
+c     call WriteField_phy('physiq_dtajs',d_t_ajs,klev)
+c     call WriteField_phy('physiq_duajs',d_u_ajs,klev)
+c     call WriteField_phy('physiq_dvajs',d_v_ajs,klev)
+
+      endif
+c
+      IF (if_ebil.ge.2) THEN 
+        ztit='after dry_adjust'
+        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+
+c====================================================================
+c   MICROPHYSIQUE ET CHIMIE
+c====================================================================
+
+      d_tr_mph(:,:,:)=0.
+      d_tr_kim(:,:,:)=0.
+      
+c on recupere tr_seri inchange, d_tr_micro, d_tr_chim, tous les trois sur nqmax
+c on recupere aussi qaer pour le mettre dans les sorties
+c  si microfi=1, sortie de qaer(1:nmicro)
+c  si nmicro != nqmax et si chimi, sortie de tr_seri(nmicro+1:nqmax) 
+
+c faire un test comme pour rayonnement, avec chimi en plus comme flag, 
+c pour voir si chimie appelee -> bouleen, qui passe dans phytrac.
+c faut aussi le pas de temps chimique: dtimechim, a passer..
+
+      appel_chim = 0
+      IF (MOD(itapchim,chimpas).EQ.0) THEN
+c             print*,'CHIMIE ', 
+c    $             ' (itapchim=',itapchim,'/chimpas=',chimpas,')'
+       appel_chim = 1
+       itapchim = 0
+      ENDIF
+      itapchim = itapchim + 1
+
+      if (iflag_trac.eq.1) then
+c        call WriteField_phy('physiq_qaer01',
+c    .                          qaer(:,:,1),klev)
+c        call WriteField_phy('physiq_qaer10',
+c    .                          qaer(:,:,10),klev)
+c        call WriteField_phy('physiq_tr_seri01',
+c    .                          tr_seri(:,:,1),klev)
+c        call WriteField_phy('physiq_tr_seri10',
+c    .                          tr_seri(:,:,10),klev)
+
+c         call begintime(tt0)
+c in phytrac call, mu0 and fract are only used in brume
+c so we need to pass either rmu0 ou rmu0bar depending on
+c moyzon_mu
+       if (moyzon_mu) then
+         call phytrac (debut,lafin,
+     .                 nqmax,nmicro,dtime,appel_chim,dtimechim,
+     .                 paprs,pplay,delp,t,rmu0bar,fractbar,pdecli,zls,
+     .                 yu1,yv1,zzlev,zzlay,ftsol,
+     .                 tr_seri,qaer,d_tr_mph,d_tr_kim,
+     .                 fclat,reservoir)
+       else
+         call phytrac (debut,lafin,
+     .                 nqmax,nmicro,dtime,appel_chim,dtimechim,
+     .                 paprs,pplay,delp,t,rmu0,fract,pdecli,zls,
+     .                 yu1,yv1,zzlev,zzlay,ftsol,
+     .                 tr_seri,qaer,d_tr_mph,d_tr_kim,
+     .                 fclat,reservoir)
+       endif
+
+c         call endtime(tt0,tt1)
+c         ttphytra=ttphytra+tt1
+
+c ----- ICI on ajuste radsol en tenant compte du flux de chaleur latente 
+c       d'evaporation du reservoir.
+c       NOTE : c'est pas tres elegant mais ca permet d'eviter d'aller
+c              toucher a clmain.
+        if (clouds.eq.1) then
+          radsol(:) = radsol(:)+fclat(:)    !test pas de flx de chaleur latente
+        endif
+
+        if (microfi.ge.1) then
+         tr_seri(:,:,1:nmicro) = tr_seri(:,:,1:nmicro)
+     .                        + d_tr_mph(:,:,1:nmicro)*dtime
+c        call WriteField_phy('physiq_d_tr_mph01',
+c    .                          d_tr_mph(:,:,1),klev)
+c        call WriteField_phy('physiq_d_tr_mph10',
+c    .                          d_tr_mph(:,:,10),klev)
+	endif
+c       PAS ELEGANT mais je n'ai pas trouve d'autres solutions :
+c       Il semblerait qu'il y ait un probleme lorsque les tendances de traceurs
+c       retourne des traceurs nuls et il y a parfois des valeurs negatives qui trainent.
+c       Pour ne diffuser le probleme, on force les valeurs negatives a ZERO.
+        DO iq=1,nmicro
+          DO i=1,klon
+            DO l=1,klev
+              if (tr_seri(i,l,iq).lt.0.) then
+                 tr_seri(i,l,iq) = 0.
+              endif
+            ENDDO
+          ENDDO
+        ENDDO
+
+c condensation:
+c       NE PAS OUBLIER LA CONDENSATION DES NUAGES !!!!
+        if ((clouds.eq.1.or.(chimi)).and.nqmax.gt.nmicro) then
+          tr_seri(:,:,nmicro+1:nqmax) = tr_seri(:,:,nmicro+1:nqmax)
+     .                         + d_tr_mph(:,:,nmicro+1:nqmax)*dtime
+        endif
+
+c chimie:
+        if ((chimi).and.(nqmax.gt.nmicro)) then
+         tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_kim(:,:,:)*dtime
+	endif
+
+      endif  !iflag_trac=1
+
+c       ch4=0.
+c       do l=1,llm
+c         ch4(1,l) = tr_seri(1,l,ich4)
+c         do j=2,jjm
+c           ig0=1+(j-2)*iim
+c           do i=1,iim
+c             ch4(j,l)= ch4(j,l)  + tr_seri(ig0+i,l,ich4)/iim
+c           enddo
+c         enddo
+c         ch4(jjm+1,l) = tr_seri(klon,l,ich4)
+c       enddo
+c       do j=1,jjm+1
+c         write(501,*) j,ch4(j,1)
+c       enddo
+c       do l=1,llm
+c         write(502,'(I3,49(ES24.17,1X))') l, 
+c     &   (ch4(j,l),j=1,jjm+1)
+c       enddo
+c       write(501,*) ""
+c       write(502,*) ""
+
+c------------------
+c test condensation
+c     do i=1,nqmax 
+c       if(tname(i).eq."HCN") then
+c          print*,"HCN="
+c          do k=1,klev
+c           print*,k,tr_seri(klon/2,k,i),d_tr_mph(klon/2,k,i)*dtime
+c    v      ,d_tr_kim(klon/2,k,i)*dtime
+c          enddo
+c          stop
+c       endif
+c     enddo
+c------------------
+
+c====================================================================
+c RAYONNEMENT
+c====================================================================
+
+      IF (MOD(itaprad,radpas).EQ.0) THEN
+c             print*,'RAYONNEMENT ', 
+c    $             ' (itaprad=',itaprad,'/radpas=',radpas,')'
+
+c ATTENTION, (klon/2) ne marche pas toujours............
+c     print*,"radsol avant radlwsw=",radsol(klon/2)
+c     print*,"solsw avant radlwsw=",solsw(klon/2)
+c     print*,"sollw avant radlwsw=",sollw(klon/2)
+c     print*,"avant radlwsw"
+
+c   ----------------
+c   Calcul du rayon moyen des gouttes et des fractions volumique pour le TR
+c  ----------------
+      IF (clouds.eq.1) THEN
+        DO i=1,klon
+          DO j=1,klev
+            rmcbar(i,j)=rmcbar(i,j)/MAX(REAL(ncount(i,j)),1.)
+            xfbar(i,j,:)=xfbar(i,j,:)/MAX(REAL(ncount(i,j)),1.)
+          ENDDO 
+        ENDDO
+      ENDIF
+     
+c      call begintime(tt0)
+      CALL radlwsw
+     e            (dist, rmu0, fract, zzlev,
+     e             paprs, pplay,ftsol, t_seri, nqmax, nmicro,
+     c             tr_seri, qaer)
+c     print*,"apres radlwsw"
+
+c      call endtime(tt0,tt1)
+c      ttrad=ttrad+tt1
+
+c     print*,"apres radlwsw"
+c     mise a zero du rayon moyen des gouttes et des fractions volumique 
+      IF (clouds.eq.1) THEN
+        rmcbar(:,:)  = 0.
+        xfbar(:,:,:) = 0.
+        ncount(:,:)  = 0
+      ENDIF
+
+      itaprad = 0
+      DO k = 1, klev
+       DO i = 1, klon
+         dtrad(i,k) = heat(i,k)-cool(i,k)     !K/s
+       ENDDO
+      ENDDO
+
+c     call WriteField_phy('physiq_heat',heat,klev)
+c     call WriteField_phy('physiq_cool',cool,klev)
+
+      ENDIF
+      itaprad = itaprad + 1
+c====================================================================
+c
+c Ajouter la tendance des rayonnements (tous les pas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + dtrad(i,k) * dtime
+      ENDDO
+      ENDDO
+ 
+      IF (if_ebil.ge.2) THEN 
+        ztit='after rad'
+        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+c
+
+c====================================================================
+c   Calcul  des gravity waves  FLOTT
+c====================================================================
+c
+      if (ok_orodr.or.ok_gw_nonoro) then
+c  CALCUL DE N2
+       do i=1,klon
+        do k=2,klev
+	  ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
+	  zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
+	enddo
+       enddo
+       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
+       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
+       do i=1,klon
+        do k=2,klev
+	  zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
+	  zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
+          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
+          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
+	enddo
+        zn2(i,1) = 1.e-12  ! securite
+       enddo
+
+      endif
+      
+c ----------------------------ORODRAG
+      IF (ok_orodr) THEN
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+c        IF ((zstd(i).gt.10.0)) THEN
+        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS!!!
+        CALL drag_noro(klon,klev,dtime,paprs,pplay,pphi,zn2,
+     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
+     e                   igwd,idx,itest,
+     e                   t_seri, u_seri, v_seri,
+     s                   zulow, zvlow, zustrdr, zvstrdr,
+     s                   d_t_oro, d_u_oro, d_v_oro)
+
+c       print*,"d_u_oro=",d_u_oro(klon/2,:)
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
+           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
+           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
+           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
+c    
+      ELSE
+         d_t_oro = 0.
+         d_u_oro = 0.
+         d_v_oro = 0.
+	 zustrdr = 0.
+	 zvstrdr = 0.
+c
+      ENDIF ! fin de test sur ok_orodr
+c
+c ----------------------------OROLIFT
+      IF (ok_orolf) THEN
+       print*,"ok_orolf NOT IMPLEMENTED !"
+       stop
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+        IF ((zpic(i)-zmea(i)).GT.100.) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS ET TITAN!!!
+c            CALL lift_noro(klon,klev,dtime,paprs,pplay,
+c     e                   latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval,
+c     e                   igwd,idx,itest,
+c     e                   t_seri, u_seri, v_seri,
+c     s                   zulow, zvlow, zustrli, zvstrli,
+c     s                   d_t_lif, d_u_lif, d_v_lif               )
+
+c
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
+           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
+           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
+           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
+c
+      ELSE
+         d_t_lif = 0.
+         d_u_lif = 0.
+         d_v_lif = 0.
+         zustrli = 0.
+         zvstrli = 0.
+c
+      ENDIF ! fin de test sur ok_orolf
+
+c ---------------------------- NON-ORO GRAVITY WAVES
+       IF(ok_gw_nonoro) then
+
+        abort_message="Option non developpee pour Titan"
+        call abort_gcm(modname,abort_message,1)
+c A FAIRE POUR TITAN
+c      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
+c     e               t_seri, u_seri, v_seri,
+c     o               zustrhi,zvstrhi,
+c     o               d_t_hin, d_u_hin, d_v_hin)
+
+c  ajout des tendances
+
+c         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
+c         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
+c         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
+c         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
+c         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
+c         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
+
+      ELSE
+         d_t_hin = 0.
+         d_u_hin = 0.
+         d_v_hin = 0.
+         zustrhi = 0.
+         zvstrhi = 0.
+
+      ENDIF ! fin de test sur ok_gw_nonoro
+
+c====================================================================
+c Transport de ballons 
+c====================================================================
+      if (ballons.eq.1) then
+         CALL ballon(30,pdtphys,rjourvrai,gmtime,
+     &               latitude_deg,longitude_deg,
+c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
+     C               t,pplay,u,v,zphi)   ! alt above planet average radius
+      endif !ballons
+
+c====================================================================
+c Bilan de mmt angulaire
+c====================================================================
+      if (bilansmc.eq.1) then
+CMODDEB FLOTT
+C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
+C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
+
+      DO i = 1, klon
+        zustrph(i)=0.
+        zvstrph(i)=0.
+        zustrcl(i)=0.
+        zvstrcl(i)=0.
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+      ENDDO
+      ENDDO
+
+      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
+     C               ra,rg,romega,
+     C               latitude_deg,longitude_deg,pphis,
+     C               zustrdr,zustrli,zustrcl,
+     C               zvstrdr,zvstrli,zvstrcl,
+     C               paprs,u,v)
+                     
+CCMODFIN FLOTT
+      endif !bilansmc
+
+c====================================================================
+c====================================================================
+c Calculer le transport de l'eau et de l'energie (diagnostique)
+c
+c  A REVOIR POUR VENUS ET TITAN...
+c
+c     CALL transp (paprs,ftsol,
+c    e                   t_seri, q_seri, u_seri, v_seri, zphi,
+c    s                   ve, vq, ue, uq)
+c
+c====================================================================
+c+jld ec_conser
+      DO k = 1, klev
+      DO i = 1, klon
+        d_t_ec(i,k)=0.5/cpdet(t_seri(i,k))
+     $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
+        t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
+        d_t_ec(i,k) = d_t_ec(i,k)/dtime
+       END DO 
+      END DO 
+         do i=1,klon
+          flux_ec(i,1) = 0.0
+          do j=2,klev
+            flux_ec(i,j) = flux_ec(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_ec(i,j-1)*delp(i,j-1)
+          enddo
+         enddo
+         
+c-jld ec_conser
+c====================================================================
+      IF (if_ebil.ge.1) THEN 
+        ztit='after physic'
+        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+C
+      d_h_vcol_phy=d_h_vcol
+C
+      END IF 
+C
+c=======================================================================
+c   SORTIES
+c=======================================================================
+
+c Convertir les incrementations en tendances
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
+         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
+         d_t(i,k) = ( t_seri(i,k) - t(i,k) ) / dtime
+      ENDDO
+      ENDDO
+c
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         d_qx(i,k,iq) = ( tr_seri(i,k,iq) - qx(i,k,iq) ) / dtime
+      ENDDO
+      ENDDO
+      ENDDO
+      
+c------------------------
+c Calcul moment cinetique
+c------------------------
+c TEST...
+c     mangtot = 0.0
+c     DO k = 1, klev
+c     DO i = 1, klon
+c       mang(i,k) = RA*cos(latitude(i))
+c    .     *(u_seri(i,k)+RA*cos(latitude(i))*ROMEGA)
+c    .     *cell_area(i)*(paprs(i,k)-paprs(i,k+1))/RG
+c       mangtot=mangtot+mang(i,k)
+c     ENDDO
+c     ENDDO
+c     print*,"Moment cinetique total = ",mangtot
+c
+c------------------------
+c
+c Sauvegarder les valeurs de t et u a la fin de la physique:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u_seri(i,k)
+         t_ancien(i,k) = t_seri(i,k)
+      ENDDO
+      ENDDO
+c
+c=============================================================
+c   Ecriture des sorties
+c=============================================================
+      
+#ifdef CPP_IOIPSL
+
+#ifdef histday
+#include "write_histday.h"
+#endif
+
+#ifdef histmth
+#include "write_histmth.h"
+#endif
+
+#ifdef histins
+#include "write_histins.h"
+#endif
+
+#endif
+
+c====================================================================
+c Si c'est la fin, il faut conserver l'etat de redemarrage
+c====================================================================
+c
+      IF (lafin) THEN
+         itau_phy = itau_phy + itap
+         lsinit   = zlsdeg
+         CALL phyredem ("restartphy.nc")
+     
+c--------------FLOTT
+CMODEB LOTT
+C  FERMETURE DU FICHIER FORMATTE CONTENANT LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      if (bilansmc.eq.1) then
+        write(*,*)'Fermeture de aaam_bud.out (FL Vous parle)'
+        close(27)                                     
+        close(28)                                     
+      endif !bilansmc
+CMODFIN
+c-------------
+c--------------SLEBONNOIS
+C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+        write(*,*)'Fermeture des ballons*.out'
+        close(30)                                     
+        close(31)                                     
+        close(32)                                     
+        close(33)                                     
+        close(34)                                     
+      endif !ballons
+c-------------
+      ENDIF
+      
+      END SUBROUTINE physiq
+
+      END MODULE physiq_mod
+
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F	(revision 1548)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F	(revision 1549)
@@ -14,4 +14,5 @@
       USE iniphysiq_mod, ONLY: iniphysiq
       USE mod_const_mpi, ONLY: comm_lmdz
+      USE physiq_mod, ONLY: physiq
       IMPLICIT NONE
 
@@ -68,5 +69,5 @@
       REAL du(llm),dv(llm),dtemp(llm)
       REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
-      REAL dpsurf    
+      REAL dpsurf(1)    
       REAL,allocatable :: dq(:,:)
 
@@ -449,5 +450,5 @@
 c       ----------------------------------------------------------
 
-           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           psurf=psurf+dtphys*dpsurf(1)   ! evolution de la pression de surface
            DO ilevel=1,nlevel
              plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
Index: /trunk/LMDZ.VENUS/libf/phyvenus/gr_fi_ecrit.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/gr_fi_ecrit.F90	(revision 1549)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/gr_fi_ecrit.F90	(revision 1549)
@@ -0,0 +1,24 @@
+SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
+  IMPLICIT none
+  !
+  ! Tranformer une variable de la grille physique a
+  ! la grille d'ecriture
+  !
+  ! WARNING: This only works on the full global grid
+  !          (ie for GCM in serial mode)
+  INTEGER nfield,nlon,iim,jjmp1, jjm
+  REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
+  !
+  INTEGER i, n, ig
+  !
+  jjm = jjmp1 - 1
+  DO n = 1, nfield
+     DO i=1,iim
+        ecrit(i,n) = fi(1,n)
+        ecrit(i+jjm*iim,n) = fi(nlon,n)
+     ENDDO
+     DO ig = 1, nlon - 2
+        ecrit(iim+ig,n) = fi(1+ig,n)
+     ENDDO
+  ENDDO
+END SUBROUTINE gr_fi_ecrit
Index: unk/LMDZ.VENUS/libf/phyvenus/physiq.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/physiq.F	(revision 1548)
+++ 	(revision )
@@ -1,1805 +1,0 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/physiq.F,v 1.8 2005/02/24 09:58:18 fairhead Exp $
-!
-c
-      SUBROUTINE physiq (nlon,nlev,nqmax,
-     .            debut,lafin,rjourvrai,gmtime,pdtphys,
-     .            paprs,pplay,ppk,pphi,pphis,presnivs,
-     .            u,v,t,qx,
-     .            flxmw,
-     .            d_u, d_v, d_t, d_qx, d_ps)
-
-c======================================================================
-c
-c Modifications pour la physique de Venus
-c     S. Lebonnois (LMD/CNRS) Septembre 2005
-c
-c ---------------------------------------------------------------------
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c
-c Objet: Moniteur general de la physique du modele
-cAA      Modifications quant aux traceurs :
-cAA                  -  uniformisation des parametrisations ds phytrac
-cAA                  -  stockage des moyennes des champs necessaires
-cAA                     en mode traceur off-line 
-c    modif   ( P. Le Van ,  12/10/98 )
-c
-c  Arguments:
-c
-c nlon----input-I-nombre de points horizontaux
-c nlev----input-I-nombre de couches verticales
-c nqmax---input-I-nombre de traceurs
-c debut---input-L-variable logique indiquant le premier passage
-c lafin---input-L-variable logique indiquant le dernier passage
-c rjour---input-R-numero du jour de l'experience
-c gmtime--input-R-fraction de la journee (0 a 1)
-c pdtphys-input-R-pas d'integration pour la physique (seconde)
-c paprs---input-R-pression pour chaque inter-couche (en Pa)
-c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
-c ppk  ---input-R-fonction d'Exner au milieu de couche
-c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
-c pphis---input-R-geopotentiel du sol
-c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
-c u-------input-R-vitesse dans la direction X (de O a E) en m/s
-c v-------input-R-vitesse Y (de S a N) en m/s
-c t-------input-R-temperature (K)
-c qx------input-R-mass mixing ratio traceurs (kg/kg) 
-c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
-c flxmw---input-R-flux de masse vertical en kg/s
-c
-c d_u-----output-R-tendance physique de "u" (m/s/s)
-c d_v-----output-R-tendance physique de "v" (m/s/s)
-c d_t-----output-R-tendance physique de "t" (K/s)
-c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
-c d_ps----output-R-tendance physique de la pression au sol
-c======================================================================
-      USE ioipsl
-!      USE histcom ! not needed; histcom is included in ioipsl
-      USE infotrac
-      use dimphy
-      USE geometry_mod,only: longitude, latitude, ! in radians
-     &                       longitude_deg,latitude_deg, ! in degrees
-     &                       cell_area,dx,dy
-      USE mod_phys_lmdz_para, only : is_parallel,jj_nb
-      USE phys_state_var_mod ! Variables sauvegardees de la physique
-      USE write_field_phy
-      USE iophy
-      USE cpdet_mod, only: cpdet, t2tpot
-      USE chemparam_mod
-      USE conc
-      USE compo_hedin83_mod2
-      use moyzon_mod, only: tmoy
-!      use ieee_arithmetic
-      use time_phylmdz_mod, only: annee_ref, day_ref, itau_phy
-      use mod_grid_phy_lmdz, only: nbp_lon
-      use logic_mod, only: iflag_trac
-      IMPLICIT none
-c======================================================================
-c   CLEFS CPP POUR LES IO
-c   =====================
-c#define histhf
-#define histday
-#define histmth
-#define histins
-c======================================================================
-#include "dimsoil.h"
-#include "clesphys.h"
-#include "iniprint.h"
-#include "timerad.h" 
-#include "tabcontrol.h"
-#include "nirdata.h"
-#include "hedin.h"
-c======================================================================
-      LOGICAL ok_journe ! sortir le fichier journalier
-      save ok_journe
-c      PARAMETER (ok_journe=.true.)
-c
-      LOGICAL ok_mensuel ! sortir le fichier mensuel
-      save ok_mensuel
-c      PARAMETER (ok_mensuel=.true.)
-c
-      LOGICAL ok_instan ! sortir le fichier instantane
-      save ok_instan
-c      PARAMETER (ok_instan=.true.)
-c
-c======================================================================
-c
-c Variables argument:
-c
-      INTEGER nlon
-      INTEGER nlev
-      INTEGER nqmax
-      REAL rjourvrai
-      REAL gmtime
-      REAL pdtphys
-      LOGICAL debut, lafin
-      REAL paprs(klon,klev+1)
-      REAL pplay(klon,klev)
-      REAL pphi(klon,klev)
-      REAL pphis(klon)
-      REAL presnivs(klev)
-
-! ADAPTATION GCM POUR CP(T)
-      REAL ppk(klon,klev)
-
-      REAL u(klon,klev)
-      REAL v(klon,klev)
-      REAL t(klon,klev)
-      REAL qx(klon,klev,nqmax)
-
-      REAL d_u_dyn(klon,klev)
-      REAL d_t_dyn(klon,klev)
-
-      REAL flxmw(klon,klev)
-
-      REAL d_u(klon,klev)
-      REAL d_v(klon,klev)
-      REAL d_t(klon,klev)
-      REAL d_qx(klon,klev,nqmax)
-      REAL d_ps(klon)
-
-      logical ok_hf
-      real ecrit_hf
-      integer nid_hf
-      save ok_hf, ecrit_hf, nid_hf
-
-#ifdef histhf
-      data ok_hf,ecrit_hf/.true.,0.25/
-#else
-      data ok_hf/.false./
-#endif
-
-c Variables propres a la physique
-c
-      INTEGER,save :: itap        ! compteur pour la physique
-      REAL delp(klon,klev)        ! epaisseur d'une couche
-      REAL omega(klon,klev)       ! vitesse verticale en Pa/s
-
-      
-      INTEGER igwd,idx(klon),itest(klon)
-c
-c  Diagnostiques 2D de drag_noro, lift_noro et gw_nonoro
-
-      REAL zulow(klon),zvlow(klon)
-      REAL zustrdr(klon), zvstrdr(klon)
-      REAL zustrli(klon), zvstrli(klon)
-      REAL zustrhi(klon), zvstrhi(klon)
-
-c Pour calcul GW drag oro et nonoro: CALCUL de N2:
-      real zdzlev(klon,klev)
-      real ztlev(klon,klev),zpklev(klon,klev)
-      real ztetalay(klon,klev),ztetalev(klon,klev)
-      real zdtetalev(klon,klev)
-      real zn2(klon,klev) ! BV^2 at plev
-
-c Pour les bilans de moment angulaire, 
-      integer bilansmc
-c Pour le transport de ballons
-      integer ballons
-c j'ai aussi besoin
-c du stress de couche limite a la surface:
-
-      REAL zustrcl(klon),zvstrcl(klon) 
-
-c et du stress total c de la physique:
-
-      REAL zustrph(klon),zvstrph(klon) 
-
-c Variables locales:
-c
-      REAL cdragh(klon) ! drag coefficient pour T and Q
-      REAL cdragm(klon) ! drag coefficient pour vent
-c
-cAA  Pour  TRACEURS
-cAA
-      REAL,save,allocatable :: source(:,:)
-      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
-      REAL yu1(klon)            ! vents dans la premiere couche U
-      REAL yv1(klon)            ! vents dans la premiere couche V
-
-      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
-      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
-      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
-      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
-      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
-c
-      REAL Fsedim(klon,klev+1)  ! Flux de sedimentation (kg.m-2)
-
-c======================================================================
-c
-c Declaration des procedures appelees
-c
-      EXTERNAL ajsec     ! ajustement sec
-      EXTERNAL clmain    ! couche limite 
-      EXTERNAL hgardfou  ! verifier les temperatures
-c     EXTERNAL orbite    ! calculer l'orbite 
-      EXTERNAL phyetat0  ! lire l'etat initial de la physique
-      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
-      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
-      EXTERNAL suphec    ! initialiser certaines constantes
-      EXTERNAL transp    ! transport total de l'eau et de l'energie
-      EXTERNAL abort_gcm
-      EXTERNAL printflag
-      EXTERNAL zenang
-      EXTERNAL diagetpq
-      EXTERNAL conf_phys
-      EXTERNAL diagphy
-      EXTERNAL mucorr
-      EXTERNAL nirco2abs
-      EXTERNAL nir_leedat
-      EXTERNAL nltecool
-      EXTERNAL nlte_tcool
-      EXTERNAL nlte_setup
-      EXTERNAL blendrad
-      EXTERNAL nlthermeq
-      EXTERNAL euvheat
-      EXTERNAL param_read
-      EXTERNAL param_read_e107
-      EXTERNAL conduction
-      EXTERNAL molvis
-      EXTERNAL moldiff_red
-
-c
-c Variables locales
-c
-CXXX PB 
-      REAL fluxt(klon,klev)   ! flux turbulent de chaleur
-      REAL fluxu(klon,klev)   ! flux turbulent de vitesse u
-      REAL fluxv(klon,klev)   ! flux turbulent de vitesse v
-c
-      REAL flux_dyn(klon,klev)  ! flux de chaleur produit par la dynamique
-      REAL flux_ajs(klon,klev)  ! flux de chaleur ajustement sec
-      REAL flux_ec(klon,klev)   ! flux de chaleur Ec
-c
-      REAL tmpout(klon,klev)  ! K s-1 
-
-      INTEGER itaprad
-      SAVE itaprad
-c
-      REAL dist, rmu0(klon), fract(klon)
-      REAL zdtime, zlongi
-c
-      INTEGER i, k, iq, ig, j, ll, ilon, ilat, ilev
-c
-      REAL zphi(klon,klev)
-      REAL zzlev(klon,klev+1),zzlay(klon,klev),z1,z2
-      real tsurf(klon)
-
-c va avec nlte_tcool
-      INTEGER ierr_nlte
-      REAL    varerr
-
-c Variables du changement
-c
-c ajs: ajustement sec
-c vdf: couche limite (Vertical DiFfusion)
-      REAL d_t_ajs(klon,klev), d_tr_ajs(klon,klev,nqmax)
-      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
-c
-      REAL d_ts(klon)
-c
-      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
-      REAL d_t_vdf(klon,klev), d_tr_vdf(klon,klev,nqmax)
-c
-CMOD LOTT: Tendances Orography Sous-maille
-      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
-      REAL d_t_oro(klon,klev)
-      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
-      REAL d_t_lif(klon,klev)
-C          Tendances Ondes de G non oro (runs strato).
-      REAL d_u_hin(klon,klev), d_v_hin(klon,klev)
-      REAL d_t_hin(klon,klev)
-
-c Tendencies due to radiative scheme   [K/s]
-c     d_t_rad,dtsw,dtlw,d_t_nirco2,d_t_nlte,d_t_euv
-c are not computed at each physical timestep
-c therefore, they are defined and saved in phys_state_var_mod
-
-c Tendencies due to molecular viscosity and conduction
-      real d_t_conduc(klon,klev)     ! [K/s]
-      real d_u_molvis(klon,klev)     ! (m/s) /s
-      real d_v_molvis(klon,klev)     ! (m/s) /s
-
-c Tendencies due to molecular diffusion
-      real d_q_moldif(klon,klev,nqmax)
-
-c
-c Variables liees a l'ecriture de la bande histoire physique
-c
-      INTEGER ecrit_mth
-      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
-c
-      INTEGER ecrit_day
-      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
-c
-      INTEGER ecrit_ins
-      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
-c
-      integer itau_w   ! pas de temps ecriture = itap + itau_phy
-
-c Variables locales pour effectuer les appels en serie
-c
-      REAL t_seri(klon,klev)
-      REAL u_seri(klon,klev), v_seri(klon,klev)
-c
-      REAL :: tr_seri(klon,klev,nqmax)
-      REAL :: d_tr(klon,klev,nqmax)
-
-c Champ de modification de la temperature par rapport a VIRAII
-      REAL delta_temp(klon,klev)
-c      SAVE delta_temp
-      REAL mat_dtemp(33,50)
-      SAVE mat_dtemp
-
-c Variables tendance sedimentation
-
-      REAL :: d_tr_sed(klon,klev,2)
-      REAL :: d_tr_ssed(klon)
-c
-c pour ioipsl
-      INTEGER nid_day, nid_mth, nid_ins
-      SAVE nid_day, nid_mth, nid_ins
-      INTEGER nhori, nvert, idayref
-      REAL zsto, zout, zsto1, zsto2, zero
-      parameter (zero=0.0e0)
-      real zjulian
-      save zjulian
-
-      CHARACTER*2  str2
-      character*20 modname
-      character*80 abort_message
-      logical ok_sync
-
-      character*30 nom_fichier
-      character*10 varname
-      character*40 vartitle
-      character*20 varunits
-C     Variables liees au bilan d'energie et d'enthalpi
-      REAL ztsol(klon)
-      REAL      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
-     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
-      SAVE      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
-     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
-      REAL      d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
-      REAL      d_h_vcol_phy
-      REAL      fs_bound, fq_bound
-      SAVE      d_h_vcol_phy
-      REAL      zero_v(klon),zero_v2(klon,klev)
-      CHARACTER*15 ztit
-      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
-      SAVE      ip_ebil
-      DATA      ip_ebil/2/
-      INTEGER   if_ebil ! level for energy conserv. dignostics
-      SAVE      if_ebil
-c+jld ec_conser
-      REAL d_t_ec(klon,klev)    ! tendance du a la conversion Ec -> E thermique
-c-jld ec_conser
-
-c TEST VENUS...
-      REAL mang(klon,klev)    ! moment cinetique
-      REAL mangtot            ! moment cinetique total
-
-c Declaration des constantes et des fonctions thermodynamiques
-c
-#include "YOMCST.h"
-
-c======================================================================
-c INITIALISATIONS
-c================
-
-      modname = 'physiq'
-      ok_sync=.TRUE.
-
-      bilansmc = 0
-      ballons  = 0
-! NE FONCTIONNENT PAS ENCORE EN PARALLELE !!!
-      if (is_parallel) then
-        bilansmc = 0
-        ballons  = 0
-      endif
-
-      IF (if_ebil.ge.1) THEN
-        DO i=1,klon
-          zero_v(i)=0.
-        END DO 
-        DO i=1,klon
-         DO j=1,klev
-          zero_v2(i,j)=0.
-         END DO 
-        END DO 
-      END IF 
-      
-c PREMIER APPEL SEULEMENT
-c========================
-      IF (debut) THEN
-         allocate(source(klon,nqmax))
-
-         CALL suphec ! initialiser constantes et parametres phys.
-
-         IF (if_ebil.ge.1) d_h_vcol_phy=0.
-c
-c appel a la lecture du physiq.def 
-c
-         call conf_phys(ok_journe, ok_mensuel,
-     .                  ok_instan,
-     .                  if_ebil)
-
-         call phys_state_var_init
-c
-c Initialising Hedin model for upper atm 
-c   (to be revised when coupled to chemistry) :
-         call conc_init
-c
-c Initialiser les compteurs:
-c
-         itap    = 0
-         itaprad = 0
-c         
-c Lecture startphy.nc :
-c
-         CALL phyetat0 ("startphy.nc")
-
-c dtime est defini dans tabcontrol.h et lu dans startphy
-c pdtphys est calcule a partir des nouvelles conditions:
-c Reinitialisation du pas de temps physique quand changement
-         IF (ABS(dtime-pdtphys).GT.0.001) THEN
-            WRITE(lunout,*) 'Pas physique a change',dtime,
-     .                        pdtphys
-c           abort_message='Pas physique n est pas correct '
-c           call abort_gcm(modname,abort_message,1)
-c----------------
-c pour initialiser convenablement le time_counter, il faut tenir compte
-c du changement de dtime en changeant itau_phy (point de depart)
-            itau_phy = NINT(itau_phy*dtime/pdtphys)
-c----------------
-            dtime=pdtphys
-         ENDIF
-
-         radpas = NINT( RDAY/pdtphys/nbapp_rad)
-
-         CALL printflag( ok_journe,ok_instan )
-c
-c---------
-c FLOTT
-       IF (ok_orodr) THEN
-         DO i=1,klon
-         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
-         ENDDO
-         CALL SUGWD(klon,klev,paprs,pplay)
-         DO i=1,klon
-         zuthe(i)=0.
-         zvthe(i)=0.
-         if(zstd(i).gt.10.)then
-           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
-           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
-         endif
-         ENDDO
-       ENDIF
-
-      if (bilansmc.eq.1) then
-C  OUVERTURE D'UN FICHIER FORMATTE POUR STOCKER LES COMPOSANTES
-C  DU BILAN DE MOMENT ANGULAIRE.
-      open(27,file='aaam_bud.out',form='formatted')
-      open(28,file='fields_2d.out',form='formatted')
-      write(*,*)'Ouverture de aaam_bud.out (FL Vous parle)'
-      write(*,*)'Ouverture de fields_2d.out (FL Vous parle)'
-      endif !bilansmc
-
-c--------------SLEBONNOIS
-C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
-C  DES BALLONS
-      if (ballons.eq.1) then
-      open(30,file='ballons-lat.out',form='formatted')
-      open(31,file='ballons-lon.out',form='formatted')
-      open(32,file='ballons-u.out',form='formatted')
-      open(33,file='ballons-v.out',form='formatted')
-      open(34,file='ballons-alt.out',form='formatted')
-      write(*,*)'Ouverture des ballons*.out'
-      endif !ballons
-c-------------
-
-c---------
-C TRACEURS
-C source dans couche limite
-         source(:,:) = 0.0 ! pas de source, pour l'instant
-c---------
-
-c---------
-c INITIALIZE THERMOSPHERIC PARAMETERS
-c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-         if (callthermos) then
-            if(solvarmod.eq.0) call param_read
-            if(solvarmod.eq.1) call param_read_e107 
-         endif
-
-c Initialisation (recomputed in concentration2)
-       do ig=1,klon
-         do j=1,klev
-            rnew(ig,j)=R
-            cpnew(ig,j)=cpdet(tmoy(j))
-            mmean(ig,j)=RMD
-            akknew(ig,j)=1.e-4
-          enddo
-c        stop
-
-        enddo  
-     
-      IF(callthermos.or.callnlte.or.callnirco2) THEN  
-         call compo_hedin83_init2
-      ENDIF
-      if (callnlte.and.nltemodel.eq.2) call nlte_setup
-      if (callnirco2.and.nircorr.eq.1) call nir_leedat         
-c---------
-      
-c
-c Verifications:
-c
-         IF (nlon .NE. klon) THEN
-            WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, 
-     .                      klon
-            abort_message='nlon et klon ne sont pas coherents'
-            call abort_gcm(modname,abort_message,1)
-         ENDIF
-         IF (nlev .NE. klev) THEN
-            WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev,
-     .                       klev
-            abort_message='nlev et klev ne sont pas coherents'
-            call abort_gcm(modname,abort_message,1)
-         ENDIF
-c
-         IF (dtime*REAL(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
-     $    THEN 
-           WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
-           WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
-           abort_message='Nbre d appels au rayonnement insuffisant'
-           call abort_gcm(modname,abort_message,1)
-         ENDIF
-c
-         WRITE(lunout,*)"Clef pour la convection seche, iflag_ajs=",
-     .                   iflag_ajs
-c
-         ecrit_mth = NINT(RDAY/dtime*ecriphy)  ! tous les ecritphy jours
-         IF (ok_mensuel) THEN
-         WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 
-     .                   ecrit_mth
-         ENDIF
-
-         ecrit_day = NINT(RDAY/dtime *1.0)  ! tous les jours
-         IF (ok_journe) THEN
-         WRITE(lunout,*)'La frequence de sortie journaliere est de ',
-     .                   ecrit_day
-         ENDIF
-
-         ecrit_ins = NINT(RDAY/dtime*ecriphy)  ! Fraction de jour reglable
-         IF (ok_instan) THEN
-         WRITE(lunout,*)'La frequence de sortie instant. est de ', 
-     .                   ecrit_ins
-         ENDIF
-
-c Initialisation des sorties 
-c===========================
-
-#ifdef CPP_IOIPSL
-
-#ifdef histhf
-#include "ini_histhf.h"
-#endif
-
-#ifdef histday
-#include "ini_histday.h"
-#endif
-
-#ifdef histmth
-#include "ini_histmth.h"
-#endif
-
-#ifdef histins
-#include "ini_histins.h"
-#endif
-
-#endif
-
-c
-c Initialiser les valeurs de u pour calculs tendances
-c (pour T, c'est fait dans phyetat0)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         u_ancien(i,k) = u(i,k)
-      ENDDO
-      ENDDO
-
-c---------
-c       Ecriture fichier initialisation
-c       PRINT*,'Ecriture Initial_State.csv'
-c       OPEN(88,file='Trac_Point.csv',
-c     & form='formatted')
-c---------
-     
-c---------
-c       Initialisation des parametres des nuages
-c===============================================
-     
-      if ((nlon .EQ. 1) .AND. ok_cloud) then
-        PRINT*,'Open profile_cloud_parameters.csv'
-        OPEN(66,file='profile_cloud_parameters.csv',
-     &   form='formatted')
-      endif
-
-      if ((nlon .EQ. 1) .AND. ok_sedim) then
-        PRINT*,'Open profile_cloud_sedim.csv'
-        OPEN(77,file='profile_cloud_sedim.csv',
-     &   form='formatted')
-      endif
-           
-      if ((nlon .GT. 1) .AND. (ok_chem.OR.ok_cloud)) then
-c !!! DONC 3D !!!
-        CALL chemparam_ini() 
-      endif
-         
-      if ((nlon .GT. 1) .AND. ok_cloud) then
-c !!! DONC 3D !!!
-        CALL cloud_ini(nlon,nlev)
-      endif
-
-c======================================================================
-c      Lecture du fichier DeltaT
-c======================================================================
-
-c     ATTENTION tout ce qui suit est pour un 48*32*50
-
-      if (ok_deltatemp) then
-
-      print*,'lecture de VenusDeltaT.txt '
-      open(99, form = 'formatted', status = 'old', file = 
-     &     'VenusDeltaT.dat')
-      print*,'Ouverture de VenusDeltaT.txt '
-
-      DO ilev = 1, klev
-         read(99,'(33(1x,e13.6))') (mat_dtemp(ilat,ilev),ilat=1,33)
-         print*,'lecture de VenusDeltaT.txt ligne:',ilev
-      ENDDO
-      
-      close(99)
-      print*,'FIN lecture de VenusDeltaT.txt ok.'
-
-      DO k = 1, klev
-      DO i = 1, klon      
-         ilat=(latitude_deg(i)/5.625) + 17.
-         delta_temp(i,k)=mat_dtemp(INT(ilat),k)
-      ENDDO
-      ENDDO
-      
-      endif
-        
-      ENDIF ! debut
-c======================================================================
-c======================================================================
-
-c Mettre a zero des variables de sortie (pour securite)
-c
-      DO i = 1, klon
-         d_ps(i) = 0.0
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-         d_t(i,k) = 0.0
-         d_u(i,k) = 0.0
-         d_v(i,k) = 0.0
-      ENDDO
-      ENDDO
-      DO iq = 1, nqmax
-      DO k = 1, klev
-      DO i = 1, klon
-         d_qx(i,k,iq) = 0.0
-      ENDDO
-      ENDDO
-      ENDDO
-c
-c Ne pas affecter les valeurs entrees de u, v, h, et q
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k)  = t(i,k)
-         u_seri(i,k)  = u(i,k)
-         v_seri(i,k)  = v(i,k)
-      ENDDO
-      ENDDO
-      DO iq = 1, nqmax
-      DO  k = 1, klev
-      DO  i = 1, klon
-         tr_seri(i,k,iq) = qx(i,k,iq)
-      ENDDO
-      ENDDO
-      ENDDO
-C
-      DO i = 1, klon
-          ztsol(i) = ftsol(i)
-      ENDDO
-C
-      IF (if_ebil.ge.1) THEN 
-        ztit='after dynamic'
-        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-C     Comme les tendances de la physique sont ajoute dans la dynamique,
-C     on devrait avoir que la variation d'entalpie par la dynamique
-C     est egale a la variation de la physique au pas de temps precedent.
-C     Donc la somme de ces 2 variations devrait etre nulle.
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , zero_v, zero_v, zero_v, zero_v, zero_v
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol+d_h_vcol_phy, d_qt, 0.
-     s      , fs_bound, fq_bound )
-      END IF 
-
-c====================================================================
-c Diagnostiquer la tendance dynamique
-c
-      IF (ancien_ok) THEN
-         DO k = 1, klev
-         DO i = 1, klon
-            d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
-            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
-         ENDDO
-         ENDDO
-
-! ADAPTATION GCM POUR CP(T)
-         do i=1,klon
-          flux_dyn(i,1) = 0.0
-          do j=2,klev
-            flux_dyn(i,j) = flux_dyn(i,j-1)
-     . +cpdet(t_seri(i,j-1))/RG*d_t_dyn(i,j-1)*(paprs(i,j-1)-paprs(i,j))
-          enddo
-         enddo
-         
-      ELSE
-         DO k = 1, klev
-         DO i = 1, klon
-            d_u_dyn(i,k) = 0.0
-            d_t_dyn(i,k) = 0.0
-         ENDDO
-         ENDDO
-         ancien_ok = .TRUE.
-      ENDIF
-c====================================================================
-
-c Calcule de vitesse verticale a partir de flux de masse verticale
-      DO k = 1, klev
-       DO i = 1, klon
-        omega(i,k) = RG*flxmw(i,k) / cell_area(i)
-       END DO
-      END DO
-
-c
-c Ajouter le geopotentiel du sol:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         zphi(i,k) = pphi(i,k) + pphis(i)
-      ENDDO
-      ENDDO
-
-c   calcul du geopotentiel aux niveaux intercouches
-c   ponderation des altitudes au niveau des couches en dp/p
-
-      DO k=1,klev
-         DO i=1,klon
-            zzlay(i,k)=zphi(i,k)/RG        ! [m]
-         ENDDO
-      ENDDO
-      DO i=1,klon
-         zzlev(i,1)=pphis(i)/RG            ! [m]
-      ENDDO
-      DO k=2,klev
-         DO i=1,klon
-            z1=(pplay(i,k-1)+paprs(i,k))/(pplay(i,k-1)-paprs(i,k))
-            z2=(paprs(i,k)  +pplay(i,k))/(paprs(i,k)  -pplay(i,k))
-            zzlev(i,k)=(z1*zzlay(i,k-1)+z2*zzlay(i,k))/(z1+z2)
-         ENDDO
-      ENDDO
-      DO i=1,klon
-         zzlev(i,klev+1)=zzlay(i,klev)+(zzlay(i,klev)-zzlev(i,klev))
-      ENDDO
-
-c====================================================================
-c
-c Verifier les temperatures
-c
-      CALL hgardfou(t_seri,ftsol,'debutphy')
-c====================================================================
-c
-c Incrementer le compteur de la physique
-c
-      itap   = itap + 1
-
-c====================================================================
-c Orbite et eclairement
-c====================================================================
-
-c Pour VENUS, on fixe l'obliquite a 0 et l'eccentricite a 0.
-c donc pas de variations de Ls, ni de dist.
-c La seule chose qui compte, c'est la rotation de la planete devant
-c le Soleil...
-      
-      zlongi = 0.0
-      dist   = 0.72  ! en UA
-
-c Si on veut remettre l'obliquite a 3 degres et/ou l'eccentricite 
-c a sa valeur, et prendre en compte leur evolution, 
-c il faudra refaire un orbite.F...
-c     CALL orbite(zlongi,dist)
-
-      IF (cycle_diurne) THEN
-        zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
-        CALL zenang(zlongi,gmtime,zdtime,latitude_deg,longitude_deg,
-     &              rmu0,fract)
-      ELSE
-        call mucorr(klon,zlongi,latitude_deg,rmu0,fract)
-      ENDIF
-      
-c====================================================================
-c   Calcul  des tendances traceurs
-c====================================================================
-
-      if (iflag_trac.eq.1) then
-
-       if (tr_scheme.eq.1) then
-! Case 1: pseudo-chemistry with relaxation toward fixed profile
-
-         call phytrac_relax (debut,lafin,nqmax,
-     I                   nlon,nlev,dtime,pplay,
-     O                   tr_seri)
-
-       elseif (tr_scheme.eq.2) then
-! Case 2: surface emission
-! For the moment, inspired from Mars version
-! However, the variable 'source' could be used in physiq
-! so the call to phytrac_emiss could be to initialise it.
-
-         call phytrac_emiss ( (rjourvrai+gmtime)*RDAY,
-     I                   debut,lafin,nqmax,
-     I                   nlon,nlev,dtime,paprs,
-     I                   latitude_deg,longitude_deg,
-     O                   tr_seri)
-
-       elseif (tr_scheme.eq.3) then  ! identical to ok_chem.or.ok_cloud
-! Case 3: Full chemistry and/or clouds
-
-         if (ok_deltatemp) then
-!           PRINT*,'Def de delta_temp'
-           DO k = 1, klev
-           DO i = 1, klon      
-             ilat=(latitude_deg(i)/5.625) + 17.
-!             PRINT*,INT(ilat),latitude_deg(i),mat_dtemp(INT(ilat),k)
-             delta_temp(i,k)=mat_dtemp(INT(ilat),k)
-           ENDDO
-           ENDDO
-      
-         endif
-
-!         Pas appel concentrations car BUG ... comprend pas
-!         valeur de mmean trop hautes 5,25E+29
-!         call concentrations2(pplay,t_seri,d_t,tr_seri, nqmax)
-
-         if (ok_deltatemp) then
-! Utilisation du champ de temperature modifie         
-           call phytrac_chimie(                              
-     I             debut,
-     I             gmtime,
-     I             nqmax,
-     I             klon,
-     I             latitude_deg,
-     I             longitude_deg,
-     I             nlev,
-     I             dtime,
-     I             t_seri+delta_temp,
-     I             pplay,
-     O             tr_seri)
-         else
-         
-           call phytrac_chimie(                              
-     I             debut,
-     I             gmtime,
-     I             nqmax,
-     I             klon,
-     I             latitude_deg,
-     I             longitude_deg,
-     I             nlev,
-     I             dtime,
-     I             t_seri,
-     I             pplay,
-     O             tr_seri)
-         endif
-
-c        CALL WriteField_phy('Pression',pplay,nlev)
-c        CALL WriteField_phy('PressionBnd',paprs,nlev+1)
-c        CALL WriteField_phy('Temp',t_seri,nlev)
-c        IF (ok_cloud) THEN
-c          CALL WriteField_phy('NBRTOT',NBRTOT,nlev)
-c        ENDIF
-c        CALL WriteField_phy('SAl',tr_seri(:,:,i_h2so4liq),nlev)
-c        CALL WriteField_phy('SAg',tr_seri(:,:,i_h2so4),nlev)
-
-         if (ok_sedim) then 
-
-         if (ok_deltatemp) then
-! Utilisation du champ de temperature modifie  
-           CALL new_cloud_sedim(
-     I                 klon,
-     I                     nlev,
-     I                     dtime,
-     I                 pplay,
-     I                     paprs,
-     I                     t_seri+delta_temp,
-     I                 tr_seri,
-     O                     d_tr_sed,
-     O                     d_tr_ssed,
-     I                     nqmax,
-     O                 Fsedim)
-         else
-         
-           CALL new_cloud_sedim(
-     I                 klon,
-     I                     nlev,
-     I                     dtime,
-     I                 pplay,
-     I                     paprs,
-     I                     t_seri,
-     I                 tr_seri,
-     O                     d_tr_sed,
-     O                     d_tr_ssed,
-     I                     nqmax,
-     O                 Fsedim)
-
-         endif
-
-        DO k = 1, klev
-         DO i = 1, klon
-
-c--------------------
-c   Ce test est necessaire pour eviter Xliq=NaN   
-!        IF (ieee_is_nan(d_tr_sed(i,k,1)).OR.
-!     &  ieee_is_nan(d_tr_sed(i,k,2))) THEN
-        IF ((d_tr_sed(i,k,1).ne.d_tr_sed(i,k,1)).OR.
-     &      (d_tr_sed(i,k,2).ne.d_tr_sed(i,k,2))) THEN
-        PRINT*,'sedim NaN PROBLEM'
-        PRINT*,'d_tr_sed Nan?',d_tr_sed(i,k,:),'Temp',t_seri(i,k)
-        PRINT*,'lat-lon',i,'level',k,'dtime',dtime
-        PRINT*,'F_sed',Fsedim(i,k)
-        PRINT*,'==============================================='
-                d_tr_sed(i,k,:)=0.
-        ENDIF
-c--------------------
-
-        tr_seri(i,k,i_h2so4liq) = tr_seri(i,k,i_h2so4liq)+
-     &                            d_tr_sed(i,k,1)
-        tr_seri(i,k,i_h2oliq)   = tr_seri(i,k,i_h2oliq)+
-     &                            d_tr_sed(i,k,2)
-        d_tr_sed(i,k,:) = d_tr_sed(i,k,:) / dtime
-        Fsedim(i,k)     = Fsedim(i,k) / dtime
-     
-          ENDDO
-         ENDDO
-      
-        Fsedim(:,klev+1) = 0.
-
-         endif ! ok_sedim
-
-       endif   ! tr_scheme
-      endif    ! iflag_trac
-
-c
-c====================================================================
-c Appeler la diffusion verticale (programme de couche limite)
-c====================================================================
-
-c-------------------------------
-c VENUS TEST: on ne tient pas compte des calculs de clmain mais on force
-c l'equilibre radiatif du sol
-      if (1.eq.0) then
-              if (debut) then
-                print*,"ATTENTION, CLMAIN SHUNTEE..."
-              endif
-
-      DO i = 1, klon
-         sens(i) = 0.0e0 ! flux de chaleur sensible au sol
-         fder(i) = 0.0e0
-         dlw(i)  = 0.0e0
-      ENDDO
-
-c Incrementer la temperature du sol
-c
-      DO i = 1, klon
-         d_ts(i)  = dtime * radsol(i)/22000. !valeur calculee par GCM pour I=200
-         ftsol(i) = ftsol(i) + d_ts(i)
-         do j=1,nsoilmx
-           ftsoil(i,j)=ftsol(i)
-         enddo
-      ENDDO
-
-c-------------------------------
-      else
-c-------------------------------
-
-      fder = dlw
-
-! ADAPTATION GCM POUR CP(T)
-
-      CALL clmain(dtime,itap,
-     e            t_seri,u_seri,v_seri,
-     e            rmu0, 
-     e            ftsol,
-     $            ftsoil,
-     $            paprs,pplay,ppk,radsol,falbe,
-     e            solsw, sollw, sollwdown, fder,
-     e            longitude_deg, latitude_deg, dx, dy,   
-     e            debut, lafin,
-     s            d_t_vdf,d_u_vdf,d_v_vdf,d_ts,
-     s            fluxt,fluxu,fluxv,cdragh,cdragm,
-     s            dsens,
-     s            ycoefh,yu1,yv1) 
-
-CXXX Incrementation des flux
-      DO i = 1, klon
-         sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
-         fder(i) = dlw(i) + dsens(i) 
-      ENDDO
-CXXX
-
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
-         d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
-         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
-         d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
-         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
-         d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
-      ENDDO
-      ENDDO
-
-C TRACEURS
-
-      if (iflag_trac.eq.1) then
-         DO k = 1, klev
-         DO i = 1, klon
-            delp(i,k) = paprs(i,k)-paprs(i,k+1)
-         ENDDO
-         ENDDO
-   
-         DO iq=1, nqmax
-     
-             CALL cltrac(dtime,ycoefh,t_seri,
-     s               tr_seri(:,:,iq),source(:,iq),
-     e               paprs, pplay,delp,
-     s               d_tr_vdf(:,:,iq))
-     
-             tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
-             d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
-
-         ENDDO !nqmax
-
-       endif
-
-      IF (if_ebil.ge.2) THEN 
-        ztit='after clmain'
-        CALL diagetpq(cell_area,ztit,ip_ebil,2,1,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-         call diagphy(cell_area,ztit,ip_ebil
-     e      , zero_v, zero_v, zero_v, zero_v, sens
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-      END IF 
-C
-c
-c Incrementer la temperature du sol
-c
-      DO i = 1, klon
-         ftsol(i) = ftsol(i) + d_ts(i)
-      ENDDO
-
-c Calculer la derive du flux infrarouge
-c
-      DO i = 1, klon
-            dlw(i) = - 4.0*RSIGMA*ftsol(i)**3 
-      ENDDO
-
-c-------------------------------
-      endif  ! fin du VENUS TEST
-
-      ! tests: output tendencies
-!      call writefield_phy('physiq_d_t_vdf',d_t_vdf,klev)
-!      call writefield_phy('physiq_d_u_vdf',d_u_vdf,klev)
-!      call writefield_phy('physiq_d_v_vdf',d_v_vdf,klev)
-!      call writefield_phy('physiq_d_ts',d_ts,1)
-
-c
-c Appeler l'ajustement sec
-c
-c===================================================================
-c Convection seche 
-c===================================================================
-c
-      d_t_ajs(:,:)=0.
-      d_u_ajs(:,:)=0.
-      d_v_ajs(:,:)=0.
-      d_tr_ajs(:,:,:)=0.
-c
-      IF(prt_level>9)WRITE(lunout,*)
-     .    'AVANT LA CONVECTION SECHE , iflag_ajs='
-     s   ,iflag_ajs
-
-      if(iflag_ajs.eq.0) then
-c  Rien
-c  ====
-         IF(prt_level>9)WRITE(lunout,*)'pas de convection'
-
-      else if(iflag_ajs.eq.1) then
-
-c  Ajustement sec
-c  ==============
-         IF(prt_level>9)WRITE(lunout,*)'ajsec'
-
-! ADAPTATION GCM POUR CP(T)
-         CALL ajsec(paprs, pplay, ppk, t_seri, u_seri, v_seri, nqmax,
-     .              tr_seri, d_t_ajs, d_u_ajs, d_v_ajs, d_tr_ajs)
-
-! ADAPTATION GCM POUR CP(T)
-         do i=1,klon
-          flux_ajs(i,1) = 0.0
-          do j=2,klev
-            flux_ajs(i,j) = flux_ajs(i,j-1)
-     .        + cpdet(t_seri(i,j-1))/RG*d_t_ajs(i,j-1)/dtime
-     .                                 *(paprs(i,j-1)-paprs(i,j))
-          enddo
-         enddo
-         
-         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
-         d_t_ajs(:,:)= d_t_ajs(:,:)/dtime          ! K/s
-         u_seri(:,:) = u_seri(:,:) + d_u_ajs(:,:)
-         d_u_ajs(:,:)= d_u_ajs(:,:)/dtime          ! (m/s)/s
-         v_seri(:,:) = v_seri(:,:) + d_v_ajs(:,:)
-         d_v_ajs(:,:)= d_v_ajs(:,:)/dtime          ! (m/s)/s
-
-         if (iflag_trac.eq.1) then
-           tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
-           d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime  ! /s
-         endif
-      endif
-
-      ! tests: output tendencies
-!      call writefield_phy('physiq_d_t_ajs',d_t_ajs,klev)
-!      call writefield_phy('physiq_d_u_ajs',d_u_ajs,klev)
-!      call writefield_phy('physiq_d_v_ajs',d_v_ajs,klev)
-c
-      IF (if_ebil.ge.2) THEN 
-        ztit='after dry_adjust'
-        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , zero_v, zero_v, zero_v, zero_v, sens
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-      END IF 
-
-
-c====================================================================
-c RAYONNEMENT
-c====================================================================
-
-c------------------------------------
-c    . Compute radiative tendencies :
-c------------------------------------
-c====================================================================
-      IF (MOD(itaprad,radpas).EQ.0) THEN
-c====================================================================
-
-      dtimerad = dtime*REAL(radpas)  ! pas de temps du rayonnement (s)
-c     PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
-            
-
-c------------------------------------
-c    . Compute mean mass, cp and R :
-c------------------------------------
-
-      if(callthermos) then
-         call concentrations2(pplay,t_seri,d_t,tr_seri, nqmax)
-
-      endif
-
-
-cc!!! ADD key callhedin 
-
-      IF(callnlte.or.callthermos) THEN                                 
-         call compo_hedin83_mod(pplay,rmu0,   
-     &                 co2vmr_gcm,covmr_gcm,ovmr_gcm,n2vmr_gcm,nvmr_gcm)
-
-         IF(ok_chem) then
- 
-CC  !! GG : Using only mayor species tracers abundances to compute NLTE heating/cooling
-
-CC               Conversion [mmr] ---> [vmr]
-        
-                 co2vmr_gcm(:,:) = tr_seri(1:nlon,1:nlev,i_co2)*
-     &                             mmean(1:nlon,1:nlev)/M_tr(i_co2)
-                 covmr_gcm(:,:)  = tr_seri(1:nlon,1:nlev,i_co)* 
-     &                              mmean(1:nlon,1:nlev)/M_tr(i_co)
-                 ovmr_gcm(:,:)   = tr_seri(1:nlon,1:nlev,i_o)*
-     &                             mmean(1:nlon,1:nlev)/M_tr(i_o)
-                 n2vmr_gcm(:,:)   = tr_seri(1:nlon,1:nlev,i_n2)*
-     &                             mmean(1:nlon,1:nlev)/M_tr(i_n2)
-
-         ENDIF
-
-       ENDIF        
-
-c
-c   NLTE cooling from CO2 emission
-c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-        IF(callnlte) THEN                                 
-            if(nltemodel.eq.0.or.nltemodel.eq.1) then
-                CALL nltecool(klon, klev, nqmax, pplay*9.869e-6, t_seri,
-     $                    tr_seri, d_t_nlte)
-            else if(nltemodel.eq.2) then                                
-               CALL nlte_tcool(klon,klev,pplay*9.869e-6,              
-     $               t_seri,zzlay,co2vmr_gcm, n2vmr_gcm, covmr_gcm, 
-     $               ovmr_gcm,d_t_nlte,ierr_nlte,varerr )
-                  if(ierr_nlte.gt.0) then
-                     write(*,*)
-     $                'WARNING: nlte_tcool output with error message',
-     $                'ierr_nlte=',ierr_nlte,'varerr=',varerr
-                     write(*,*)'I will continue anyway'
-                  endif
-
-             endif
-             
-        ELSE
- 
-          d_t_nlte(:,:)=0.
-
-        ENDIF        
-
-c      Find number of layers for LTE radiation calculations
-
-      IF(callnlte .or. callnirco2) 
-     $        CALL nlthermeq(klon, klev, paprs, pplay) 
-
-c
-c       LTE radiative transfert / solar / IR matrix
-c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      CALL radlwsw
-     e            (dist, rmu0, fract, zzlev,
-     e             paprs, pplay,ftsol, t_seri)
-
-
-c       CO2 near infrared absorption
-c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-        d_t_nirco2(:,:)=0.
-        if (callnirco2) then
-           call nirco2abs (klon, klev, pplay, dist, nqmax, tr_seri,
-     .                 rmu0, fract, d_t_nirco2)
-        endif
-
-
-c          Net atmospheric radiative heating rate (K.s-1)
-c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-        IF(callnlte.or.callnirco2) THEN 
-           CALL blendrad(klon, klev, pplay,heat,
-     &          cool, d_t_nirco2,d_t_nlte, dtsw, dtlw)
-        ELSE
-           dtsw(:,:)=heat(:,:)
-           dtlw(:,:)=-1*cool(:,:)
-        ENDIF
-
-         DO k=1,klev
-            DO i=1,klon
-               d_t_rad(i,k) = dtsw(i,k) + dtlw(i,k)   ! K/s
-            ENDDO
-         ENDDO
-
-
-cc---------------------------------------------
-
-c          EUV heating rate (K.s-1)
-c          ~~~~~~~~~~~~~~~~~~~~~~~~
-
-        d_t_euv(:,:)=0.
-
-        IF (callthermos) THEN
-
-c           call euvheat(klon, klev,t_seri,paprs,pplay,zzlay,
-c     $          rmu0,pdtphys,gmtime,rjourvrai, co2vmr_gcm, n2vmr_gcm, 
-c     $          covmr_gcm, ovmr_gcm,d_t_euv )
-           call euvheat(klon, klev, nqmax, t_seri,paprs,pplay,zzlay,
-     $         rmu0,pdtphys,gmtime,rjourvrai,
-     $         tr_seri, d_tr, d_t_euv )
-                 
-           DO k=1,klev
-              DO ig=1,klon
-                 d_t_rad(ig,k)=d_t_rad(ig,k)+d_t_euv(ig,k)
-                
-              ENDDO
-           ENDDO
-
-        ENDIF  ! callthermos
-
-c====================================================================
-        itaprad = 0
-      ENDIF    ! radpas
-c====================================================================
-c
-c Ajouter la tendance des rayonnements (tous les pas)
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_rad(i,k) * dtime
-      ENDDO
-      ENDDO
-
-! CONDUCTION  and  MOLECULAR VISCOSITY
-c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-        d_t_conduc(:,:)=0.
-        d_u_molvis(:,:)=0.
-        d_v_molvis(:,:)=0.
-
-        IF (callthermos) THEN
-
-           tsurf(:)=t_seri(:,1)
-           call conduction(klon, klev,pdtphys,
-     $            pplay,paprs,t_seri,
-     $            tsurf,zzlev,zzlay,d_t_conduc)
-
-            call molvis(klon, klev,pdtphys,
-     $            pplay,paprs,t_seri,
-     $            u,tsurf,zzlev,zzlay,d_u_molvis)
-
-            call molvis(klon, klev, pdtphys,
-     $            pplay,paprs,t_seri,
-     $            v,tsurf,zzlev,zzlay,d_v_molvis)
-
-            DO k=1,klev
-               DO ig=1,klon
-                  t_seri(ig,k)= t_seri(ig,k)+ d_t_conduc(ig,k)*dtime ! [K]
-                  u_seri(ig,k)= u_seri(ig,k)+ d_u_molvis(ig,k)*dtime ! m/s
-                  v_seri(ig,k)= v_seri(ig,k)+ d_v_molvis(ig,k)*dtime ! m/s
-               ENDDO
-            ENDDO
-        ENDIF
-
-
-!  --  MOLECULAR DIFFUSION ---
-
-          d_q_moldif(:,:,:)=0
-
-         IF (callthermos .and. ok_chem) THEN
-
-             call moldiff_red(klon, klev, nqmax,
-     &                   pplay,paprs,t_seri, tr_seri, pdtphys,
-     &                   zzlay,d_t_euv,d_t_conduc,d_q_moldif)
-
-
-! --- update tendencies tracers ---
-
-          DO iq = 1, nqmax
-           DO k=1,klev
-              DO ig=1,klon
-                tr_seri(ig,k,iq)= tr_seri(ig,k,iq)+ 
-     &                           d_q_moldif(ig,k,iq)*dtime ! [Kg/kg]?
-              ENDDO
-            ENDDO
-           ENDDO
-           
-
-         ENDIF  ! callthermos & ok_chem
-
-c====================================================================
-      ! tests: output tendencies
-!      call writefield_phy('physiq_dtrad',dtrad,klev)
- 
-      IF (if_ebil.ge.2) THEN 
-        ztit='after rad'
-        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , topsw, toplw, solsw, sollw, zero_v
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-      END IF 
-c
-
-c====================================================================
-c   Calcul  des gravity waves  FLOTT
-c====================================================================
-c
-      if (ok_orodr.or.ok_gw_nonoro) then
-c  CALCUL DE N2
-       do i=1,klon
-        do k=2,klev
-          ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
-          zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
-        enddo
-       enddo
-       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
-       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
-       do i=1,klon
-        do k=2,klev
-          zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
-          zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
-          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
-          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
-        enddo
-        zn2(i,1) = 1.e-12  ! securite
-       enddo
-
-      endif
-      
-c ----------------------------ORODRAG
-      IF (ok_orodr) THEN
-c
-c  selection des points pour lesquels le shema est actif:
-        igwd=0
-        DO i=1,klon
-        itest(i)=0
-c        IF ((zstd(i).gt.10.0)) THEN
-        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
-          itest(i)=1
-          igwd=igwd+1
-          idx(igwd)=i
-        ENDIF
-        ENDDO
-c        igwdim=MAX(1,igwd)
-c
-c A ADAPTER POUR VENUS!!!
-        CALL drag_noro(klon,klev,dtime,paprs,pplay,pphi,zn2,
-     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
-     e                   igwd,idx,itest,
-     e                   t_seri, u_seri, v_seri,
-     s                   zulow, zvlow, zustrdr, zvstrdr,
-     s                   d_t_oro, d_u_oro, d_v_oro)
-
-c       print*,"d_u_oro=",d_u_oro(klon/2,:)
-c  ajout des tendances
-           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
-           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
-           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
-           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
-           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
-           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
-c    
-      ELSE
-         d_t_oro = 0.
-         d_u_oro = 0.
-         d_v_oro = 0.
-         zustrdr = 0.
-         zvstrdr = 0.
-c
-      ENDIF ! fin de test sur ok_orodr
-c
-      ! tests: output tendencies
-!      call writefield_phy('physiq_d_t_oro',d_t_oro,klev)
-!      call writefield_phy('physiq_d_u_oro',d_u_oro,klev)
-!      call writefield_phy('physiq_d_v_oro',d_v_oro,klev)
-
-c ----------------------------OROLIFT
-      IF (ok_orolf) THEN
-       print*,"ok_orolf NOT IMPLEMENTED !"
-       stop
-c
-c  selection des points pour lesquels le shema est actif:
-        igwd=0
-        DO i=1,klon
-        itest(i)=0
-        IF ((zpic(i)-zmea(i)).GT.100.) THEN
-          itest(i)=1
-          igwd=igwd+1
-          idx(igwd)=i
-        ENDIF
-        ENDDO
-c        igwdim=MAX(1,igwd)
-c
-c A ADAPTER POUR VENUS!!!
-c            CALL lift_noro(klon,klev,dtime,paprs,pplay,
-c     e                   latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval,
-c     e                   igwd,idx,itest,
-c     e                   t_seri, u_seri, v_seri,
-c     s                   zulow, zvlow, zustrli, zvstrli,
-c     s                   d_t_lif, d_u_lif, d_v_lif               )
-
-c
-c  ajout des tendances
-           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
-           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
-           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
-           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
-           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
-           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
-c
-      ELSE
-         d_t_lif = 0.
-         d_u_lif = 0.
-         d_v_lif = 0.
-         zustrli = 0.
-         zvstrli = 0.
-c
-      ENDIF ! fin de test sur ok_orolf
-
-c ---------------------------- NON-ORO GRAVITY WAVES
-       IF(ok_gw_nonoro) then
-
-      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
-     e               t_seri, u_seri, v_seri,
-     o               zustrhi,zvstrhi,
-     o               d_t_hin, d_u_hin, d_v_hin)
-
-c  ajout des tendances
-
-         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
-         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
-         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
-         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
-         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
-         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
-
-      ELSE
-         d_t_hin = 0.
-         d_u_hin = 0.
-         d_v_hin = 0.
-         zustrhi = 0.
-         zvstrhi = 0.
-
-      ENDIF ! fin de test sur ok_gw_nonoro
-
-      ! tests: output tendencies
-!      call writefield_phy('physiq_d_t_hin',d_t_hin,klev)
-!      call writefield_phy('physiq_d_u_hin',d_u_hin,klev)
-!      call writefield_phy('physiq_d_v_hin',d_v_hin,klev)
-
-c====================================================================
-c Transport de ballons 
-c====================================================================
-      if (ballons.eq.1) then
-        CALL ballon(30,pdtphys,rjourvrai,gmtime*RDAY,
-     &              latitude_deg,longitude_deg,
-c    C              t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
-     C              t,pplay,u,v,zphi)   ! alt above planet average radius
-      endif !ballons
-
-c====================================================================
-c Bilan de mmt angulaire
-c====================================================================
-      if (bilansmc.eq.1) then
-CMODDEB FLOTT
-C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
-C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
-
-      DO i = 1, klon
-        zustrph(i)=0.
-        zvstrph(i)=0.
-        zustrcl(i)=0.
-        zvstrcl(i)=0.
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-      ENDDO
-      ENDDO
-
-      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime*RDAY,
-     C               ra,rg,romega,
-     C               latitude_deg,longitude_deg,pphis,
-     C               zustrdr,zustrli,zustrcl,
-     C               zvstrdr,zvstrli,zvstrcl,
-     C               paprs,u,v)
-                     
-CCMODFIN FLOTT
-      endif !bilansmc
-
-c====================================================================
-c====================================================================
-c Calculer le transport de l'eau et de l'energie (diagnostique)
-c
-c  A REVOIR POUR VENUS...
-c
-c     CALL transp (paprs,ftsol,
-c    e                   t_seri, q_seri, u_seri, v_seri, zphi,
-c    s                   ve, vq, ue, uq)
-c
-c====================================================================
-c+jld ec_conser
-      DO k = 1, klev
-      DO i = 1, klon
-        d_t_ec(i,k)=0.5/cpdet(t_seri(i,k))
-     $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
-        t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
-        d_t_ec(i,k) = d_t_ec(i,k)/dtime
-       END DO 
-      END DO 
-         do i=1,klon
-          flux_ec(i,1) = 0.0
-          do j=2,klev
-            flux_ec(i,j) = flux_ec(i,j-1)
-     . +cpdet(t_seri(i,j-1))/RG*d_t_ec(i,j-1)*(paprs(i,j-1)-paprs(i,j))
-          enddo
-         enddo
-         
-c-jld ec_conser
-c====================================================================
-      IF (if_ebil.ge.1) THEN 
-        ztit='after physic'
-        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
-     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
-     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
-C     Comme les tendances de la physique sont ajoute dans la dynamique,
-C     on devrait avoir que la variation d'entalpie par la dynamique
-C     est egale a la variation de la physique au pas de temps precedent.
-C     Donc la somme de ces 2 variations devrait etre nulle.
-        call diagphy(cell_area,ztit,ip_ebil
-     e      , topsw, toplw, solsw, sollw, sens
-     e      , zero_v, zero_v, zero_v, ztsol
-     e      , d_h_vcol, d_qt, d_ec
-     s      , fs_bound, fq_bound )
-C
-      d_h_vcol_phy=d_h_vcol
-C
-      END IF 
-C
-c=======================================================================
-c   SORTIES
-c=======================================================================
-
-c Convertir les incrementations en tendances
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
-         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
-         d_t(i,k) = ( t_seri(i,k) - t(i,k) ) / dtime
-      ENDDO
-      ENDDO
-c
-      DO iq = 1, nqmax
-      DO  k = 1, klev
-      DO  i = 1, klon
-         d_qx(i,k,iq) = ( tr_seri(i,k,iq) - qx(i,k,iq) ) / dtime
-      ENDDO
-      ENDDO
-      ENDDO
-      
-c------------------------
-c Calcul moment cinetique
-c------------------------
-c TEST VENUS...
-c     mangtot = 0.0
-c     DO k = 1, klev
-c     DO i = 1, klon
-c       mang(i,k) = RA*cos(latitude(i))
-c    .     *(u_seri(i,k)+RA*cos(latitude(i))*ROMEGA)
-c    .     *cell_area(i)*(paprs(i,k)-paprs(i,k+1))/RG
-c       mangtot=mangtot+mang(i,k)
-c     ENDDO
-c     ENDDO
-c     print*,"Moment cinetique total = ",mangtot
-c
-c------------------------
-c
-c Sauvegarder les valeurs de t et u a la fin de la physique:
-c
-      DO k = 1, klev
-      DO i = 1, klon
-         u_ancien(i,k) = u_seri(i,k)
-         t_ancien(i,k) = t_seri(i,k)
-      ENDDO
-      ENDDO
-c
-c=============================================================
-c   Ecriture des sorties
-c=============================================================
-      
-#ifdef CPP_IOIPSL
-
-#ifdef histhf
-#include "write_histhf.h"
-#endif
-
-#ifdef histday
-#include "write_histday.h"
-#endif
-
-#ifdef histmth
-#include "write_histmth.h"
-#endif
-
-#ifdef histins
-#include "write_histins.h"
-#endif
-
-#endif
-
-c====================================================================
-c Si c'est la fin, il faut conserver l'etat de redemarrage
-c====================================================================
-c
-      IF (lafin) THEN
-         itau_phy = itau_phy + itap
-         CALL phyredem ("restartphy.nc")
-     
-c--------------FLOTT
-CMODEB LOTT
-C  FERMETURE DU FICHIER FORMATTE CONTENANT LES COMPOSANTES
-C  DU BILAN DE MOMENT ANGULAIRE.
-      if (bilansmc.eq.1) then
-        write(*,*)'Fermeture de aaam_bud.out (FL Vous parle)'
-        close(27)                                     
-        close(28)                                     
-      endif !bilansmc
-CMODFIN
-c-------------
-c--------------SLEBONNOIS
-C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
-C  DES BALLONS
-      if (ballons.eq.1) then
-        write(*,*)'Fermeture des ballons*.out'
-        close(30)                                     
-        close(31)                                     
-        close(32)                                     
-        close(33)                                     
-        close(34)                                     
-      endif !ballons
-c-------------
-      ENDIF
-      
-      RETURN
-      END
-
-
-
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-***********************************************************************
-
-      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
-      IMPLICIT none
-c
-c Tranformer une variable de la grille physique a
-c la grille d'ecriture
-c
-      INTEGER nfield,nlon,iim,jjmp1, jjm
-      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
-c
-      INTEGER i, n, ig
-c
-      jjm = jjmp1 - 1
-      DO n = 1, nfield
-         DO i=1,iim
-            ecrit(i,n) = fi(1,n)
-            ecrit(i+jjm*iim,n) = fi(nlon,n)
-         ENDDO
-         DO ig = 1, nlon - 2
-           ecrit(iim+ig,n) = fi(1+ig,n)
-         ENDDO
-      ENDDO
-      RETURN
-      END
Index: /trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F	(revision 1549)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/physiq_mod.F	(revision 1549)
@@ -0,0 +1,1777 @@
+!
+! $Id: $
+!
+      MODULE physiq_mod
+
+      IMPLICIT NONE
+
+      CONTAINS
+
+      SUBROUTINE physiq (nlon,nlev,nqmax,
+     .            debut,lafin,rjourvrai,gmtime,pdtphys,
+     .            paprs,pplay,ppk,pphi,pphis,presnivs,
+     .            u,v,t,qx,
+     .            flxmw,
+     .            d_u, d_v, d_t, d_qx, d_ps)
+
+c======================================================================
+c
+c Modifications pour la physique de Venus
+c     S. Lebonnois (LMD/CNRS) Septembre 2005
+c
+c ---------------------------------------------------------------------
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c
+c Objet: Moniteur general de la physique du modele
+cAA      Modifications quant aux traceurs :
+cAA                  -  uniformisation des parametrisations ds phytrac
+cAA                  -  stockage des moyennes des champs necessaires
+cAA                     en mode traceur off-line 
+c    modif   ( P. Le Van ,  12/10/98 )
+c
+c  Arguments:
+c
+c nlon----input-I-nombre de points horizontaux
+c nlev----input-I-nombre de couches verticales
+c nqmax---input-I-nombre de traceurs
+c debut---input-L-variable logique indiquant le premier passage
+c lafin---input-L-variable logique indiquant le dernier passage
+c rjour---input-R-numero du jour de l'experience
+c gmtime--input-R-fraction de la journee (0 a 1)
+c pdtphys-input-R-pas d'integration pour la physique (seconde)
+c paprs---input-R-pression pour chaque inter-couche (en Pa)
+c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
+c ppk  ---input-R-fonction d'Exner au milieu de couche
+c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
+c pphis---input-R-geopotentiel du sol
+c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
+c u-------input-R-vitesse dans la direction X (de O a E) en m/s
+c v-------input-R-vitesse Y (de S a N) en m/s
+c t-------input-R-temperature (K)
+c qx------input-R-mass mixing ratio traceurs (kg/kg) 
+c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
+c flxmw---input-R-flux de masse vertical en kg/s
+c
+c d_u-----output-R-tendance physique de "u" (m/s/s)
+c d_v-----output-R-tendance physique de "v" (m/s/s)
+c d_t-----output-R-tendance physique de "t" (K/s)
+c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
+c d_ps----output-R-tendance physique de la pression au sol
+c======================================================================
+      USE ioipsl
+!      USE histcom ! not needed; histcom is included in ioipsl
+      USE infotrac
+      use dimphy
+      USE geometry_mod,only: longitude, latitude, ! in radians
+     &                       longitude_deg,latitude_deg, ! in degrees
+     &                       cell_area,dx,dy
+      USE mod_phys_lmdz_para, only : is_parallel,jj_nb
+      USE phys_state_var_mod ! Variables sauvegardees de la physique
+      USE write_field_phy
+      USE iophy
+      USE cpdet_mod, only: cpdet, t2tpot
+      USE chemparam_mod
+      USE conc
+      USE compo_hedin83_mod2
+      use moyzon_mod, only: tmoy
+!      use ieee_arithmetic
+      use time_phylmdz_mod, only: annee_ref, day_ref, itau_phy
+      use mod_grid_phy_lmdz, only: nbp_lon
+      use logic_mod, only: iflag_trac
+      IMPLICIT none
+c======================================================================
+c   CLEFS CPP POUR LES IO
+c   =====================
+c#define histhf
+#define histday
+#define histmth
+#define histins
+c======================================================================
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "iniprint.h"
+#include "timerad.h" 
+#include "tabcontrol.h"
+#include "nirdata.h"
+#include "hedin.h"
+c======================================================================
+      LOGICAL ok_journe ! sortir le fichier journalier
+      save ok_journe
+c      PARAMETER (ok_journe=.true.)
+c
+      LOGICAL ok_mensuel ! sortir le fichier mensuel
+      save ok_mensuel
+c      PARAMETER (ok_mensuel=.true.)
+c
+      LOGICAL ok_instan ! sortir le fichier instantane
+      save ok_instan
+c      PARAMETER (ok_instan=.true.)
+c
+c======================================================================
+c
+c Variables argument:
+c
+      INTEGER nlon
+      INTEGER nlev
+      INTEGER nqmax
+      REAL rjourvrai
+      REAL gmtime
+      REAL pdtphys
+      LOGICAL debut, lafin
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL pphi(klon,klev)
+      REAL pphis(klon)
+      REAL presnivs(klev)
+
+! ADAPTATION GCM POUR CP(T)
+      REAL ppk(klon,klev)
+
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL t(klon,klev)
+      REAL qx(klon,klev,nqmax)
+
+      REAL d_u_dyn(klon,klev)
+      REAL d_t_dyn(klon,klev)
+
+      REAL flxmw(klon,klev)
+
+      REAL d_u(klon,klev)
+      REAL d_v(klon,klev)
+      REAL d_t(klon,klev)
+      REAL d_qx(klon,klev,nqmax)
+      REAL d_ps(klon)
+
+      logical ok_hf
+      real ecrit_hf
+      integer nid_hf
+      save ok_hf, ecrit_hf, nid_hf
+
+#ifdef histhf
+      data ok_hf,ecrit_hf/.true.,0.25/
+#else
+      data ok_hf/.false./
+#endif
+
+c Variables propres a la physique
+c
+      INTEGER,save :: itap        ! compteur pour la physique
+      REAL delp(klon,klev)        ! epaisseur d'une couche
+      REAL omega(klon,klev)       ! vitesse verticale en Pa/s
+
+      
+      INTEGER igwd,idx(klon),itest(klon)
+c
+c  Diagnostiques 2D de drag_noro, lift_noro et gw_nonoro
+
+      REAL zulow(klon),zvlow(klon)
+      REAL zustrdr(klon), zvstrdr(klon)
+      REAL zustrli(klon), zvstrli(klon)
+      REAL zustrhi(klon), zvstrhi(klon)
+
+c Pour calcul GW drag oro et nonoro: CALCUL de N2:
+      real zdzlev(klon,klev)
+      real ztlev(klon,klev),zpklev(klon,klev)
+      real ztetalay(klon,klev),ztetalev(klon,klev)
+      real zdtetalev(klon,klev)
+      real zn2(klon,klev) ! BV^2 at plev
+
+c Pour les bilans de moment angulaire, 
+      integer bilansmc
+c Pour le transport de ballons
+      integer ballons
+c j'ai aussi besoin
+c du stress de couche limite a la surface:
+
+      REAL zustrcl(klon),zvstrcl(klon) 
+
+c et du stress total c de la physique:
+
+      REAL zustrph(klon),zvstrph(klon) 
+
+c Variables locales:
+c
+      REAL cdragh(klon) ! drag coefficient pour T and Q
+      REAL cdragm(klon) ! drag coefficient pour vent
+c
+cAA  Pour  TRACEURS
+cAA
+      REAL,save,allocatable :: source(:,:)
+      REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
+      REAL yu1(klon)            ! vents dans la premiere couche U
+      REAL yv1(klon)            ! vents dans la premiere couche V
+
+      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
+      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
+      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
+      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
+      REAL uq(klon) ! integr. verticale du transport zonal de l'eau
+c
+      REAL Fsedim(klon,klev+1)  ! Flux de sedimentation (kg.m-2)
+
+c======================================================================
+c
+c Declaration des procedures appelees
+c
+      EXTERNAL ajsec     ! ajustement sec
+      EXTERNAL clmain    ! couche limite 
+      EXTERNAL hgardfou  ! verifier les temperatures
+c     EXTERNAL orbite    ! calculer l'orbite 
+      EXTERNAL phyetat0  ! lire l'etat initial de la physique
+      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
+      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
+      EXTERNAL suphec    ! initialiser certaines constantes
+      EXTERNAL transp    ! transport total de l'eau et de l'energie
+      EXTERNAL abort_gcm
+      EXTERNAL printflag
+      EXTERNAL zenang
+      EXTERNAL diagetpq
+      EXTERNAL conf_phys
+      EXTERNAL diagphy
+      EXTERNAL mucorr
+      EXTERNAL nirco2abs
+      EXTERNAL nir_leedat
+      EXTERNAL nltecool
+      EXTERNAL nlte_tcool
+      EXTERNAL nlte_setup
+      EXTERNAL blendrad
+      EXTERNAL nlthermeq
+      EXTERNAL euvheat
+      EXTERNAL param_read
+      EXTERNAL param_read_e107
+      EXTERNAL conduction
+      EXTERNAL molvis
+      EXTERNAL moldiff_red
+
+c
+c Variables locales
+c
+CXXX PB 
+      REAL fluxt(klon,klev)   ! flux turbulent de chaleur
+      REAL fluxu(klon,klev)   ! flux turbulent de vitesse u
+      REAL fluxv(klon,klev)   ! flux turbulent de vitesse v
+c
+      REAL flux_dyn(klon,klev)  ! flux de chaleur produit par la dynamique
+      REAL flux_ajs(klon,klev)  ! flux de chaleur ajustement sec
+      REAL flux_ec(klon,klev)   ! flux de chaleur Ec
+c
+      REAL tmpout(klon,klev)  ! K s-1 
+
+      INTEGER itaprad
+      SAVE itaprad
+c
+      REAL dist, rmu0(klon), fract(klon)
+      REAL zdtime, zlongi
+c
+      INTEGER i, k, iq, ig, j, ll, ilon, ilat, ilev
+c
+      REAL zphi(klon,klev)
+      REAL zzlev(klon,klev+1),zzlay(klon,klev),z1,z2
+      real tsurf(klon)
+
+c va avec nlte_tcool
+      INTEGER ierr_nlte
+      REAL    varerr
+
+c Variables du changement
+c
+c ajs: ajustement sec
+c vdf: couche limite (Vertical DiFfusion)
+      REAL d_t_ajs(klon,klev), d_tr_ajs(klon,klev,nqmax)
+      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
+c
+      REAL d_ts(klon)
+c
+      REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
+      REAL d_t_vdf(klon,klev), d_tr_vdf(klon,klev,nqmax)
+c
+CMOD LOTT: Tendances Orography Sous-maille
+      REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
+      REAL d_t_oro(klon,klev)
+      REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
+      REAL d_t_lif(klon,klev)
+C          Tendances Ondes de G non oro (runs strato).
+      REAL d_u_hin(klon,klev), d_v_hin(klon,klev)
+      REAL d_t_hin(klon,klev)
+
+c Tendencies due to radiative scheme   [K/s]
+c     d_t_rad,dtsw,dtlw,d_t_nirco2,d_t_nlte,d_t_euv
+c are not computed at each physical timestep
+c therefore, they are defined and saved in phys_state_var_mod
+
+c Tendencies due to molecular viscosity and conduction
+      real d_t_conduc(klon,klev)     ! [K/s]
+      real d_u_molvis(klon,klev)     ! (m/s) /s
+      real d_v_molvis(klon,klev)     ! (m/s) /s
+
+c Tendencies due to molecular diffusion
+      real d_q_moldif(klon,klev,nqmax)
+
+c
+c Variables liees a l'ecriture de la bande histoire physique
+c
+      INTEGER ecrit_mth
+      SAVE ecrit_mth   ! frequence d'ecriture (fichier mensuel)
+c
+      INTEGER ecrit_day
+      SAVE ecrit_day   ! frequence d'ecriture (fichier journalier)
+c
+      INTEGER ecrit_ins
+      SAVE ecrit_ins   ! frequence d'ecriture (fichier instantane)
+c
+      integer itau_w   ! pas de temps ecriture = itap + itau_phy
+
+c Variables locales pour effectuer les appels en serie
+c
+      REAL t_seri(klon,klev)
+      REAL u_seri(klon,klev), v_seri(klon,klev)
+c
+      REAL :: tr_seri(klon,klev,nqmax)
+      REAL :: d_tr(klon,klev,nqmax)
+
+c Champ de modification de la temperature par rapport a VIRAII
+      REAL delta_temp(klon,klev)
+c      SAVE delta_temp
+      REAL mat_dtemp(33,50)
+      SAVE mat_dtemp
+
+c Variables tendance sedimentation
+
+      REAL :: d_tr_sed(klon,klev,2)
+      REAL :: d_tr_ssed(klon)
+c
+c pour ioipsl
+      INTEGER nid_day, nid_mth, nid_ins
+      SAVE nid_day, nid_mth, nid_ins
+      INTEGER nhori, nvert, idayref
+      REAL zsto, zout, zsto1, zsto2, zero
+      parameter (zero=0.0e0)
+      real zjulian
+      save zjulian
+
+      CHARACTER*2  str2
+      character*20 modname
+      character*80 abort_message
+      logical ok_sync
+
+      character*30 nom_fichier
+      character*10 varname
+      character*40 vartitle
+      character*20 varunits
+C     Variables liees au bilan d'energie et d'enthalpi
+      REAL ztsol(klon)
+      REAL      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      SAVE      h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     $        , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+      REAL      d_h_vcol, d_h_dair, d_qt, d_qw, d_ql, d_qs, d_ec
+      REAL      d_h_vcol_phy
+      REAL      fs_bound, fq_bound
+      SAVE      d_h_vcol_phy
+      REAL      zero_v(klon),zero_v2(klon,klev)
+      CHARACTER*15 ztit
+      INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
+      SAVE      ip_ebil
+      DATA      ip_ebil/2/
+      INTEGER   if_ebil ! level for energy conserv. dignostics
+      SAVE      if_ebil
+c+jld ec_conser
+      REAL d_t_ec(klon,klev)    ! tendance du a la conversion Ec -> E thermique
+c-jld ec_conser
+
+c TEST VENUS...
+      REAL mang(klon,klev)    ! moment cinetique
+      REAL mangtot            ! moment cinetique total
+
+c Declaration des constantes et des fonctions thermodynamiques
+c
+#include "YOMCST.h"
+
+c======================================================================
+c INITIALISATIONS
+c================
+
+      modname = 'physiq'
+      ok_sync=.TRUE.
+
+      bilansmc = 0
+      ballons  = 0
+! NE FONCTIONNENT PAS ENCORE EN PARALLELE !!!
+      if (is_parallel) then
+        bilansmc = 0
+        ballons  = 0
+      endif
+
+      IF (if_ebil.ge.1) THEN
+        DO i=1,klon
+          zero_v(i)=0.
+        END DO 
+        DO i=1,klon
+         DO j=1,klev
+          zero_v2(i,j)=0.
+         END DO 
+        END DO 
+      END IF 
+      
+c PREMIER APPEL SEULEMENT
+c========================
+      IF (debut) THEN
+         allocate(source(klon,nqmax))
+
+         CALL suphec ! initialiser constantes et parametres phys.
+
+         IF (if_ebil.ge.1) d_h_vcol_phy=0.
+c
+c appel a la lecture du physiq.def 
+c
+         call conf_phys(ok_journe, ok_mensuel,
+     .                  ok_instan,
+     .                  if_ebil)
+
+         call phys_state_var_init
+c
+c Initialising Hedin model for upper atm 
+c   (to be revised when coupled to chemistry) :
+         call conc_init
+c
+c Initialiser les compteurs:
+c
+         itap    = 0
+         itaprad = 0
+c         
+c Lecture startphy.nc :
+c
+         CALL phyetat0 ("startphy.nc")
+
+c dtime est defini dans tabcontrol.h et lu dans startphy
+c pdtphys est calcule a partir des nouvelles conditions:
+c Reinitialisation du pas de temps physique quand changement
+         IF (ABS(dtime-pdtphys).GT.0.001) THEN
+            WRITE(lunout,*) 'Pas physique a change',dtime,
+     .                        pdtphys
+c           abort_message='Pas physique n est pas correct '
+c           call abort_gcm(modname,abort_message,1)
+c----------------
+c pour initialiser convenablement le time_counter, il faut tenir compte
+c du changement de dtime en changeant itau_phy (point de depart)
+            itau_phy = NINT(itau_phy*dtime/pdtphys)
+c----------------
+            dtime=pdtphys
+         ENDIF
+
+         radpas = NINT( RDAY/pdtphys/nbapp_rad)
+
+         CALL printflag( ok_journe,ok_instan )
+c
+c---------
+c FLOTT
+       IF (ok_orodr) THEN
+         DO i=1,klon
+         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
+         ENDDO
+         CALL SUGWD(klon,klev,paprs,pplay)
+         DO i=1,klon
+         zuthe(i)=0.
+         zvthe(i)=0.
+         if(zstd(i).gt.10.)then
+           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
+           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
+         endif
+         ENDDO
+       ENDIF
+
+      if (bilansmc.eq.1) then
+C  OUVERTURE D'UN FICHIER FORMATTE POUR STOCKER LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      open(27,file='aaam_bud.out',form='formatted')
+      open(28,file='fields_2d.out',form='formatted')
+      write(*,*)'Ouverture de aaam_bud.out (FL Vous parle)'
+      write(*,*)'Ouverture de fields_2d.out (FL Vous parle)'
+      endif !bilansmc
+
+c--------------SLEBONNOIS
+C  OUVERTURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+      open(30,file='ballons-lat.out',form='formatted')
+      open(31,file='ballons-lon.out',form='formatted')
+      open(32,file='ballons-u.out',form='formatted')
+      open(33,file='ballons-v.out',form='formatted')
+      open(34,file='ballons-alt.out',form='formatted')
+      write(*,*)'Ouverture des ballons*.out'
+      endif !ballons
+c-------------
+
+c---------
+C TRACEURS
+C source dans couche limite
+         source(:,:) = 0.0 ! pas de source, pour l'instant
+c---------
+
+c---------
+c INITIALIZE THERMOSPHERIC PARAMETERS
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+         if (callthermos) then
+            if(solvarmod.eq.0) call param_read
+            if(solvarmod.eq.1) call param_read_e107 
+         endif
+
+c Initialisation (recomputed in concentration2)
+       do ig=1,klon
+         do j=1,klev
+            rnew(ig,j)=R
+            cpnew(ig,j)=cpdet(tmoy(j))
+            mmean(ig,j)=RMD
+            akknew(ig,j)=1.e-4
+          enddo
+c        stop
+
+        enddo  
+     
+      IF(callthermos.or.callnlte.or.callnirco2) THEN  
+         call compo_hedin83_init2
+      ENDIF
+      if (callnlte.and.nltemodel.eq.2) call nlte_setup
+      if (callnirco2.and.nircorr.eq.1) call nir_leedat         
+c---------
+      
+c
+c Verifications:
+c
+         IF (nlon .NE. klon) THEN
+            WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, 
+     .                      klon
+            abort_message='nlon et klon ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+         IF (nlev .NE. klev) THEN
+            WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev,
+     .                       klev
+            abort_message='nlev et klev ne sont pas coherents'
+            call abort_gcm(modname,abort_message,1)
+         ENDIF
+c
+         IF (dtime*REAL(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
+     $    THEN 
+           WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
+           WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
+           abort_message='Nbre d appels au rayonnement insuffisant'
+           call abort_gcm(modname,abort_message,1)
+         ENDIF
+c
+         WRITE(lunout,*)"Clef pour la convection seche, iflag_ajs=",
+     .                   iflag_ajs
+c
+         ecrit_mth = NINT(RDAY/dtime*ecriphy)  ! tous les ecritphy jours
+         IF (ok_mensuel) THEN
+         WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 
+     .                   ecrit_mth
+         ENDIF
+
+         ecrit_day = NINT(RDAY/dtime *1.0)  ! tous les jours
+         IF (ok_journe) THEN
+         WRITE(lunout,*)'La frequence de sortie journaliere est de ',
+     .                   ecrit_day
+         ENDIF
+
+         ecrit_ins = NINT(RDAY/dtime*ecriphy)  ! Fraction de jour reglable
+         IF (ok_instan) THEN
+         WRITE(lunout,*)'La frequence de sortie instant. est de ', 
+     .                   ecrit_ins
+         ENDIF
+
+c Initialisation des sorties 
+c===========================
+
+#ifdef CPP_IOIPSL
+
+#ifdef histhf
+#include "ini_histhf.h"
+#endif
+
+#ifdef histday
+#include "ini_histday.h"
+#endif
+
+#ifdef histmth
+#include "ini_histmth.h"
+#endif
+
+#ifdef histins
+#include "ini_histins.h"
+#endif
+
+#endif
+
+c
+c Initialiser les valeurs de u pour calculs tendances
+c (pour T, c'est fait dans phyetat0)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u(i,k)
+      ENDDO
+      ENDDO
+
+c---------
+c       Ecriture fichier initialisation
+c       PRINT*,'Ecriture Initial_State.csv'
+c       OPEN(88,file='Trac_Point.csv',
+c     & form='formatted')
+c---------
+     
+c---------
+c       Initialisation des parametres des nuages
+c===============================================
+     
+      if ((nlon .EQ. 1) .AND. ok_cloud) then
+        PRINT*,'Open profile_cloud_parameters.csv'
+        OPEN(66,file='profile_cloud_parameters.csv',
+     &   form='formatted')
+      endif
+
+      if ((nlon .EQ. 1) .AND. ok_sedim) then
+        PRINT*,'Open profile_cloud_sedim.csv'
+        OPEN(77,file='profile_cloud_sedim.csv',
+     &   form='formatted')
+      endif
+           
+      if ((nlon .GT. 1) .AND. (ok_chem.OR.ok_cloud)) then
+c !!! DONC 3D !!!
+        CALL chemparam_ini() 
+      endif
+         
+      if ((nlon .GT. 1) .AND. ok_cloud) then
+c !!! DONC 3D !!!
+        CALL cloud_ini(nlon,nlev)
+      endif
+
+c======================================================================
+c      Lecture du fichier DeltaT
+c======================================================================
+
+c     ATTENTION tout ce qui suit est pour un 48*32*50
+
+      if (ok_deltatemp) then
+
+      print*,'lecture de VenusDeltaT.txt '
+      open(99, form = 'formatted', status = 'old', file = 
+     &     'VenusDeltaT.dat')
+      print*,'Ouverture de VenusDeltaT.txt '
+
+      DO ilev = 1, klev
+         read(99,'(33(1x,e13.6))') (mat_dtemp(ilat,ilev),ilat=1,33)
+         print*,'lecture de VenusDeltaT.txt ligne:',ilev
+      ENDDO
+      
+      close(99)
+      print*,'FIN lecture de VenusDeltaT.txt ok.'
+
+      DO k = 1, klev
+      DO i = 1, klon      
+         ilat=(latitude_deg(i)/5.625) + 17.
+         delta_temp(i,k)=mat_dtemp(INT(ilat),k)
+      ENDDO
+      ENDDO
+      
+      endif
+        
+      ENDIF ! debut
+c======================================================================
+c======================================================================
+
+c Mettre a zero des variables de sortie (pour securite)
+c
+      DO i = 1, klon
+         d_ps(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO k = 1, klev
+      DO i = 1, klon
+         d_qx(i,k,iq) = 0.0
+      ENDDO
+      ENDDO
+      ENDDO
+c
+c Ne pas affecter les valeurs entrees de u, v, h, et q
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k)  = t(i,k)
+         u_seri(i,k)  = u(i,k)
+         v_seri(i,k)  = v(i,k)
+      ENDDO
+      ENDDO
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         tr_seri(i,k,iq) = qx(i,k,iq)
+      ENDDO
+      ENDDO
+      ENDDO
+C
+      DO i = 1, klon
+          ztsol(i) = ftsol(i)
+      ENDDO
+C
+      IF (if_ebil.ge.1) THEN 
+        ztit='after dynamic'
+        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol+d_h_vcol_phy, d_qt, 0.
+     s      , fs_bound, fq_bound )
+      END IF 
+
+c====================================================================
+c Diagnostiquer la tendance dynamique
+c
+      IF (ancien_ok) THEN
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
+            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
+         ENDDO
+         ENDDO
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_dyn(i,1) = 0.0
+          do j=2,klev
+            flux_dyn(i,j) = flux_dyn(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_dyn(i,j-1)*(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+      ELSE
+         DO k = 1, klev
+         DO i = 1, klon
+            d_u_dyn(i,k) = 0.0
+            d_t_dyn(i,k) = 0.0
+         ENDDO
+         ENDDO
+         ancien_ok = .TRUE.
+      ENDIF
+c====================================================================
+
+c Calcule de vitesse verticale a partir de flux de masse verticale
+      DO k = 1, klev
+       DO i = 1, klon
+        omega(i,k) = RG*flxmw(i,k) / cell_area(i)
+       END DO
+      END DO
+
+c
+c Ajouter le geopotentiel du sol:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         zphi(i,k) = pphi(i,k) + pphis(i)
+      ENDDO
+      ENDDO
+
+c   calcul du geopotentiel aux niveaux intercouches
+c   ponderation des altitudes au niveau des couches en dp/p
+
+      DO k=1,klev
+         DO i=1,klon
+            zzlay(i,k)=zphi(i,k)/RG        ! [m]
+         ENDDO
+      ENDDO
+      DO i=1,klon
+         zzlev(i,1)=pphis(i)/RG            ! [m]
+      ENDDO
+      DO k=2,klev
+         DO i=1,klon
+            z1=(pplay(i,k-1)+paprs(i,k))/(pplay(i,k-1)-paprs(i,k))
+            z2=(paprs(i,k)  +pplay(i,k))/(paprs(i,k)  -pplay(i,k))
+            zzlev(i,k)=(z1*zzlay(i,k-1)+z2*zzlay(i,k))/(z1+z2)
+         ENDDO
+      ENDDO
+      DO i=1,klon
+         zzlev(i,klev+1)=zzlay(i,klev)+(zzlay(i,klev)-zzlev(i,klev))
+      ENDDO
+
+c====================================================================
+c
+c Verifier les temperatures
+c
+      CALL hgardfou(t_seri,ftsol,'debutphy')
+c====================================================================
+c
+c Incrementer le compteur de la physique
+c
+      itap   = itap + 1
+
+c====================================================================
+c Orbite et eclairement
+c====================================================================
+
+c Pour VENUS, on fixe l'obliquite a 0 et l'eccentricite a 0.
+c donc pas de variations de Ls, ni de dist.
+c La seule chose qui compte, c'est la rotation de la planete devant
+c le Soleil...
+      
+      zlongi = 0.0
+      dist   = 0.72  ! en UA
+
+c Si on veut remettre l'obliquite a 3 degres et/ou l'eccentricite 
+c a sa valeur, et prendre en compte leur evolution, 
+c il faudra refaire un orbite.F...
+c     CALL orbite(zlongi,dist)
+
+      IF (cycle_diurne) THEN
+        zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
+        CALL zenang(zlongi,gmtime,zdtime,latitude_deg,longitude_deg,
+     &              rmu0,fract)
+      ELSE
+        call mucorr(klon,zlongi,latitude_deg,rmu0,fract)
+      ENDIF
+      
+c====================================================================
+c   Calcul  des tendances traceurs
+c====================================================================
+
+      if (iflag_trac.eq.1) then
+
+       if (tr_scheme.eq.1) then
+! Case 1: pseudo-chemistry with relaxation toward fixed profile
+
+         call phytrac_relax (debut,lafin,nqmax,
+     I                   nlon,nlev,dtime,pplay,
+     O                   tr_seri)
+
+       elseif (tr_scheme.eq.2) then
+! Case 2: surface emission
+! For the moment, inspired from Mars version
+! However, the variable 'source' could be used in physiq
+! so the call to phytrac_emiss could be to initialise it.
+
+         call phytrac_emiss ( (rjourvrai+gmtime)*RDAY,
+     I                   debut,lafin,nqmax,
+     I                   nlon,nlev,dtime,paprs,
+     I                   latitude_deg,longitude_deg,
+     O                   tr_seri)
+
+       elseif (tr_scheme.eq.3) then  ! identical to ok_chem.or.ok_cloud
+! Case 3: Full chemistry and/or clouds
+
+         if (ok_deltatemp) then
+!           PRINT*,'Def de delta_temp'
+           DO k = 1, klev
+           DO i = 1, klon      
+             ilat=(latitude_deg(i)/5.625) + 17.
+!             PRINT*,INT(ilat),latitude_deg(i),mat_dtemp(INT(ilat),k)
+             delta_temp(i,k)=mat_dtemp(INT(ilat),k)
+           ENDDO
+           ENDDO
+      
+         endif
+
+!         Pas appel concentrations car BUG ... comprend pas
+!         valeur de mmean trop hautes 5,25E+29
+!         call concentrations2(pplay,t_seri,d_t,tr_seri, nqmax)
+
+         if (ok_deltatemp) then
+! Utilisation du champ de temperature modifie         
+           call phytrac_chimie(                              
+     I             debut,
+     I             gmtime,
+     I             nqmax,
+     I             klon,
+     I             latitude_deg,
+     I             longitude_deg,
+     I             nlev,
+     I             dtime,
+     I             t_seri+delta_temp,
+     I             pplay,
+     O             tr_seri)
+         else
+         
+           call phytrac_chimie(                              
+     I             debut,
+     I             gmtime,
+     I             nqmax,
+     I             klon,
+     I             latitude_deg,
+     I             longitude_deg,
+     I             nlev,
+     I             dtime,
+     I             t_seri,
+     I             pplay,
+     O             tr_seri)
+         endif
+
+c        CALL WriteField_phy('Pression',pplay,nlev)
+c        CALL WriteField_phy('PressionBnd',paprs,nlev+1)
+c        CALL WriteField_phy('Temp',t_seri,nlev)
+c        IF (ok_cloud) THEN
+c          CALL WriteField_phy('NBRTOT',NBRTOT,nlev)
+c        ENDIF
+c        CALL WriteField_phy('SAl',tr_seri(:,:,i_h2so4liq),nlev)
+c        CALL WriteField_phy('SAg',tr_seri(:,:,i_h2so4),nlev)
+
+         if (ok_sedim) then 
+
+         if (ok_deltatemp) then
+! Utilisation du champ de temperature modifie  
+           CALL new_cloud_sedim(
+     I                 klon,
+     I                     nlev,
+     I                     dtime,
+     I                 pplay,
+     I                     paprs,
+     I                     t_seri+delta_temp,
+     I                 tr_seri,
+     O                     d_tr_sed,
+     O                     d_tr_ssed,
+     I                     nqmax,
+     O                 Fsedim)
+         else
+         
+           CALL new_cloud_sedim(
+     I                 klon,
+     I                     nlev,
+     I                     dtime,
+     I                 pplay,
+     I                     paprs,
+     I                     t_seri,
+     I                 tr_seri,
+     O                     d_tr_sed,
+     O                     d_tr_ssed,
+     I                     nqmax,
+     O                 Fsedim)
+
+         endif
+
+        DO k = 1, klev
+         DO i = 1, klon
+
+c--------------------
+c   Ce test est necessaire pour eviter Xliq=NaN   
+!        IF (ieee_is_nan(d_tr_sed(i,k,1)).OR.
+!     &  ieee_is_nan(d_tr_sed(i,k,2))) THEN
+        IF ((d_tr_sed(i,k,1).ne.d_tr_sed(i,k,1)).OR.
+     &      (d_tr_sed(i,k,2).ne.d_tr_sed(i,k,2))) THEN
+        PRINT*,'sedim NaN PROBLEM'
+        PRINT*,'d_tr_sed Nan?',d_tr_sed(i,k,:),'Temp',t_seri(i,k)
+        PRINT*,'lat-lon',i,'level',k,'dtime',dtime
+        PRINT*,'F_sed',Fsedim(i,k)
+        PRINT*,'==============================================='
+                d_tr_sed(i,k,:)=0.
+        ENDIF
+c--------------------
+
+        tr_seri(i,k,i_h2so4liq) = tr_seri(i,k,i_h2so4liq)+
+     &                            d_tr_sed(i,k,1)
+        tr_seri(i,k,i_h2oliq)   = tr_seri(i,k,i_h2oliq)+
+     &                            d_tr_sed(i,k,2)
+        d_tr_sed(i,k,:) = d_tr_sed(i,k,:) / dtime
+        Fsedim(i,k)     = Fsedim(i,k) / dtime
+     
+          ENDDO
+         ENDDO
+      
+        Fsedim(:,klev+1) = 0.
+
+         endif ! ok_sedim
+
+       endif   ! tr_scheme
+      endif    ! iflag_trac
+
+c
+c====================================================================
+c Appeler la diffusion verticale (programme de couche limite)
+c====================================================================
+
+c-------------------------------
+c VENUS TEST: on ne tient pas compte des calculs de clmain mais on force
+c l'equilibre radiatif du sol
+      if (1.eq.0) then
+              if (debut) then
+                print*,"ATTENTION, CLMAIN SHUNTEE..."
+              endif
+
+      DO i = 1, klon
+         sens(i) = 0.0e0 ! flux de chaleur sensible au sol
+         fder(i) = 0.0e0
+         dlw(i)  = 0.0e0
+      ENDDO
+
+c Incrementer la temperature du sol
+c
+      DO i = 1, klon
+         d_ts(i)  = dtime * radsol(i)/22000. !valeur calculee par GCM pour I=200
+         ftsol(i) = ftsol(i) + d_ts(i)
+         do j=1,nsoilmx
+           ftsoil(i,j)=ftsol(i)
+         enddo
+      ENDDO
+
+c-------------------------------
+      else
+c-------------------------------
+
+      fder = dlw
+
+! ADAPTATION GCM POUR CP(T)
+
+      CALL clmain(dtime,itap,
+     e            t_seri,u_seri,v_seri,
+     e            rmu0, 
+     e            ftsol,
+     $            ftsoil,
+     $            paprs,pplay,ppk,radsol,falbe,
+     e            solsw, sollw, sollwdown, fder,
+     e            longitude_deg, latitude_deg, dx, dy,   
+     e            debut, lafin,
+     s            d_t_vdf,d_u_vdf,d_v_vdf,d_ts,
+     s            fluxt,fluxu,fluxv,cdragh,cdragm,
+     s            dsens,
+     s            ycoefh,yu1,yv1) 
+
+CXXX Incrementation des flux
+      DO i = 1, klon
+         sens(i) = - fluxt(i,1) ! flux de chaleur sensible au sol
+         fder(i) = dlw(i) + dsens(i) 
+      ENDDO
+CXXX
+
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
+         d_t_vdf(i,k)= d_t_vdf(i,k)/dtime          ! K/s
+         u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
+         d_u_vdf(i,k)= d_u_vdf(i,k)/dtime          ! (m/s)/s
+         v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
+         d_v_vdf(i,k)= d_v_vdf(i,k)/dtime          ! (m/s)/s
+      ENDDO
+      ENDDO
+
+C TRACEURS
+
+      if (iflag_trac.eq.1) then
+         DO k = 1, klev
+         DO i = 1, klon
+            delp(i,k) = paprs(i,k)-paprs(i,k+1)
+         ENDDO
+         ENDDO
+   
+         DO iq=1, nqmax
+     
+             CALL cltrac(dtime,ycoefh,t_seri,
+     s               tr_seri(:,:,iq),source(:,iq),
+     e               paprs, pplay,delp,
+     s               d_tr_vdf(:,:,iq))
+     
+             tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
+             d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
+
+         ENDDO !nqmax
+
+       endif
+
+      IF (if_ebil.ge.2) THEN 
+        ztit='after clmain'
+        CALL diagetpq(cell_area,ztit,ip_ebil,2,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+         call diagphy(cell_area,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+C
+c
+c Incrementer la temperature du sol
+c
+      DO i = 1, klon
+         ftsol(i) = ftsol(i) + d_ts(i)
+      ENDDO
+
+c Calculer la derive du flux infrarouge
+c
+      DO i = 1, klon
+            dlw(i) = - 4.0*RSIGMA*ftsol(i)**3 
+      ENDDO
+
+c-------------------------------
+      endif  ! fin du VENUS TEST
+
+      ! tests: output tendencies
+!      call writefield_phy('physiq_d_t_vdf',d_t_vdf,klev)
+!      call writefield_phy('physiq_d_u_vdf',d_u_vdf,klev)
+!      call writefield_phy('physiq_d_v_vdf',d_v_vdf,klev)
+!      call writefield_phy('physiq_d_ts',d_ts,1)
+
+c
+c Appeler l'ajustement sec
+c
+c===================================================================
+c Convection seche 
+c===================================================================
+c
+      d_t_ajs(:,:)=0.
+      d_u_ajs(:,:)=0.
+      d_v_ajs(:,:)=0.
+      d_tr_ajs(:,:,:)=0.
+c
+      IF(prt_level>9)WRITE(lunout,*)
+     .    'AVANT LA CONVECTION SECHE , iflag_ajs='
+     s   ,iflag_ajs
+
+      if(iflag_ajs.eq.0) then
+c  Rien
+c  ====
+         IF(prt_level>9)WRITE(lunout,*)'pas de convection'
+
+      else if(iflag_ajs.eq.1) then
+
+c  Ajustement sec
+c  ==============
+         IF(prt_level>9)WRITE(lunout,*)'ajsec'
+
+! ADAPTATION GCM POUR CP(T)
+         CALL ajsec(paprs, pplay, ppk, t_seri, u_seri, v_seri, nqmax,
+     .              tr_seri, d_t_ajs, d_u_ajs, d_v_ajs, d_tr_ajs)
+
+! ADAPTATION GCM POUR CP(T)
+         do i=1,klon
+          flux_ajs(i,1) = 0.0
+          do j=2,klev
+            flux_ajs(i,j) = flux_ajs(i,j-1)
+     .        + cpdet(t_seri(i,j-1))/RG*d_t_ajs(i,j-1)/dtime
+     .                                 *(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
+         d_t_ajs(:,:)= d_t_ajs(:,:)/dtime          ! K/s
+         u_seri(:,:) = u_seri(:,:) + d_u_ajs(:,:)
+         d_u_ajs(:,:)= d_u_ajs(:,:)/dtime          ! (m/s)/s
+         v_seri(:,:) = v_seri(:,:) + d_v_ajs(:,:)
+         d_v_ajs(:,:)= d_v_ajs(:,:)/dtime          ! (m/s)/s
+
+         if (iflag_trac.eq.1) then
+           tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
+           d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime  ! /s
+         endif
+      endif
+
+      ! tests: output tendencies
+!      call writefield_phy('physiq_d_t_ajs',d_t_ajs,klev)
+!      call writefield_phy('physiq_d_u_ajs',d_u_ajs,klev)
+!      call writefield_phy('physiq_d_v_ajs',d_v_ajs,klev)
+c
+      IF (if_ebil.ge.2) THEN 
+        ztit='after dry_adjust'
+        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , zero_v, zero_v, zero_v, zero_v, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+
+
+c====================================================================
+c RAYONNEMENT
+c====================================================================
+
+c------------------------------------
+c    . Compute radiative tendencies :
+c------------------------------------
+c====================================================================
+      IF (MOD(itaprad,radpas).EQ.0) THEN
+c====================================================================
+
+      dtimerad = dtime*REAL(radpas)  ! pas de temps du rayonnement (s)
+c     PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
+            
+
+c------------------------------------
+c    . Compute mean mass, cp and R :
+c------------------------------------
+
+      if(callthermos) then
+         call concentrations2(pplay,t_seri,d_t,tr_seri, nqmax)
+
+      endif
+
+
+cc!!! ADD key callhedin 
+
+      IF(callnlte.or.callthermos) THEN                                 
+         call compo_hedin83_mod(pplay,rmu0,   
+     &                 co2vmr_gcm,covmr_gcm,ovmr_gcm,n2vmr_gcm,nvmr_gcm)
+
+         IF(ok_chem) then
+ 
+CC  !! GG : Using only mayor species tracers abundances to compute NLTE heating/cooling
+
+CC               Conversion [mmr] ---> [vmr]
+        
+                 co2vmr_gcm(:,:) = tr_seri(1:nlon,1:nlev,i_co2)*
+     &                             mmean(1:nlon,1:nlev)/M_tr(i_co2)
+                 covmr_gcm(:,:)  = tr_seri(1:nlon,1:nlev,i_co)* 
+     &                              mmean(1:nlon,1:nlev)/M_tr(i_co)
+                 ovmr_gcm(:,:)   = tr_seri(1:nlon,1:nlev,i_o)*
+     &                             mmean(1:nlon,1:nlev)/M_tr(i_o)
+                 n2vmr_gcm(:,:)   = tr_seri(1:nlon,1:nlev,i_n2)*
+     &                             mmean(1:nlon,1:nlev)/M_tr(i_n2)
+
+         ENDIF
+
+       ENDIF        
+
+c
+c   NLTE cooling from CO2 emission
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        IF(callnlte) THEN                                 
+            if(nltemodel.eq.0.or.nltemodel.eq.1) then
+                CALL nltecool(klon, klev, nqmax, pplay*9.869e-6, t_seri,
+     $                    tr_seri, d_t_nlte)
+            else if(nltemodel.eq.2) then                                
+               CALL nlte_tcool(klon,klev,pplay*9.869e-6,              
+     $               t_seri,zzlay,co2vmr_gcm, n2vmr_gcm, covmr_gcm, 
+     $               ovmr_gcm,d_t_nlte,ierr_nlte,varerr )
+                  if(ierr_nlte.gt.0) then
+                     write(*,*)
+     $                'WARNING: nlte_tcool output with error message',
+     $                'ierr_nlte=',ierr_nlte,'varerr=',varerr
+                     write(*,*)'I will continue anyway'
+                  endif
+
+             endif
+             
+        ELSE
+ 
+          d_t_nlte(:,:)=0.
+
+        ENDIF        
+
+c      Find number of layers for LTE radiation calculations
+
+      IF(callnlte .or. callnirco2) 
+     $        CALL nlthermeq(klon, klev, paprs, pplay) 
+
+c
+c       LTE radiative transfert / solar / IR matrix
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      CALL radlwsw
+     e            (dist, rmu0, fract, zzlev,
+     e             paprs, pplay,ftsol, t_seri)
+
+
+c       CO2 near infrared absorption
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        d_t_nirco2(:,:)=0.
+        if (callnirco2) then
+           call nirco2abs (klon, klev, pplay, dist, nqmax, tr_seri,
+     .                 rmu0, fract, d_t_nirco2)
+        endif
+
+
+c          Net atmospheric radiative heating rate (K.s-1)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        IF(callnlte.or.callnirco2) THEN 
+           CALL blendrad(klon, klev, pplay,heat,
+     &          cool, d_t_nirco2,d_t_nlte, dtsw, dtlw)
+        ELSE
+           dtsw(:,:)=heat(:,:)
+           dtlw(:,:)=-1*cool(:,:)
+        ENDIF
+
+         DO k=1,klev
+            DO i=1,klon
+               d_t_rad(i,k) = dtsw(i,k) + dtlw(i,k)   ! K/s
+            ENDDO
+         ENDDO
+
+
+cc---------------------------------------------
+
+c          EUV heating rate (K.s-1)
+c          ~~~~~~~~~~~~~~~~~~~~~~~~
+
+        d_t_euv(:,:)=0.
+
+        IF (callthermos) THEN
+
+c           call euvheat(klon, klev,t_seri,paprs,pplay,zzlay,
+c     $          rmu0,pdtphys,gmtime,rjourvrai, co2vmr_gcm, n2vmr_gcm, 
+c     $          covmr_gcm, ovmr_gcm,d_t_euv )
+           call euvheat(klon, klev, nqmax, t_seri,paprs,pplay,zzlay,
+     $         rmu0,pdtphys,gmtime,rjourvrai,
+     $         tr_seri, d_tr, d_t_euv )
+                 
+           DO k=1,klev
+              DO ig=1,klon
+                 d_t_rad(ig,k)=d_t_rad(ig,k)+d_t_euv(ig,k)
+                
+              ENDDO
+           ENDDO
+
+        ENDIF  ! callthermos
+
+c====================================================================
+        itaprad = 0
+      ENDIF    ! radpas
+c====================================================================
+c
+c Ajouter la tendance des rayonnements (tous les pas)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_seri(i,k) = t_seri(i,k) + d_t_rad(i,k) * dtime
+      ENDDO
+      ENDDO
+
+! CONDUCTION  and  MOLECULAR VISCOSITY
+c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+        d_t_conduc(:,:)=0.
+        d_u_molvis(:,:)=0.
+        d_v_molvis(:,:)=0.
+
+        IF (callthermos) THEN
+
+           tsurf(:)=t_seri(:,1)
+           call conduction(klon, klev,pdtphys,
+     $            pplay,paprs,t_seri,
+     $            tsurf,zzlev,zzlay,d_t_conduc)
+
+            call molvis(klon, klev,pdtphys,
+     $            pplay,paprs,t_seri,
+     $            u,tsurf,zzlev,zzlay,d_u_molvis)
+
+            call molvis(klon, klev, pdtphys,
+     $            pplay,paprs,t_seri,
+     $            v,tsurf,zzlev,zzlay,d_v_molvis)
+
+            DO k=1,klev
+               DO ig=1,klon
+                  t_seri(ig,k)= t_seri(ig,k)+ d_t_conduc(ig,k)*dtime ! [K]
+                  u_seri(ig,k)= u_seri(ig,k)+ d_u_molvis(ig,k)*dtime ! m/s
+                  v_seri(ig,k)= v_seri(ig,k)+ d_v_molvis(ig,k)*dtime ! m/s
+               ENDDO
+            ENDDO
+        ENDIF
+
+
+!  --  MOLECULAR DIFFUSION ---
+
+          d_q_moldif(:,:,:)=0
+
+         IF (callthermos .and. ok_chem) THEN
+
+             call moldiff_red(klon, klev, nqmax,
+     &                   pplay,paprs,t_seri, tr_seri, pdtphys,
+     &                   zzlay,d_t_euv,d_t_conduc,d_q_moldif)
+
+
+! --- update tendencies tracers ---
+
+          DO iq = 1, nqmax
+           DO k=1,klev
+              DO ig=1,klon
+                tr_seri(ig,k,iq)= tr_seri(ig,k,iq)+ 
+     &                           d_q_moldif(ig,k,iq)*dtime ! [Kg/kg]?
+              ENDDO
+            ENDDO
+           ENDDO
+           
+
+         ENDIF  ! callthermos & ok_chem
+
+c====================================================================
+      ! tests: output tendencies
+!      call writefield_phy('physiq_dtrad',dtrad,klev)
+ 
+      IF (if_ebil.ge.2) THEN 
+        ztit='after rad'
+        CALL diagetpq(cell_area,ztit,ip_ebil,2,2,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+c
+
+c====================================================================
+c   Calcul  des gravity waves  FLOTT
+c====================================================================
+c
+      if (ok_orodr.or.ok_gw_nonoro) then
+c  CALCUL DE N2
+       do i=1,klon
+        do k=2,klev
+          ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
+          zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
+        enddo
+       enddo
+       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
+       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
+       do i=1,klon
+        do k=2,klev
+          zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
+          zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
+          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
+          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
+        enddo
+        zn2(i,1) = 1.e-12  ! securite
+       enddo
+
+      endif
+      
+c ----------------------------ORODRAG
+      IF (ok_orodr) THEN
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+c        IF ((zstd(i).gt.10.0)) THEN
+        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS!!!
+        CALL drag_noro(klon,klev,dtime,paprs,pplay,pphi,zn2,
+     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
+     e                   igwd,idx,itest,
+     e                   t_seri, u_seri, v_seri,
+     s                   zulow, zvlow, zustrdr, zvstrdr,
+     s                   d_t_oro, d_u_oro, d_v_oro)
+
+c       print*,"d_u_oro=",d_u_oro(klon/2,:)
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
+           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
+           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
+           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
+c    
+      ELSE
+         d_t_oro = 0.
+         d_u_oro = 0.
+         d_v_oro = 0.
+         zustrdr = 0.
+         zvstrdr = 0.
+c
+      ENDIF ! fin de test sur ok_orodr
+c
+      ! tests: output tendencies
+!      call writefield_phy('physiq_d_t_oro',d_t_oro,klev)
+!      call writefield_phy('physiq_d_u_oro',d_u_oro,klev)
+!      call writefield_phy('physiq_d_v_oro',d_v_oro,klev)
+
+c ----------------------------OROLIFT
+      IF (ok_orolf) THEN
+       print*,"ok_orolf NOT IMPLEMENTED !"
+       stop
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+        IF ((zpic(i)-zmea(i)).GT.100.) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS!!!
+c            CALL lift_noro(klon,klev,dtime,paprs,pplay,
+c     e                   latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval,
+c     e                   igwd,idx,itest,
+c     e                   t_seri, u_seri, v_seri,
+c     s                   zulow, zvlow, zustrli, zvstrli,
+c     s                   d_t_lif, d_u_lif, d_v_lif               )
+
+c
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
+           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
+           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
+           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
+c
+      ELSE
+         d_t_lif = 0.
+         d_u_lif = 0.
+         d_v_lif = 0.
+         zustrli = 0.
+         zvstrli = 0.
+c
+      ENDIF ! fin de test sur ok_orolf
+
+c ---------------------------- NON-ORO GRAVITY WAVES
+       IF(ok_gw_nonoro) then
+
+      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
+     e               t_seri, u_seri, v_seri,
+     o               zustrhi,zvstrhi,
+     o               d_t_hin, d_u_hin, d_v_hin)
+
+c  ajout des tendances
+
+         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
+         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
+         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
+         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
+         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
+         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
+
+      ELSE
+         d_t_hin = 0.
+         d_u_hin = 0.
+         d_v_hin = 0.
+         zustrhi = 0.
+         zvstrhi = 0.
+
+      ENDIF ! fin de test sur ok_gw_nonoro
+
+      ! tests: output tendencies
+!      call writefield_phy('physiq_d_t_hin',d_t_hin,klev)
+!      call writefield_phy('physiq_d_u_hin',d_u_hin,klev)
+!      call writefield_phy('physiq_d_v_hin',d_v_hin,klev)
+
+c====================================================================
+c Transport de ballons 
+c====================================================================
+      if (ballons.eq.1) then
+        CALL ballon(30,pdtphys,rjourvrai,gmtime*RDAY,
+     &              latitude_deg,longitude_deg,
+c    C              t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
+     C              t,pplay,u,v,zphi)   ! alt above planet average radius
+      endif !ballons
+
+c====================================================================
+c Bilan de mmt angulaire
+c====================================================================
+      if (bilansmc.eq.1) then
+CMODDEB FLOTT
+C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
+C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
+
+      DO i = 1, klon
+        zustrph(i)=0.
+        zvstrph(i)=0.
+        zustrcl(i)=0.
+        zvstrcl(i)=0.
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+      ENDDO
+      ENDDO
+
+      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime*RDAY,
+     C               ra,rg,romega,
+     C               latitude_deg,longitude_deg,pphis,
+     C               zustrdr,zustrli,zustrcl,
+     C               zvstrdr,zvstrli,zvstrcl,
+     C               paprs,u,v)
+                     
+CCMODFIN FLOTT
+      endif !bilansmc
+
+c====================================================================
+c====================================================================
+c Calculer le transport de l'eau et de l'energie (diagnostique)
+c
+c  A REVOIR POUR VENUS...
+c
+c     CALL transp (paprs,ftsol,
+c    e                   t_seri, q_seri, u_seri, v_seri, zphi,
+c    s                   ve, vq, ue, uq)
+c
+c====================================================================
+c+jld ec_conser
+      DO k = 1, klev
+      DO i = 1, klon
+        d_t_ec(i,k)=0.5/cpdet(t_seri(i,k))
+     $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
+        t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
+        d_t_ec(i,k) = d_t_ec(i,k)/dtime
+       END DO 
+      END DO 
+         do i=1,klon
+          flux_ec(i,1) = 0.0
+          do j=2,klev
+            flux_ec(i,j) = flux_ec(i,j-1)
+     . +cpdet(t_seri(i,j-1))/RG*d_t_ec(i,j-1)*(paprs(i,j-1)-paprs(i,j))
+          enddo
+         enddo
+         
+c-jld ec_conser
+c====================================================================
+      IF (if_ebil.ge.1) THEN 
+        ztit='after physic'
+        CALL diagetpq(cell_area,ztit,ip_ebil,1,1,dtime
+     e      , t_seri,zero_v2,zero_v2,zero_v2,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+C     Comme les tendances de la physique sont ajoute dans la dynamique,
+C     on devrait avoir que la variation d'entalpie par la dynamique
+C     est egale a la variation de la physique au pas de temps precedent.
+C     Donc la somme de ces 2 variations devrait etre nulle.
+        call diagphy(cell_area,ztit,ip_ebil
+     e      , topsw, toplw, solsw, sollw, sens
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+C
+      d_h_vcol_phy=d_h_vcol
+C
+      END IF 
+C
+c=======================================================================
+c   SORTIES
+c=======================================================================
+
+c Convertir les incrementations en tendances
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
+         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
+         d_t(i,k) = ( t_seri(i,k) - t(i,k) ) / dtime
+      ENDDO
+      ENDDO
+c
+      DO iq = 1, nqmax
+      DO  k = 1, klev
+      DO  i = 1, klon
+         d_qx(i,k,iq) = ( tr_seri(i,k,iq) - qx(i,k,iq) ) / dtime
+      ENDDO
+      ENDDO
+      ENDDO
+      
+c------------------------
+c Calcul moment cinetique
+c------------------------
+c TEST VENUS...
+c     mangtot = 0.0
+c     DO k = 1, klev
+c     DO i = 1, klon
+c       mang(i,k) = RA*cos(latitude(i))
+c    .     *(u_seri(i,k)+RA*cos(latitude(i))*ROMEGA)
+c    .     *cell_area(i)*(paprs(i,k)-paprs(i,k+1))/RG
+c       mangtot=mangtot+mang(i,k)
+c     ENDDO
+c     ENDDO
+c     print*,"Moment cinetique total = ",mangtot
+c
+c------------------------
+c
+c Sauvegarder les valeurs de t et u a la fin de la physique:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         u_ancien(i,k) = u_seri(i,k)
+         t_ancien(i,k) = t_seri(i,k)
+      ENDDO
+      ENDDO
+c
+c=============================================================
+c   Ecriture des sorties
+c=============================================================
+      
+#ifdef CPP_IOIPSL
+
+#ifdef histhf
+#include "write_histhf.h"
+#endif
+
+#ifdef histday
+#include "write_histday.h"
+#endif
+
+#ifdef histmth
+#include "write_histmth.h"
+#endif
+
+#ifdef histins
+#include "write_histins.h"
+#endif
+
+#endif
+
+c====================================================================
+c Si c'est la fin, il faut conserver l'etat de redemarrage
+c====================================================================
+c
+      IF (lafin) THEN
+         itau_phy = itau_phy + itap
+         CALL phyredem ("restartphy.nc")
+     
+c--------------FLOTT
+CMODEB LOTT
+C  FERMETURE DU FICHIER FORMATTE CONTENANT LES COMPOSANTES
+C  DU BILAN DE MOMENT ANGULAIRE.
+      if (bilansmc.eq.1) then
+        write(*,*)'Fermeture de aaam_bud.out (FL Vous parle)'
+        close(27)                                     
+        close(28)                                     
+      endif !bilansmc
+CMODFIN
+c-------------
+c--------------SLEBONNOIS
+C  FERMETURE DES FICHIERS FORMATTES CONTENANT LES POSITIONS ET VITESSES
+C  DES BALLONS
+      if (ballons.eq.1) then
+        write(*,*)'Fermeture des ballons*.out'
+        close(30)                                     
+        close(31)                                     
+        close(32)                                     
+        close(33)                                     
+        close(34)                                     
+      endif !ballons
+c-------------
+      ENDIF
+      
+      END SUBROUTINE physiq
+
+      END MODULE physiq_mod
+
