Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/aeropacity_use.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/aeropacity_use.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/aeropacity_use.F	(revision 308)
@@ -0,0 +1,667 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &    pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d,zdqnorm)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL dsodust(ngridmx,nlayermx)
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL nueffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+      REAL zdqnorm(ngridmx,nlayermx,2)                         !Quantity of dust which have to be added by the dynamical core to have a "realistic" mass mixing ratio
+
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+      REAL qdust(ngridmx,nlayermx) ! True dust mass mixing ratio
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL qtot(ngridmx)           ! Dust column (kg m-2)
+
+c     CCN reduction factor
+      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
+
+c
+c   Variables pour rescaler la poussière
+c   -----------------------------------
+
+      REAL pq_hold(ngridmx, nlayermx, 2)
+      REAL tauref2(ngridmx)
+      REAL eta
+      real rhoq 
+      real rho
+      real afactor
+      real temp
+      REAL alphalift(ngridmx) ! surface dust flux in kg.m-2.s-1
+      REAL vstockes(ngridmx)
+      REAL mmr(ngridmx)
+
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+c     Level under which the dust mixing ratio is held constant
+c       when computing the dust opacity in each layer
+c       (this applies when doubleq and active are true)
+      INTEGER, PARAMETER :: cstdustlevel = 7
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: txt ! to temporarly store text
+      CHARACTER(LEN=1) :: txt2 ! to temporarly store text
+! indexes of dust scatterers:
+      INTEGER,SAVE :: iaerdust(naerkind)
+      INTEGER,SAVE :: naerdust ! number of dust scatterers
+
+      tau(1:ngrid,1:naerkind)=0
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify scatterers that are dust
+        naerdust=0
+        DO iaer=1,naerkind
+          txt=name_iaer(iaer)
+          IF (txt(1:4).eq."dust") THEN
+            naerdust=naerdust+1
+            iaerdust(naerdust)=iaer
+          ENDIF
+        ENDDO
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          txt=noms(iq)
+          IF (txt(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        msolsir(1:nlayer,1:naerkind)=0
+        mqextsqabs(1:nlayer,1:naerkind)=0
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+        firstcall=.false.
+
+      END IF
+
+c     Vertical column optical depth at 700.Pa 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF(iaervar.eq.1) THEN 
+         do ig=1, ngridmx
+          tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                       ! or read in starfi
+        end do
+      ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+        tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+
+      ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+        taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+        tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+        tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+        do ig=1,ngrid/2  ! Northern hemisphere
+          tauref(ig)= tauN +
+     &    (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+        end do
+        do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+          tauref(ig)= tauS +
+     &    (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+        end do
+      ELSE IF ((iaervar.eq.4).or.
+     &        ((iaervar.ge.24).and.(iaervar.le.26)))
+     &     THEN  ! << "TES assimilated dust scenarios >>
+        call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+      ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+        tauref(1) = 2.5
+        if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+      ELSE
+        stop 'problem with iaervar in aeropacity.F'
+      ENDIF
+
+c -----------------------------------------------------------------
+c Computing the opacity in each layer
+c -----------------------------------------------------------------
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind      ! Typical dust profile
+c==================================================================
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+
+          expfactor=0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+            ENDDO
+          ENDDO
+
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c==================================================================
+        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) =
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("dust_submicron") aerkind   ! Small dust population
+c==================================================================
+
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("h2o_ice") aerkind             ! Water ice crystals
+c==================================================================
+
+c       1. Initialization
+        aerosol(1:ngrid,1:nlayer,iaer) = 0.
+        taucloudvis(1:ngrid) = 0.
+        taucloudtes(1:ngrid) = 0.
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) = max(1E-20,
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        pq(ig,l,i_ice) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+     &                              )
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauVIS','tauext VIS refwvl',
+     &      ' ',2,taucloudvis)
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'tauVIS','tauext VIS refwvl',
+     &        ' ',2,taucloudvis)
+            CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &        ' ',2,taucloudtes)
+          ENDIF
+        ELSE
+c         CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+c==================================================================
+        END SELECT aerkind
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+c -----------------------------------------------------------------
+c Rescaling each layer to reproduce the choosen (or assimilated)
+c   dust extinction opacity at visible reference wavelength, which
+c   is originally scaled to an equivalent 700Pa pressure surface.
+c -----------------------------------------------------------------
+
+         pq_hold(:,:,1) = pq(:,:,igcm_dust_mass)
+         pq_hold(:,:,2) = pq(:,:,igcm_dust_number)
+
+      taudusttmp(1:ngrid)=0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+c           Scaling factor
+            taudusttmp(ig) = taudusttmp(ig) + 
+     &                       aerosol(ig,l,iaerdust(iaer))
+
+          ENDDO
+        ENDDO
+      ENDDO
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            aerosol(ig,l,iaerdust(iaer)) = max(1E-20,
+     &                   tauref(ig) *
+     &                   pplev(ig,1) / 700.E0 *
+     &                   aerosol(ig,l,iaerdust(iaer)) / 
+     &                   taudusttmp(ig)
+     &                                        )
+          ENDDO
+        ENDDO
+      ENDDO
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+
+c-----------------------------------------------------------
+c   Modification of mass mixing ratio
+c------------------------------------------------------
+
+      IF (l.LE.cstdustlevel) THEN
+        pq(ig,l,igcm_dust_mass) = g *
+     &                     aerosol(ig,l,iaer) /
+     &                     (pplev(ig,l)-pplev(ig,l+1)) /
+     &                     ( 0.75*QREFvis3d(ig,cstdustlevel,iaer)/
+     &                       (rho_dust*reffrad(ig,cstdustlevel,iaer)) )
+      ELSE
+        pq(ig,l,igcm_dust_mass) = g *
+     &                     aerosol(ig,l,iaer) /
+     &                     (pplev(ig,l)-pplev(ig,l+1)) /
+     &                     ( 0.75*QREFvis3d(ig,l,iaer)/
+     &                       (rho_dust*reffrad(ig,l,iaer)) )
+      ENDIF
+
+
+
+
+
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+            IF (l.LE.cstdustlevel) THEN
+              pq(ig,l,igcm_dust_number) =
+     &          ((ref_r0/reffrad(ig,cstdustlevel,iaer))**3) *
+     &          r3n_q*pq(ig,l,igcm_dust_mass)
+            ELSE
+              pq(ig,l,igcm_dust_number) =
+     &          ((ref_r0/reffrad(ig,l,iaer))**3) *
+     &          r3n_q*pq(ig,l,igcm_dust_mass)
+            ENDIF
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+          ENDDO
+        ENDDO
+      ENDDO
+
+c------------------------------------------------------------------------------
+c         Compute the lifting factor to write in initracer.F
+c--------------------------------------------------------------------------------
+      DO ig=1, ngrid
+      mmr(ig)=pq(ig,1,igcm_dust_mass)
+      eta=1e-5       ! dynamic viscosity (kg.m-1.s-1) 
+      rhoq=2500.     ! dust density (kg.m-3)
+      rho=0.015      ! atmospheric density (kg.m-3) = p/RT
+      afactor = 0.707*8.31/(4*3.1416* 2.2e-10**2  * 6.023e23)
+      temp=210.      ! typical temperature (K)      !Ca faisait longtemps que je n'avais pas jeté un coup d'oeil ici, ça pourrait etre amélioré en utilisant la température réelle
+
+
+
+       vstockes(ig) = 2. / 9. * 
+     &             g * rhoq * 3e-6
+     &             / eta * 
+     &            (3e-6+1.333*afactor*temp/pplev(ig,1))
+       alphalift(ig) = mmr(ig) * (rho * vstockes(ig))
+
+      ENDDO
+
+
+c-------------------------------------------------------------------
+c    quantity of dust that have to be added by dynamical core
+c--------------------------------------------------------------------
+         zdqnorm(:,:,2) = pq(:,:,igcm_dust_number) -
+     &                                    pq_hold(:,:,2)
+         zdqnorm(:,:,1) = pq(:,:,igcm_dust_mass) -
+     &                                    pq_hold(:,:,1)
+
+
+
+            PRINT*,'pq apres', pq(10,1,igcm_dust_mass)
+            PRINT*,'pq avant', pq_hold(10,1,1)
+            PRINT*,'pdq', zdqnorm(10,1,1)
+
+
+c -----------------------------------------------------------------
+c Computing the number of condensation nuclei
+c -----------------------------------------------------------------
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind2: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind2     ! Typical dust profile
+c==================================================================
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              ccn(ig,l) = max(aerosol(ig,l,iaer) /
+     &                  pi / QREFvis3d(ig,l,iaer) *
+     &                  (1.+nueffrad(ig,l,iaer))**3. /
+     &                  reffrad(ig,l,iaer)**2. * g /
+     &                  (pplev(ig,l)-pplev(ig,l+1)),1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        CASE("dust_doubleq") aerkind2!Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+          qtot(1:ngridmx) = 0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * tauref(ig) *
+c     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+c              qtot(ig) = qtot(ig) + qdust(ig,l) *
+c     &                   (pplev(ig,l)-pplev(ig,l+1)) / g
+              ccn(ig,l) = max( ( ref_r0 /
+     &                    reffrad(ig,l,iaer) )**3. *
+     &                    r3n_q * pq(ig,l,igcm_dust_mass) ,1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        END SELECT aerkind2
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+c  Reduce number of nuclei
+!         TEMPORAIRE : r�duction du nombre de nuclei FF 04/200
+!         reduction facteur 3
+!         ccn(ig,l) = ccn(ig,l) / 27.
+!         reduction facteur 2
+!         ccn(ig,l) = ccn(ig,l) / 8.
+c -----------------------------------------------------------------
+       write(*,*) "water_param CCN reduc. fac. ", ccn_factor
+       DO l=1,nlayer
+         DO ig=1,ngrid
+            ccn(ig,l) = ccn(ig,l) / ccn_factor
+         ENDDO
+       ENDDO
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+      DO iaer=1,naerkind
+        do l=1,nlayer
+           do ig=1,ngrid
+             tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+           end do
+        end do
+      ENDDO
+c -----------------------------------------------------------------
+c Density scaled opacity and column opacity output
+c -----------------------------------------------------------------
+      dsodust(1:ngrid,1:nlayer) = 0.
+      DO iaer=1,naerdust
+        DO l=1,nlayermx
+          DO ig=1,ngrid
+            dsodust(ig,l) = dsodust(ig,l) +
+     &                      aerosol(ig,l,iaerdust(iaer)) * g /
+     &                      (pplev(ig,l) - pplev(ig,l+1))
+          ENDDO
+        ENDDO
+        IF (ngrid.NE.1) THEN
+          write(txt2,'(i1.1)') iaer
+          call WRITEDIAGFI(ngridmx,'taudust'//txt2,
+     &                    'Dust col opacity',
+     &                    ' ',2,tau(1,iaerdust(iaer)))
+        
+
+                tauref2(1:ngrid) = 0.
+          DO ig=1,ngrid
+            tauref2(ig) = tauref(ig) *
+     &                      pplev(ig,1) / 700
+          ENDDO
+          call WRITEDIAGFI(ngridmx,'tauref',
+     &                    'tau de ref',
+     &                    ' ',2,tauref2)
+
+          call WRITEDIAGFI(ngridmx,'alphlift',
+     &                    'poussière à soulever',
+     &                    'kg.m-2.s-1',2,alphalift)
+
+        IF (callstats) THEN
+            CALL wstats(ngridmx,'taudust'//txt2,
+     &                 'Dust col opacity',
+     &                 ' ',2,tau(1,iaerdust(iaer)))
+          ENDIF
+        ENDIF
+      ENDDO
+
+      IF (ngrid.NE.1) THEN
+c       CALL WRITEDIAGFI(ngridmx,'dsodust','tau*g/dp',
+c    &                    'm2.kg-1',3,dsodust)
+        IF (callstats) THEN
+          CALL wstats(ngridmx,'dsodust',
+     &               'tau*g/dp',
+     &               'm2.kg-1',3,dsodust)
+        ENDIF
+c       CALL WRITEDIAGFI(ngridmx,'ccn','Cond. nuclei',
+c    &                    'part kg-1',3,ccn)
+      ELSE
+        CALL writeg1d(ngrid,nlayer,dsodust,'dsodust','m2.kg-1')
+      ENDIF
+c -----------------------------------------------------------------
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/callradite_use.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/callradite_use.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/callradite_use.F	(revision 308)
@@ -0,0 +1,560 @@
+      SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice,zdqnorm)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call the main canonic
+c   radiative transfer subroutine "lwmain" et "swmain"
+c   to compute radiative heating and cooling rate and
+c   radiative fluxes to the surface.
+c
+c   These calculations are only valid on the part of the atmosphere
+c   where Local Thermal Equilibrium (NLTE) is verified. In practice
+c   The calculations are only performed for the first "nlaylte"
+c   parameters (nlaylte is calculated by subroutine "nlthermeq"
+c   and stored in common "yomlw.h").
+c
+c   The purpose of this subroutine is to:
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h
+c      3) Compute the 3D scattering parameters depending on the
+c        size distribution of the different tracers (added by JBM)
+c      4) call "lwmain" and "swmain"
+c
+c
+c   authors:   
+c   ------
+c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
+c
+c
+c   3D scattering scheme user's guide (J.-B. Madeleine)
+c   ---------------------------------
+c
+c   This routine has been modified to take into account 3D, time
+c   dependent scattering properties of the aerosols.
+c---- The look-up tables that contain the scattering parameters
+c   of a given tracer, for different sizes, are read by SUAER.F90.
+c   The names of the corresponding ASCII files have to be set in
+c   this subroutine (file_id variable), and files must be in the
+c   directory specified in datafile.h. Please make sure that the
+c   ASCII files are correctly written, and that the range
+c   of particle sizes is consistent with what you would expect.
+c---- SUAER.F90 is in charge of reading the ASCII files and averaging
+c   the scattering parameters in each GCM channel, using the three last
+c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
+c---- These look-up tables, loaded during the firstcall, are then
+c   constantly used by the subroutine "aeroptproperties.F" to compute,
+c   online, the 3D scattering parameters, based on the size distribution
+c   (reffrad and nueffrad) of the different tracers, in each grid box.
+c   These 3D size distributions are loaded by the "updatereffrad.F"
+c   subroutine. A log-normal distribution is then assumed in
+c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+c---- The optical depth at the visible reference wavelength (set in
+c   SUAER.F90, after the file_id variable) is then computed by
+c   the subroutine "aeropacity.F", by using the size and spatial
+c   distribution of the corresponding tracer. This connection has to
+c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
+c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
+c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
+c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and 
+c   swmain.F to solve the radiative transfer equation.
+c
+c   changes:
+c   -------
+c
+c   > SRL 7/2000
+c   
+c   This version has been modified to only calculate radiative tendencies
+c   over layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+c   layers, if any.
+c   In other routines, nlayermx -> nflev.
+c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
+c
+c   > J.-B. Madeleine 10W12
+c   This version uses the variable's splitting, which can be usefull
+c     when performing very high resolution simulation like LES.
+c
+c   ----------
+c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
+c   set in dimradmars.h 
+c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
+c   set in dimradmars.h 
+c
+c   input:
+c   ----- 
+c   icount                counter of call to subroutine physic by gcm
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   nq                    Number of tracer
+c   ls                    Solar longitude (Ls) , radian
+c   zday                  Date (time since Ls=0, in martian days)
+c   pq(ngrid,nlayer,nq)   Advected fields
+c
+c   albedo (ngrid,2)      hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1 
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c   emis                  Thermal IR surface emissivity (no unit)
+c   mu0(ngridmx)           cos of solar zenith angle
+c                           (=1 when sun at zenith)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
+c   tsurf(ngrid)           surface temperature (K)
+c   fract(ngridmx)         day fraction of the time interval 
+c                          =1 during the full day ; =0 during the night
+c   declin                 latitude of subsolar point
+c   dist_sol               sun-Mars distance (AU)
+c   igout                  coordinate of analysed point for debugging
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
+
+c
+c  output:
+c  -------
+c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
+c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
+c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
+c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
+c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
+c
+c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
+c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
+c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
+
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical
+c                         properties.
+
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "yomlw.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER icount        
+      INTEGER ngrid,nlayer,nq 
+      INTEGER igout
+
+      REAL pq(ngrid,nlayer,nq)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL albedo(ngrid,2),emis(ngrid)
+      REAL ls,zday
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer)
+      REAL tsurf(ngrid)
+      REAL dist_sol,mu0(ngrid),fract(ngrid)
+      REAL dtlw(ngridmx,nlayermx),dtsw(ngridmx,nlayermx)
+      REAL fluxsurf_lw(ngridmx), fluxtop_lw(ngridmx)
+      REAL fluxsurf_sw(ngridmx,2), fluxtop_sw(ngridmx,2)
+
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL rdust(ngridmx,nlayermx)  ! Dust geometric mean radius (m)
+      REAL rice(ngridmx,nlayermx)   ! Ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)  ! Estimated effective variance
+      REAL zdqnorm(ngridmx,nlayermx,2)  !Quantity of dust which have to be added by the dynamical core to have a "realistic" quantity of dust
+c
+c    Local variables :
+c    -----------------
+
+      INTEGER j,l,ig,n,ich
+      INTEGER aer_count,iaer
+      INTEGER jd,ig0,nd
+
+      real  cste_mars ! solar constant on Mars (Wm-2)
+      REAL ptlev(ngridmx,nlayermx+1)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+c     Thermal IR net radiative budget (W m-2)
+
+      real znetrad(ndomainsz,nflev)
+
+      real zfluxd_sw(ndomainsz,nflev+1,2)
+      real zfluxu_sw(ndomainsz,nflev+1,2)
+
+      REAL zplev(ndomainsz,nflev+1)
+      REAL zztlev(ndomainsz,nflev+1)
+      REAL zplay(ndomainsz,nflev)
+      REAL zt(ndomainsz,nflev)
+      REAL zaerosol(ndomainsz,nflev,naerkind)
+      REAL zalbedo(ndomainsz,2)
+      REAL zdp(ndomainsz,nflev)
+      REAL zdt0(ndomainsz)
+
+      REAL zzdtlw(ndomainsz,nflev)
+      REAL zzdtsw(ndomainsz,nflev)
+      REAL zzflux(ndomainsz,6)
+      real zrmuz
+
+      REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
+
+      REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
+
+c     Aerosol size distribution
+      REAL :: reffrad(ngrid,nlayer,naerkind)
+      REAL :: nueffrad(ngrid,nlayer,naerkind)
+c     Aerosol optical properties
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+c   local saved variables
+c   ---------------------
+
+      real pview(ngridmx)
+      save pview
+      
+      real zco2   ! volume fraction of CO2 in Mars atmosphere
+      DATA zco2/0.95/
+      SAVE zco2
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+
+c        Please name the different scatterers here ----------------
+c        PLEASE MAKE SURE that you set up the right number of
+c          scatterers in dimradmars.h (naerkind);
+c          name_iaer(1) = "dust_conrath"   !! poussiere classique
+          name_iaer(1) = "dust_doubleq"
+cc        name_iaer(2) = "dust_submicron" !! JB: experimental
+c          name_iaer(2) = "h2o_ice"
+c        ----------------------------------------------------------
+
+c        Assign a number to the different scatterers
+c        -------------------------------------------
+
+         iaer_dust_conrath=0
+         iaer_dust_doubleq=0
+         iaer_dust_submicron=0
+         iaer_h2o_ice=0
+
+         aer_count=0
+         if (.NOT.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_conrath") then
+               iaer_dust_conrath = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (doubleq.AND.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_doubleq") then
+               iaer_dust_doubleq = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (submicron.AND.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_submicron") then
+               iaer_dust_submicron = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (water.AND.activice) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."h2o_ice") then
+               iaer_h2o_ice = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+
+c        Check that we identified all tracers:
+         if (aer_count.ne.naerkind) then
+           write(*,*) "callradite: found only ",aer_count," scatterers"
+           write(*,*) "               expected ",naerkind
+           write(*,*) "please make sure that the number of"
+           write(*,*) "scatterers in dimradmars.h, the names"
+           write(*,*) "in callradite.F, and the flags in"
+           write(*,*) "callphys.def are all consistent!"
+           do iaer=1,naerkind
+             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
+           enddo
+           stop
+         else
+           write(*,*) "callradite: found all scatterers, namely:"
+           do iaer=1,naerkind
+             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
+           enddo
+         endif
+c        -------------------------------------------
+
+         DO ig=1,ngrid
+            pview(ig)=1.66     ! cosecant of viewing angle
+         ENDDO
+         gcp = g/cpp
+
+c        Logical tests for radiatively active water-ice clouds:
+         IF ( (activice.AND.(.NOT.water)).OR.
+     &        (activice.AND.(naerkind.LT.2)) ) THEN
+           WRITE(*,*) 'If activice is TRUE, water has to be set'
+           WRITE(*,*) 'to TRUE, and "naerkind" must be at least'
+           WRITE(*,*) 'equal to 2 in dimradmars.h.'
+           CALL ABORT
+         ELSE IF ( (.NOT.activice).AND.(naerkind.GT.1) ) THEN
+           WRITE(*,*) 'naerkind is greater than unity, but'
+           WRITE(*,*) 'activice has not been set to .true.'
+           WRITE(*,*) 'in callphys.def; this is not logical!'
+           CALL ABORT
+         ENDIF
+
+c        Loading the optical properties in external look-up tables:
+         CALL SUAER
+         CALL SULW
+
+         write(*,*) 'Splitting radiative calculations: ',
+     $              ' ngridmx,ngrid,ndomainsz,ndomain',
+     $                ngridmx,ngrid,ndomainsz,ndomain
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+         firstcall=.false.
+      END IF
+
+c     Computing aerosol optical properties and opacity
+c     ------------------------------------------------
+
+c     Updating aerosol size distributions:
+      CALL updatereffrad(ngrid,nlayer,
+     &                rdust,rice,nuice,
+     &                reffrad,nueffrad,
+     &                pq)
+
+c     Computing 3D scattering parameters:
+      CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                      QIRsQREF3d,omegaIR3d,gIR3d,
+     &                      QREFvis3d,QREFir3d,
+     &                      omegaREFvis3d,omegaREFir3d)
+
+c     Computing aerosol optical depth in each layer:
+      CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &            pq,ccn,tauref,tau,aerosol,reffrad,nueffrad, QREFvis3d,
+     &            QREFir3d,omegaREFvis3d,omegaREFir3d,zdqnorm)
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+         nd=ngridmx-ig0
+        else
+         nd=ndomainsz
+        endif
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+           do iaer = 1, naerkind
+             do ich = 1, nsun
+               zQVISsQREF3d(ig,l,ich,iaer) = 
+     &                           QVISsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaVIS3d(ig,l,ich,iaer) = 
+     &                           omegaVIS3d(ig0+ig,l,ich,iaer)
+               zgVIS3d(ig,l,ich,iaer) = 
+     &                           gVIS3d(ig0+ig,l,ich,iaer)
+             enddo
+             do ich = 1, nir
+               zQIRsQREF3d(ig,l,ich,iaer) = 
+     &                           QIRsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaIR3d(ig,l,ich,iaer) = 
+     &                           omegaIR3d(ig0+ig,l,ich,iaer)
+               zgIR3d(ig,l,ich,iaer) = 
+     &                           gIR3d(ig0+ig,l,ich,iaer)
+             enddo
+           enddo
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          zplev(ig,l) = pplev(ig0+ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          zplay(ig,l) = pplay(ig0+ig,l)
+          zt(ig,l) = pt(ig0+ig,l)
+c         Thickness of each layer (Pa) :
+          zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
+         enddo
+        enddo
+
+        do n=1,naerkind
+          do l=1,nlaylte
+            do ig=1,nd
+              zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+            enddo
+          enddo
+        enddo
+
+        do j=1,2
+          do ig = 1,nd
+           zalbedo(ig,j) = albedo(ig0+ig,j)
+          enddo
+        enddo
+
+c       Intermediate  levels: (computing tlev)
+c       ---------------------------------------
+c       Extrapolation for the air temperature above the surface
+        DO ig=1,nd
+              zztlev(ig,1)=zt(ig,1)+
+     s        (zplev(ig,1)-zplay(ig,1))*
+     s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
+
+              zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
+        ENDDO
+
+        DO l=2,nlaylte
+         DO ig=1, nd
+               zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l)) 
+         ENDDO
+        ENDDO
+
+        DO ig=1, nd
+           zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
+        ENDDO
+
+
+c       Longwave ("lw") radiative transfer (= thermal infrared)
+c       -------------------------------------------------------
+        call lwmain (ig0,icount,nd,nflev
+     .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
+     .        ,zaerosol,zzdtlw
+     .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
+     .        ,znetrad
+     &        ,zQIRsQREF3d,zomegaIR3d,zgIR3d)
+
+c       Shortwave ("sw") radiative transfer (= solar radiation)
+c       -------------------------------------------------------
+c          Mars solar constant (W m-2)
+c          1370 W.m-2 is the solar constant at 1 AU.
+           cste_mars=1370./(dist_sol*dist_sol)
+
+           call swmain ( nd, nflev,
+     S     cste_mars, zalbedo,
+     S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
+     S     zzdtsw, zfluxd_sw, zfluxu_sw,
+     &     zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
+
+c       ------------------------------------------------------------
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          dtlw(ig0+ig,l) = zzdtlw(ig,l)
+          dtsw(ig0+ig,l) = zzdtsw(ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          ptlev(ig0+ig,l) = zztlev(ig,l)
+         enddo
+        enddo
+
+        do ig = 1,nd
+          fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+          fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+          fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+          fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+c     Zero tendencies for any remaining layers between nlaylte and nlayer
+      if (nlayer.gt.nlaylte) then
+         do l = nlaylte+1, nlayer
+            do ig = 1, ngrid
+               dtlw(ig, l) = 0.
+               dtsw(ig, l) = 0.
+            enddo
+         enddo
+      endif
+
+c     Output for debugging if lwrite=T
+c     --------------------------------
+c     Write all nlayer layers, even though only nlaylte layers may have
+c     non-zero tendencies.
+
+         IF(lwrite) THEN
+            PRINT*,'Diagnotique for the radiation'
+            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
+            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
+     s           fract(igout), fluxsurf_lw(igout),
+     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
+            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
+            PRINT*,'daysec',daysec
+            DO l=1,nlayer
+               PRINT*,pt(igout,l),ptlev(igout,l),
+     s         pplay(igout,l),pplev(igout,l),
+     s         dtsw(igout,l),dtlw(igout,l)
+            ENDDO
+         ENDIF
+
+
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/initracer_use.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/initracer_use.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/initracer_use.F	(revision 308)
@@ -0,0 +1,720 @@
+      SUBROUTINE initracer(qsurf,co2ice)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Initialization related to tracer 
+c   (transported dust, water, chemical species, ice...)
+c
+c   Name of the tracer
+c
+c   Test of dimension :
+c   Initialize COMMON tracer in tracer.h, using tracer names provided
+c   by the dynamics in "advtrac.h"
+c
+c   Old conventions: (not used any more)
+c
+c   If water=T : q(iq=nqmx) is the water mass mixing ratio
+c     and q(iq=nqmx-1) is the ice mass mixing ratio
+
+c   If there is transported dust, it uses iq=1 to iq=dustbin
+c   If there is no transported dust : dustbin=0
+c   If doubleq=T : q(iq=1) is the dust mass mixing ratio
+c                  q(iq=2) is the dust number mixing ratio 
+
+c   If (photochem.or.thermochem) there is "ncomp" chemical species (ncomp
+c   is set in aeronomars/chimiedata.h) using the ncomp iq values starting at
+c      iq=nqchem_min = dustbin+1   (nqchem_min is defined in inifis.F)
+c   
+c
+c   author: F.Forget
+c   ------
+c    Modifs: Franck Montmessin, Sebastien Lebonnois (june 2003)
+c            Ehouarn Millour (oct. 2008) identify tracers by their names
+c=======================================================================
+
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "tracer.h"
+#include "advtrac.h"
+#include "comgeomfi.h"
+#include "watercap.h"
+#include "chimiedata.h"
+
+#include "surfdat.h"
+
+      real qsurf(ngridmx,nqmx)       ! tracer on surface (e.g.  kg.m-2)
+      real co2ice(ngridmx)           ! co2 ice mass on surface (e.g.  kg.m-2)
+      integer iq,ig,count, yeyey
+      real r0_lift , reff_lift, nueff_lift
+c     Ratio of small over large dust particles (used when both 
+c       doubleq and the submicron mode are active); In Montmessin
+c       et al. (2002), a value of 25 has been deduced;
+      real, parameter :: popratio = 25.
+      logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
+      character(len=20) :: txt ! to store some text
+
+c-----------------------------------------------------------------------
+c  radius(nqmx)      ! aerosol particle radius (m)
+c  rho_q(nqmx)       ! tracer densities (kg.m-3)
+c  alpha_lift(nqmx)  ! saltation vertical flux/horiz flux ratio (m-1)
+c  alpha_devil(nqmx) ! lifting coeeficient by dust devil
+c  rho_dust          ! Mars dust density
+c  rho_ice           ! Water ice density
+c  nuice_ref         ! Effective variance nueff of the
+c                    !   water-ice size distributions
+c  doubleq           ! if method with mass (iq=1) and number(iq=2) mixing ratio
+c  varian            ! Characteristic variance of log-normal distribution
+c-----------------------------------------------------------------------
+
+      integer :: nqchem_start
+
+! Initialization: get tracer names from the dynamics and check if we are
+!                 using 'old' tracer convention ('q01',q02',...)
+!                 or new convention (full tracer names)
+      ! check if tracers have 'old' names
+      oldnames=.false.
+      count=0
+      do iq=1,nqmx
+        txt=" "
+        write(txt,'(a1,i2.2)') 'q',iq
+        if (txt.eq.tnom(iq)) then
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+      
+      if (count.eq.nqmx) then
+        write(*,*) "initracer: tracers seem to follow old naming ",
+     &             "convention (q01,q02,...)"
+        write(*,*) "   => will work for now ... "
+        write(*,*) "      but you should run newstart to rename them"
+        oldnames=.true.
+      endif
+
+      ! copy/set tracer names
+      if (oldnames) then ! old names (derived from iq & option values)
+        ! 1. dust:
+        if (dustbin.ne.0) then ! transported dust
+          do iq=1,dustbin
+            txt=" "
+            write(txt,'(a4,i2.2)') 'dust',iq
+            noms(iq)=txt
+            mmol(iq)=100.
+          enddo
+          ! special case if doubleq
+          if (doubleq) then
+            if (dustbin.ne.2) then
+              write(*,*) 'initracer: error expected dustbin=2'
+            else
+              noms(1)='dust_mass'   ! dust mass mixing ratio
+              noms(2)='dust_number' ! dust number mixing ratio
+            endif
+          endif
+        endif
+        ! 2. water & ice
+        if (water) then
+          noms(nqmx)='h2o_vap'
+          mmol(nqmx)=18.
+          noms(nqmx-1)='h2o_ice'
+          mmol(nqmx-1)=18.
+        endif
+        ! 3. Chemistry
+        if (photochem .or. callthermos) then
+          if (doubleq) then
+            nqchem_start=3
+          else
+            nqchem_start=dustbin+1
+          end if
+          do iq=nqchem_start,nqchem_start+ncomp-1
+            noms(iq)=nomchem(iq-nqchem_start+1)
+            mmol(iq)=mmolchem(iq-nqchem_start+1)
+          enddo
+        endif ! of if (photochem .or. callthermos)
+        ! 4. Other tracers ????
+        if ((dustbin.eq.0).and.(.not.water)) then
+          noms(1)='co2'
+          mmol(1)=44
+          if (nqmx.eq.2) then
+            noms(nqmx)='Ar_N2'
+            mmol(nqmx)=30
+          endif
+        endif
+      else
+        ! copy tracer names from dynamics
+        do iq=1,nqmx
+          noms(iq)=tnom(iq)
+        enddo
+        ! mmol(:) array is initialized later (see below)
+      endif ! of if (oldnames)
+
+      ! special modification when using 'old' tracers:
+      ! qsurf(nqmx) was h2o ice whereas q(nqmx) was water vapour
+      ! and (if iceparty) q(nqmx-1) was null whereas q(nqmx-1) was water ice
+      if (oldnames.and.water) then
+        write(*,*)'initracer: moving surface water ice to index ',nqmx-1
+        qsurf(1:ngridmx,nqmx-1)=qsurf(1:ngridmx,nqmx)
+        qsurf(1:ngridmx,nqmx)=0
+      endif 
+      
+c------------------------------------------------------------
+c     Test Dimensions tracers
+c------------------------------------------------------------
+
+! Ehouarn: testing number of tracers is obsolete...
+!      if(photochem.or.thermochem) then
+!          if (water) then
+!              if ((dustbin+ncomp+2).ne.nqmx) then
+!                 print*,'initracer: tracer dimension problem:'
+!                 print*,"(dustbin+ncomp+2).ne.nqmx"
+!                 print*,"ncomp: ",ncomp
+!                 print*,"dustbin: ",dustbin
+!                 print*,"nqmx: ",nqmx
+!                 print*,'Change ncomp in chimiedata.h'
+!               endif
+!          else
+!              if ((dustbin+ncomp+1).ne.nqmx) then
+!                 print*,'initracer: tracer dimension problem:'
+!                 print*,"(dustbin+ncomp+1).ne.nqmx"
+!                 print*,"ncomp: ",ncomp
+!                 print*,"dustbin: ",dustbin
+!                 print*,"nqmx: ",nqmx
+!                 print*,'Change ncomp in chimiedata.h'
+!                 STOP
+!               endif
+!            endif
+!      endif
+
+c------------------------------------------------------------
+c         NAME and molar mass of the tracer 
+c------------------------------------------------------------
+
+   
+! Identify tracers by their names: (and set corresponding values of mmol)
+      ! 0. initialize tracer indexes to zero:
+      do iq=1,nqmx
+        igcm_dustbin(iq)=0
+      enddo
+      igcm_dust_mass=0
+      igcm_dust_number=0
+      igcm_dust_submicron=0
+      igcm_h2o_vap=0
+      igcm_h2o_ice=0
+      igcm_co2=0
+      igcm_co=0
+      igcm_o=0
+      igcm_o1d=0
+      igcm_o2=0
+      igcm_o3=0
+      igcm_h=0
+      igcm_h2=0
+      igcm_oh=0
+      igcm_ho2=0
+      igcm_h2o2=0
+      igcm_n2=0
+      igcm_ar=0
+      igcm_ar_n2=0
+
+      ! 1. find dust tracers
+      count=0
+      if (dustbin.gt.0) then
+        do iq=1,nqmx
+          txt=" "
+          write(txt,'(a4,i2.2)')'dust',count+1
+          if (noms(iq).eq.txt) then
+            count=count+1
+            igcm_dustbin(count)=iq
+            mmol(iq)=100.
+          endif
+        enddo !do iq=1,nqmx
+      endif ! of if (dustbin.gt.0)
+      if (doubleq) then
+        do iq=1,nqmx
+          if (noms(iq).eq."dust_mass") then
+            igcm_dust_mass=iq
+            count=count+1
+          endif
+          if (noms(iq).eq."dust_number") then
+            igcm_dust_number=iq
+            count=count+1
+          endif
+        enddo
+      endif ! of if (doubleq)
+      if (submicron) then
+        do iq=1,nqmx
+          if (noms(iq).eq."dust_submicron") then
+            igcm_dust_submicron=iq
+            mmol(iq)=100.
+            count=count+1
+          endif
+        enddo
+      endif ! of if (submicron)
+      ! 2. find chemistry and water tracers
+      do iq=1,nqmx
+        if (noms(iq).eq."co2") then
+          igcm_co2=iq
+          mmol(igcm_co2)=44.
+          count=count+1
+        endif
+        if (noms(iq).eq."co") then
+          igcm_co=iq
+          mmol(igcm_co)=28.
+          count=count+1
+        endif
+        if (noms(iq).eq."o") then
+          igcm_o=iq
+          mmol(igcm_o)=16.
+          count=count+1
+        endif
+        if (noms(iq).eq."o1d") then
+          igcm_o1d=iq
+          mmol(igcm_o1d)=16.
+          count=count+1
+        endif
+        if (noms(iq).eq."o2") then
+          igcm_o2=iq
+          mmol(igcm_o2)=32.
+          count=count+1
+        endif
+        if (noms(iq).eq."o3") then
+          igcm_o3=iq
+          mmol(igcm_o3)=48.
+          count=count+1
+        endif
+        if (noms(iq).eq."h") then
+          igcm_h=iq
+          mmol(igcm_h)=1.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2") then
+          igcm_h2=iq
+          mmol(igcm_h2)=2.
+          count=count+1
+        endif
+        if (noms(iq).eq."oh") then
+          igcm_oh=iq
+          mmol(igcm_oh)=17.
+          count=count+1
+        endif
+        if (noms(iq).eq."ho2") then
+          igcm_ho2=iq
+          mmol(igcm_ho2)=33.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o2") then
+          igcm_h2o2=iq
+          mmol(igcm_h2o2)=34.
+          count=count+1
+        endif
+        if (noms(iq).eq."n2") then
+          igcm_n2=iq
+          mmol(igcm_n2)=28.
+          count=count+1
+        endif
+        if (noms(iq).eq."ar") then
+          igcm_ar=iq
+          mmol(igcm_ar)=40.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o_vap") then
+          igcm_h2o_vap=iq
+          mmol(igcm_h2o_vap)=18.
+          count=count+1
+        endif
+        if (noms(iq).eq."h2o_ice") then
+          igcm_h2o_ice=iq
+          mmol(igcm_h2o_ice)=18.
+          count=count+1
+        endif
+        ! Other stuff: e.g. for simulations using co2 + neutral gaz
+        if (noms(iq).eq."Ar_N2") then
+          igcm_ar_n2=iq
+          mmol(igcm_ar_n2)=30.
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqmx
+!      count=count+nbqchem
+      
+      ! check that we identified all tracers:
+      if (count.ne.nqmx) then
+        write(*,*) "initracer: found only ",count," tracers"
+        write(*,*) "               expected ",nqmx
+        do iq=1,count
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+        stop
+      else
+        write(*,*) "initracer: found all expected tracers, namely:"
+        do iq=1,nqmx
+          write(*,*)'      ',iq,' ',trim(noms(iq))
+        enddo
+      endif
+
+      ! if water cycle but iceparty=.false., there will nevertheless be
+      ! water ice at the surface (iceparty is not used anymore, but this
+      ! part is still relevant, as we want to stay compatible with the
+      ! older versions).
+      if (water.and.(igcm_h2o_ice.eq.0)) then
+        igcm_h2o_ice=igcm_h2o_vap ! so that qsurf(i_h2o_ice) is identified
+                                  ! even though there is no q(i_h2o_ice)
+      else
+       ! surface ice qsurf(i_h2o_ice) was loaded twice by phyetat0,
+       ! as qsurf(i_h2o_vap) & as qsurf(i_h2o_ice), so to be clean:
+       if (igcm_h2o_vap.ne.0) then
+         qsurf(1:ngridmx,igcm_h2o_vap)=0
+       endif
+      endif
+
+c------------------------------------------------------------
+c     Initialisation tracers ....
+c------------------------------------------------------------
+      call zerophys(nqmx,rho_q)
+
+      rho_dust=2500.  ! Mars dust density (kg.m-3)
+      rho_ice=920.    ! Water ice density (kg.m-3)
+      nuice_ref=0.1   ! Effective variance nueff of the
+                      ! water-ice size distributions
+
+      if (doubleq) then
+c       "doubleq" technique 
+c       -------------------
+c      (transport of mass and number mixing ratio)
+c       iq=1: Q mass mixing ratio, iq=2: N number mixing ratio
+
+        if( (nqmx.lt.2).or.(water.and.(nqmx.lt.4)) ) then
+          write(*,*)'initracer: nqmx is too low : nqmx=', nqmx
+          write(*,*)'water= ',water,' doubleq= ',doubleq   
+        end if
+
+        nueff_lift = 0.5
+        varian=sqrt(log(1.+nueff_lift))
+
+        rho_q(igcm_dust_mass)=rho_dust
+        rho_q(igcm_dust_number)=rho_dust
+
+c       Intermediate calcul for computing geometric mean radius r0
+c       as a function of mass and number mixing ratio Q and N
+c       (r0 = (r3n_q * Q/ N)^(1/3))
+        r3n_q = exp(-4.5*varian**2)*(3./4.)/(pi*rho_dust)
+
+c       Intermediate calcul for computing effective radius reff
+c       from geometric mean radius r0
+c       (reff = ref_r0 * r0)
+        ref_r0 = exp(2.5*varian**2)
+        
+c       lifted dust :
+c       '''''''''''
+        reff_lift = 3.0e-6 !3.e-6 !Effective radius of lifted dust (m)
+        alpha_devil(igcm_dust_mass)=9.e-9   !  dust devil lift mass coeff
+c       alpha_lift(igcm_dust_mass)=3.0e-15  !  Lifted mass coeff
+        alpha_lift(igcm_dust_mass)= 3.3e-10!1.e-6 !Lifted mass coeff
+
+        r0_lift = reff_lift/ref_r0
+        alpha_devil(igcm_dust_number)=r3n_q*
+     &                        alpha_devil(igcm_dust_mass)/r0_lift**3
+        alpha_lift(igcm_dust_number)=r3n_q*
+     &                        alpha_lift(igcm_dust_mass)/r0_lift**3
+
+        radius(igcm_dust_mass) = reff_lift
+        radius(igcm_dust_number) = reff_lift
+
+        write(*,*) "initracer: doubleq_param reff_lift:", reff_lift
+        write(*,*) "initracer: doubleq_param nueff_lift:", nueff_lift
+        write(*,*) "initracer: doubleq_param alpha_lift:",
+     &    alpha_lift(igcm_dust_mass)
+
+      else
+
+       if (dustbin.gt.1) then
+        print*,'initracer: STOP!',
+     $   ' properties of dust need to be set in initracer !!!'
+        stop
+
+       else if (dustbin.eq.1) then
+
+c       This will be used for 1 dust particle size:
+c       ------------------------------------------
+        radius(igcm_dustbin(1))=3.e-6
+        alpha_lift(igcm_dustbin(1))=0.0e-6
+        alpha_devil(igcm_dustbin(1))=7.65e-9
+        rho_q(igcm_dustbin(1))=rho_dust
+
+       endif
+      end if    ! (doubleq)
+
+c     Submicron dust mode:
+c     --------------------
+
+      if (submicron) then
+        radius(igcm_dust_submicron)=0.1e-6
+        rho_q(igcm_dust_submicron)=rho_dust
+        if (doubleq) then
+c         If doubleq is also active, we use the population ratio:
+          alpha_lift(igcm_dust_submicron) = 
+     &      alpha_lift(igcm_dust_number)*popratio*
+     &      rho_q(igcm_dust_submicron)*4./3.*pi*
+     &      radius(igcm_dust_submicron)**3.
+          alpha_devil(igcm_dust_submicron)=1.e-30
+        else
+          alpha_lift(igcm_dust_submicron)=1e-6
+          alpha_devil(igcm_dust_submicron)=1.e-30
+        endif ! (doubleq)
+      end if  ! (submicron)
+
+c     Initialization for photochemistry:
+c     ---------------------------------
+      if (photochem) then
+      ! initialize chemistry+water (water will be correctly initialized below)
+      ! by initializing everything which is not dust ...
+        do iq=1,nqmx
+          txt=noms(iq)
+          if (txt(1:4).ne."dust") then
+            radius(iq)=0.
+            alpha_lift(iq) =0.
+            alpha_devil(iq)=0.
+          endif
+        enddo ! do iq=1,nqmx
+      endif
+
+c     Initialization for water vapor
+c     ------------------------------
+      if(water) then
+         radius(igcm_h2o_vap)=0.
+         alpha_lift(igcm_h2o_vap) =0.
+         alpha_devil(igcm_h2o_vap)=0.
+
+c       "Dryness coefficient" controlling the evaporation and
+c        sublimation from the ground water ice (close to 1)
+c        HERE, the goal is to correct for the fact
+c        that the simulated permanent water ice polar caps
+c        is larger than the actual cap and the atmospheric
+c        opacity not always realistic.
+
+         do ig=1,ngridmx
+           if (ngridmx.ne.1) watercaptag(ig)=.false.
+           dryness(ig) = 1.
+         enddo
+
+         IF (caps) THEN
+c Perennial H20 north cap defined by watercaptag=true (allows surface to be
+c hollowed by sublimation in vdifc).
+         yeyey = 0
+         do ig=1,ngridmx
+!          !!! TESTS TESTS outliers
+!          !!! TESTS TESTS outliers
+!          if ( ( lati(ig)*180./pi      .ge.  75 ) .and.
+!     .         ( lati(ig)*180./pi      .le.  77 ) .and.
+!     .         ( ( ( long(ig)*180./pi .ge. 000. ) .and.
+!     .              ( long(ig)*180./pi .le. 120. ) ) 
+!     .             .or.
+!     .             ( ( long(ig)*180./pi .ge. -130. ) .and.
+!     .             ( long(ig)*180./pi .le. -115. ) ) ) ) then
+!             if (yeyey .eq. 0) then  !!! 1/2 en 64x48 sinon trop large en lat
+!              write(*,*) "outliers ", lati(ig)*180./pi, long(ig)*180./pi
+!              if (ngridmx.ne.1) watercaptag(ig)=.true.
+!              dryness(ig) = 1.
+!              albedodat(ig) = 0.45 !! comme alb_surfice
+!              yeyey = 1
+!             else
+!              yeyey = 0
+!             endif
+!          endif
+!          !!! TESTS TESTS outliers
+!          !!! TESTS TESTS outliers
+!
+!          !!! TESTS TESTS addcap
+!          !!! TESTS TESTS addcap     
+!          if ( ( lati(ig)*180./pi      .ge.  82 ) .and.
+!     .         ( lati(ig)*180./pi      .le.  84 ) .and.
+!     .         ( ( long(ig)*180./pi .gt. -030. ) .and.
+!     .              ( long(ig)*180./pi .lt. 090. ) ) ) then
+!              write(*,*) "capadd ", lati(ig)*180./pi, long(ig)*180./pi
+!              if (ngridmx.ne.1) watercaptag(ig)=.true.
+!              albedodat(ig) = 0.45 !! comme alb_surfice
+!              dryness(ig) = 1.
+!          endif
+!          !!! TESTS TESTS addcap
+!          !!! TESTS TESTS addcap 
+    
+           if (lati(ig)*180./pi.gt.84) then
+             if (ngridmx.ne.1) watercaptag(ig)=.true.
+             dryness(ig) = 1.
+c Use the following cap definition for high spatial resolution (latitudinal bin <= 5 deg)
+c	      if (lati(ig)*180./pi.lt.85.and.long(ig).ge.0) then
+c	        if (ngridmx.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+c             if (lati(ig)*180./pi.ge.85) then
+c               if (ngridmx.ne.1) watercaptag(ig)=.true.
+c               dryness(ig) = 1.
+c	      endif
+           endif  ! (lati>80 deg)
+         end do ! (ngridmx)
+        ENDIF ! (caps)
+
+         if(water.and.(nqmx.ge.2)) then
+           radius(igcm_h2o_ice)=3.e-6
+           rho_q(igcm_h2o_ice)=rho_ice
+           alpha_lift(igcm_h2o_ice) =0.
+           alpha_devil(igcm_h2o_ice)=0.
+         elseif(water.and.(nqmx.lt.2)) then
+            write(*,*) 'nqmx is too low : nqmx=', nqmx
+            write(*,*) 'water= ',water
+         endif
+
+      end if  ! (water)
+
+c     Output for records:
+c     ~~~~~~~~~~~~~~~~~~
+      write(*,*)
+      Write(*,*) '******** initracer : dust transport parameters :'
+      write(*,*) 'alpha_lift = ', alpha_lift
+      write(*,*) 'alpha_devil = ', alpha_devil
+      write(*,*) 'radius  = ', radius
+      if(doubleq) then
+        write(*,*) 'reff_lift (um) =  ', reff_lift
+        write(*,*) 'size distribution variance  = ', varian
+        write(*,*) 'r3n_q , ref_r0 : ', r3n_q , ref_r0
+      end if
+
+!
+!     some extra (possibly redundant) sanity checks for tracers: 
+!     ---------------------------------------------------------
+
+       if (doubleq) then 
+       ! verify that we indeed have dust_mass and dust_number tracers 
+         if (igcm_dust_mass.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use doubleq option without ",
+     &                "a dust_mass tracer !"
+           stop
+         endif
+         if (igcm_dust_number.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use doubleq option without ",
+     &                "a dust_number tracer !"
+           stop
+         endif
+       endif
+
+       if ((.not.doubleq).and.(dustbin.gt.0)) then
+       ! verify that we indeed have 'dustbin' dust tracers
+         count=0
+         do iq=1,dustbin
+           if (igcm_dustbin(iq).ne.0) then
+             count=count+1
+           endif
+         enddo
+         if (count.ne.dustbin) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  dusbin is set to ",dustbin,
+     &                " but we only have the following dust tracers:"
+           do iq=1,count
+             write(*,*)"   ",trim(noms(igcm_dustbin(iq)))
+           enddo
+           stop
+         endif
+       endif
+
+       if (water) then
+       ! verify that we indeed have h2o_vap and h2o_ice tracers
+         if (igcm_h2o_vap.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use water option without ",
+     &                "an h2o_vap tracer !"
+           stop
+         endif
+         if (igcm_h2o_ice.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use water option without ",
+     &                "an h2o_ice tracer !"
+           stop
+         endif
+       endif
+
+       if (photochem .or. callthermos) then
+       ! verify that we indeed have the chemistry tracers
+         if (igcm_co2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a co2 tracer !"
+         stop
+         endif
+         if (igcm_co.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a co tracer !"
+         stop
+         endif
+         if (igcm_o.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a o tracer !"
+         stop
+         endif
+         if (igcm_o1d.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a o1d tracer !"
+         stop
+         endif
+         if (igcm_o2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an o2 tracer !"
+         stop
+         endif
+         if (igcm_o3.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an o3 tracer !"
+         stop
+         endif
+         if (igcm_h.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a h tracer !"
+         stop
+         endif
+         if (igcm_h2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a h2 tracer !"
+         stop
+         endif
+         if (igcm_oh.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an oh tracer !"
+         stop
+         endif
+         if (igcm_ho2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a ho2 tracer !"
+         stop
+         endif
+         if (igcm_h2o2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a h2o2 tracer !"
+         stop
+         endif
+         if (igcm_n2.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "a n2 tracer !"
+         stop
+         endif
+         if (igcm_ar.eq.0) then
+           write(*,*) "initracer: error !!"
+           write(*,*) "  cannot use chemistry option without ",
+     &                "an ar tracer !"
+         stop
+         endif
+       endif ! of if (photochem .or. callthermos)
+
+      end
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/physiq_modif_use.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/physiq_modif_use.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/GCM_modif/physiq_modif_use.F	(revision 308)
@@ -0,0 +1,1503 @@
+      SUBROUTINE physiq(ngrid,nlayer,nq,
+     $            firstcall,lastcall,
+     $            pday,ptime,ptimestep,
+     $            pplev,pplay,pphi,
+     $            pu,pv,pt,pq,
+     $            pw,
+     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn)
+
+
+      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. Renormalisation
+c     11. 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     12. 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           
+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    pw(ngrid,?)           vertical velocity
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx,nqmx)   /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "watercap.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx) ! surface pressure tendency
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind)
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad_sky(ngridmx)      ! rad. flux from sky absorbed by surface (W.m-2)
+      REAL fluxrad(ngridmx)          ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy 
+      INTEGER ig_vl1                 ! Grid Point near VL1   (for diagnostic) 
+
+c     Variables used by the water ice microphysical scheme:
+      REAL rice(ngridmx,nlayermx)    ! Water ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+                                     !   of the size distribution
+c     Albedo of deposited surface ice
+      !!REAL, PARAMETER :: alb_surfice = 0.4 ! 0.45
+      REAL, PARAMETER :: alb_surfice = 0.45 !!TESTS_JB 
+
+      SAVE day_ini, icount
+      SAVE aerosol, tsurf,tsoil
+      SAVE co2ice,albedo,emis, q2
+      SAVE capcal,fluxgrd,dtrad,fluxrad,fluxrad_sky,qsurf
+      SAVE ig_vl1
+
+      REAL stephan   
+      DATA stephan/5.67e-08/  ! Stephan Boltzman constant
+      SAVE stephan
+
+c Local variables :
+c -----------------
+
+      REAL CBRT
+      EXTERNAL CBRT
+
+      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq,i, tapphys
+
+      REAL fluxsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngridmx)           ! Reference column optical depth at 700 Pa
+                                     ! (used if active=F) 
+      REAL tau(ngridmx,naerkind)     ! Column dust optical depth at each point
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngridmx,nlayermx)   ! altitude at the middle of the layers
+      REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries
+      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngridmx,nqmx)
+      REAL zdtlw(ngridmx,nlayermx)     ! (K/s)
+      REAL zdtsw(ngridmx,nlayermx)     ! (K/s)
+      REAL cldtlw(ngridmx,nlayermx)     ! (K/s) LW heating rate for clear area
+      REAL cldtsw(ngridmx,nlayermx)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngridmx,nlayermx) ! (K/s)
+      REAL zdtnlte(ngridmx,nlayermx)   ! (K/s)
+      REAL zdtsurf(ngridmx)            ! (K/s)
+      REAL zdtcloud(ngridmx,nlayermx)
+      REAL zdvdif(ngridmx,nlayermx),zdudif(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhdif(ngridmx,nlayermx), zdtsdif(ngridmx)         ! (K/s)
+      REAL zdvadj(ngridmx,nlayermx),zduadj(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhadj(ngridmx,nlayermx)                           ! (K/s)
+      REAL zdtgw(ngridmx,nlayermx)                            ! (K/s)
+      REAL zdugw(ngridmx,nlayermx),zdvgw(ngridmx,nlayermx)    ! (m.s-2)
+      REAL zdtc(ngridmx,nlayermx),zdtsurfc(ngridmx)
+      REAL zdvc(ngridmx,nlayermx),zduc(ngridmx,nlayermx)
+
+      REAL zdqdif(ngridmx,nlayermx,nqmx), zdqsdif(ngridmx,nqmx)
+      REAL zdqsed(ngridmx,nlayermx,nqmx), zdqssed(ngridmx,nqmx)
+      REAL zdqdev(ngridmx,nlayermx,nqmx), zdqsdev(ngridmx,nqmx)
+      REAL zdqadj(ngridmx,nlayermx,nqmx)
+      REAL zdqc(ngridmx,nlayermx,nqmx)
+      REAL zdqcloud(ngridmx,nlayermx,nqmx)
+      REAL zdqscloud(ngridmx,nqmx)
+      REAL zdqchim(ngridmx,nlayermx,nqmx)
+      REAL zdqschim(ngridmx,nqmx)
+      REAL zdqnorm(ngridmx,nlayermx,2)                     !quantity of dust which have to be added by the dynamical core
+
+
+      REAL zdteuv(ngridmx,nlayermx)    ! (K/s)
+      REAL zdtconduc(ngridmx,nlayermx) ! (K/s)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngridmx)
+      REAL zplanck(ngridmx),zpopsk(ngridmx,nlayermx)
+      REAL zdum1(ngridmx,nlayermx)
+      REAL zdum2(ngridmx,nlayermx)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngridmx,nlayermx)
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngridmx), zt(ngridmx,nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL fluxtop_sw_tot(ngridmx), fluxsurf_sw_tot(ngridmx)
+      character*2 str2
+      character*5 str5
+      real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      SAVE ccn  !! in case iradia != 1
+      real rdust(ngridmx,nlayermx) ! dust geometric mean radius (m)
+      real qtot1,qtot2 ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+      real co2col(ngridmx)        ! CO2 column
+      REAL zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      REAL zstress(ngrid), cd
+      real hco2(nqmx),tmean, zlocal(nlayermx)
+      real rho(ngridmx,nlayermx)  ! density
+      real vmr(ngridmx,nlayermx)  ! volume mixing ratio
+      REAL mtot(ngridmx)          ! Total mass of water vapor (kg/m2)
+      REAL icetot(ngridmx)        ! Total mass of water ice (kg/m2)
+      REAL rave(ngridmx)          ! Mean water ice effective radius (m)
+      REAL opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+      REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! Water ice absorption coefficient
+
+
+      REAL time_phys
+
+c=======================================================================
+
+c 1. Initialisation:
+c -----------------
+
+c  1.1   Initialisation only at first call
+c  ---------------------------------------
+      IF (firstcall) THEN
+
+c        variables set to 0
+c        ~~~~~~~~~~~~~~~~~~
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         call zerophys(ngrid*nlayer,dtrad)
+         call zerophys(ngrid,fluxrad)
+
+c        read startfi 
+c        ~~~~~~~~~~~~
+
+! Read netcdf initial physical parameters.
+         CALL phyetat0 ("startfi.nc",0,0,
+     &         nsoilmx,nq,
+     &         day_ini,time_phys,
+     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+
+         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
+
+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
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         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
+
+
+c        initialize tracers
+c        ~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         ENDIF  ! end tracer
+
+c        Determining gridpoint near Viking Lander 1 (used for diagnostic only)
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+         if(ngrid.ne.1) then
+           latvl1= 22.27 
+           lonvl1= -47.94 
+           ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.)  -2 )*iim +
+     &              int(1.5+(lonvl1+180)*iim/360.)
+           write(*,*) 'Viking Lander 1 GCM point: lat,lon',
+     &              lati(ig_vl1)*180/pi, long(ig_vl1)*180/pi
+         end if 
+
+c        Initialize thermospheric parameters
+c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+         if (callthermos) call param_read
+
+c        Initialize R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+
+        IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+          write(*,*)"physiq: water_param Surface ice alb:",alb_surfice
+        ENDIF
+                   
+      ENDIF        !  (end of "if firstcall")
+
+c ---------------------------------------------------
+c 1.2   Initializations done at every physical timestep:
+c ---------------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+c     Initialize various variables
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      call zerophys(ngrid*nlayer, pdv)
+      call zerophys(ngrid*nlayer, pdu)
+      call zerophys(ngrid*nlayer, pdt)
+      call zerophys(ngrid*nlayer*nq, pdq)
+      call zerophys(ngrid, pdpsrf)
+      call zerophys(ngrid, zflubid)
+      call zerophys(ngrid, zdtsurf)
+      call zerophys(ngrid*nq, dqsurf)
+      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     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=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Compute potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      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)
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    1.2.5 Compute mean mass, cp, and R
+c    --------------------------------
+
+      if(photochem.or.callthermos) then
+         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+      endif
+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, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+     &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+
+c          Note: Dustopacity.F has been transferred to callradite.F
+         
+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,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice,zdqnorm)
+
+c          CO2 near infrared absorption
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           call zerophys(ngrid*nlayer,zdtnirco2)
+           if (callnirco2) then
+              call nirco2abs (ngrid,nlayer,pplay,dist_sol,
+     .                       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, pplay,
+     &             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)
+           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,
+     &                 pplay,pplev,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    -----------------------------------------
+c
+      IF (calldifv) THEN
+
+
+         DO ig=1,ngrid
+            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
+         ENDDO
+
+         CALL zerophys(ngrid*nlayer,zdum1)
+         CALL zerophys(ngrid*nlayer,zdum2)
+         do l=1,nlayer
+            do ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            enddo
+         enddo
+         
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif)
+
+         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
+
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+zdtsdif(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)+ 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    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+      ENDIF ! of IF (calldifv)
+
+
+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
+         CALL zerophys(ngrid*nlayer,zduadj)
+         CALL zerophys(ngrid*nlayer,zdvadj)
+         CALL zerophys(ngrid*nlayer,zdhadj)
+
+         CALL convadj(ngrid,nlayer,nq,ptimestep,
+     $                pplay,pplev,zpopsk,
+     $                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. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      IF (callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,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)
+
+      ENDIF  ! of IF (callcond)
+
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if (tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+           call watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,
+     &                ccn,rdust,rice,nuice)
+           if (activice) then
+c Temperature variation due to latent heat release
+           DO l=1,nlayer
+             DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+             ENDDO
+           ENDDO
+           endif
+
+! increment water vapour and ice atmospheric tracers tendencies
+           IF (water) THEN
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o_vap)=pdq(ig,l,igcm_h2o_vap)+
+     &                                   zdqcloud(ig,l,igcm_h2o_vap)
+                 pdq(ig,l,igcm_h2o_ice)=pdq(ig,l,igcm_h2o_ice)+
+     &                                   zdqcloud(ig,l,igcm_h2o_ice)
+               ENDDO
+             ENDDO
+           ENDIF ! of IF (water) THEN
+! Increment water ice surface tracer tendency
+         DO ig=1,ngrid
+           dqsurf(ig,igcm_h2o_ice)=dqsurf(ig,igcm_h2o_ice)+
+     &                               zdqscloud(ig,igcm_h2o_ice)
+         ENDDO
+         
+         END IF  ! of IF (water)
+
+c   7b. Chemical species
+c     ------------------
+
+c        --------------
+c        photochemistry :
+c        --------------
+         IF (photochem .or. thermochem) then
+          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+     &      zzlay,zday,pq,pdq,rice,
+     &      zdqchim,zdqschim,zdqcloud,zdqscloud)
+!NB: Photochemistry includes condensation of H2O2
+
+           ! 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)
+
+c   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,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 
+           !call zerophys(ngrid*nlayer*nq, zdqsed)
+           zdqsed(1:ngrid,1:nlayer,1:nq)=0
+           !call zerophys(ngrid*nq, zdqssed)
+           zdqssed(1:ngrid,1:nq)=0
+
+           call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt, rdust, rice,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+
+           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   7d. 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) 
+
+
+c-----------------------------------------------------------------------
+c   8. THERMOSPHERE CALCULATION
+c-----------------------------------------------------------------------
+
+      if (callthermos) then
+        call thermosphere(pplev,pplay,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)
+
+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.(ngridmx.NE.1)) THEN
+         if (caps.and.(obliquit.lt.27.)) then
+           ! NB: Updated surface pressure, at grid point 'ngrid', is
+           !     ps(ngrid)=pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
+           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
+     &                     (pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
+         endif
+c       -------------------------------------------------------------
+c       Change of surface albedo (set to 0.4) 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.0.005)) then
+              albedo(ig,1) = alb_surfice
+              albedo(ig,2) = alb_surfice
+           endif
+         enddo  ! of do ig=1,ngrid
+      ENDIF  ! of IF (tracer.AND.water.AND.(ngridmx.NE.1))
+
+c
+c   9.2 Compute soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     &          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+      ENDIF
+c-----------------------------------------------------------
+c   10. Renormalisation
+c------------------------------------------------------------
+            DO l=1,nlayer
+              DO ig=1,ngrid
+                pdq(ig,l,igcm_dust_mass)=pdq(ig,l,igcm_dust_mass)+
+     &                                      zdqnorm(ig,l,1)/ptimestep
+                pdq(ig,l,igcm_dust_number)=pdq(ig,l,igcm_dust_number)+ 
+     &                                      zdqnorm(ig,l,2)/ptimestep
+              ENDDO
+            ENDDO
+
+            PRINT*, 'pdqphys', pdq(10,10,igcm_dust_mass)
+
+c-----------------------------------------------------------------------
+c  11. 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
+
+      ! surface pressure
+      DO ig=1,ngrid
+          ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+      ENDDO
+
+      ! pressure
+      DO l=1,nlayer
+        DO ig=1,ngrid
+             zplev(ig,l)=pplev(ig,l)/pplev(ig,1)*ps(ig)
+             zplay(ig,l)=pplay(ig,l)/pplev(ig,1)*ps(ig)
+        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
+
+c    Compute surface stress : (NB: z0 is a common in planete.h)
+c     DO ig=1,ngrid
+c        cd = (0.4/log(zzlay(ig,1)/z0))**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   pplev(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)
+
+      IF (ngrid.NE.1) THEN
+         print*,'Ls =',zls*180./pi,
+     &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2),
+     &   ' tau(Viking1) =',tau(ig_vl1,1)
+
+
+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(lastcall) THEN
+            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+            write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+     .              ptimestep,pday,
+     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+     .              zgam,zthe)
+         ENDIF
+
+c        -------------------------------------------------------------------
+c        Calculation of diagnostic variables written in both stats and
+c          diagfi files
+c        -------------------------------------------------------------------
+
+         if (tracer) then
+           if (water) then
+
+             call zerophys(ngrid,mtot)
+             call zerophys(ngrid,icetot)
+             call zerophys(ngrid,rave)
+             call zerophys(ngrid,tauTES)
+             do ig=1,ngrid 
+               do l=1,nlayermx
+                 mtot(ig) = mtot(ig) + 
+     &                      zq(ig,l,igcm_h2o_vap) * 
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g
+                 icetot(ig) = icetot(ig) + 
+     &                        zq(ig,l,igcm_h2o_ice) * 
+     &                        (pplev(ig,l) - pplev(ig,l+1)) / g
+                 rave(ig) = rave(ig) + 
+     &                      zq(ig,l,igcm_h2o_ice) *
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g * 
+     &                      rice(ig,l) * (1.+nuice_ref)
+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) *
+     &             (pplev(ig,l) - pplev(ig,l+1)) / g
+     &             / (rho_ice * rice(ig,l) * (1.+nuice_ref))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+               rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
+             enddo
+
+           endif ! of if (water)
+         endif ! of if (tracer)
+
+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,"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","none",3,rho)
+           call wstats(ngrid,"pressure","Pressure","Pa",3,pplay)
+c          call wstats(ngrid,"q2",
+c    &                "Boundary layer eddy kinetic energy",
+c    &                "m2.s-2",3,q2)
+c          call wstats(ngrid,"emis","Surface emissivity","w.m-1",2,
+c    &                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 (tracer) then
+             if (water) then
+               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_vap)
+     &                  *mugaz/mmol(igcm_h2o_vap)
+               call wstats(ngrid,"vmr_h2ovapor",
+     &                    "H2O vapor volume mixing ratio","mol/mol",
+     &                    3,vmr)
+               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+     &                  *mugaz/mmol(igcm_h2o_ice)
+               call wstats(ngrid,"vmr_h2oice",
+     &                    "H2O ice 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,"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)
+c              call wstats(ngrid,"rice",
+c    &                    "Ice particle size","m",
+c    &                    3,rice)
+c              If activice is true, tauTES is computed in aeropacity.F;
+               if (.not.activice) then
+                 call wstats(ngrid,"tauTESap",
+     &                      "tau abs 825 cm-1","",
+     &                      2,tauTES)
+               endif
+
+             endif ! of if (water)
+
+             if (thermochem.or.photochem) then
+                do iq=1,nq
+                   if ((noms(iq).eq."o").or.(noms(iq).eq."co2").or.
+     .                (noms(iq).eq."co").or.(noms(iq).eq."n2").or.
+     .                (noms(iq).eq."h2").or.
+     .                (noms(iq).eq."o3")) then
+                        do l=1,nlayer
+                          do ig=1,ngrid
+                            vmr(ig,l)=zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
+                          end do
+                        end do
+                        call wstats(ngrid,"vmr_"//trim(noms(iq)),
+     .                     "Volume mixing ratio","mol/mol",3,vmr)
+                   endif
+                enddo
+             endif ! of if (thermochem.or.photochem)
+
+           endif ! 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
+
+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 !!
+        call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
+     &                  emis)
+         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)
+c         call WRITEDIAGFI(ngrid,"fluxsurf_lw","fluxsurf_lw","W.m-2",2,
+c     &                  fluxsurf_lw)
+c         call WRITEDIAGFI(ngrid,"fluxsurf_sw","fluxsurf_sw","W.m-2",2,
+c     &                  fluxsurf_sw_tot)
+c         call WRITEDIAGFI(ngrid,"fluxtop_lw","fluxtop_lw","W.m-2",2,
+c     &                  fluxtop_lw)
+c         call WRITEDIAGFI(ngrid,"fluxtop_sw","fluxtop_sw","W.m-2",2,
+c     &                  fluxtop_sw_tot)
+         call WRITEDIAGFI(ngrid,"temp","temperature","K",3,zt)
+c        call WRITEDIAGFI(ngrid,"tau","tau"," ",2,tau)
+        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)
+c         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)
+c        call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,pplay)
+c        call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2,
+c    &                  zstress)
+c        call WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate',
+c    &                   'w.m-2',3,zdtsw)
+c        call WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate',
+c    &                   'w.m-2',3,zdtlw)
+
+!!!!!!!!!!!!!!!!!!!!!!!!SOIL SOIL SOIL
+        call WRITEDIAGFI(ngrid,"tsoil","Soil temperature",
+     &                       "K",3,tsoil)
+        call WRITEDIAGFI(ngrid,"inertiedat","Soil inertia",
+     &                       "K",3,inertiedat)
+!!!!!!!!!!!!!!!!!!!!!!!!SOIL SOIL SOIL
+
+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
+         call zerophys(ngrid,co2col)
+         do l=1,nlayermx
+           do ig=1,ngrid
+             co2col(ig)=co2col(ig)+
+     &                  zq(ig,l,igcm_co2)*(pplev(ig,l)-pplev(ig,l+1))/g
+           enddo
+         enddo
+c         call WRITEDIAGFI(ngrid,"co2col","CO2 column","kg.m-2",2,
+c     &                  co2col)
+         endif ! of if (tracer.and.(igcm_co2.ne.0))
+
+c        ----------------------------------------------------------
+c        Outputs of the water cycle
+c        ----------------------------------------------------------
+         if (tracer) then
+           if (water) then
+
+            !!!! waterice = q01, voir readmeteo.F90
+            call WRITEDIAGFI(ngridmx,'q01',noms(igcm_h2o_ice),
+     &                      'kg/kg',3,
+     &                       zq(1:ngridmx,1:nlayermx,igcm_h2o_ice))
+            !!!! watervapor = q02, voir readmeteo.F90
+            call WRITEDIAGFI(ngridmx,'q02',noms(igcm_h2o_vap),
+     &                      'kg/kg',3,
+     &                       zq(1:ngridmx,1:nlayermx,igcm_h2o_vap))
+            !!!! surface waterice qsurf02 (voir readmeteo)
+            call WRITEDIAGFI(ngridmx,'qsurf02','surface tracer',
+     &                      'kg.m-2',2,
+     &                       qsurf(1:ngridmx,igcm_h2o_ice))
+
+             CALL WRITEDIAGFI(ngridmx,'mtot',
+     &                       'total mass of water vapor',
+     &                       'kg/m2',2,mtot)
+             CALL WRITEDIAGFI(ngridmx,'icetot',
+     &                       'total mass of water ice',
+     &                       'kg/m2',2,icetot)
+cc            vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+cc    &                *mugaz/mmol(igcm_h2o_ice)
+cc            call WRITEDIAGFI(ngridmx,'vmr_h2oice','h2o ice vmr',
+cc    &                       'mol/mol',3,vmr)
+c             CALL WRITEDIAGFI(ngridmx,'reffice',
+c     &                       'Mean reff',
+c     &                       'm',2,rave)
+cc            call WRITEDIAGFI(ngridmx,'rice','Ice particle size',
+cc    &                       'm',3,rice)
+cc            If activice is true, tauTES is computed in aeropacity.F;
+c             if (.not.activice) then
+c               CALL WRITEDIAGFI(ngridmx,'tauTESap',
+c     &                         'tau abs 825 cm-1',
+c     &                         '',2,tauTES)
+c             endif
+c             call WRITEDIAGFI(ngridmx,'h2o_ice_s',
+c     &                       'surface h2o_ice',
+c     &                       'kg.m-2',2,qsurf(1,igcm_h2o_ice))
+           endif !(water)
+
+
+           if (water.and..not.photochem) then
+             iq=nq
+c            write(str2(1:2),'(i2.2)') iq
+c            call WRITEDIAGFI(ngridmx,'dqs'//str2,'dqscloud',
+c    &                       'kg.m-2',2,zdqscloud(1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqch'//str2,'var chim',
+c    &                       'kg/kg',3,zdqchim(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqd'//str2,'var dif',
+c    &                       'kg/kg',3,zdqdif(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqa'//str2,'var adj',
+c    &                       'kg/kg',3,zdqadj(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'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        ----------------------------------------------------------
+
+c        call WRITEDIAGFI(ngridmx,'tauref',
+c    &                    'Dust ref opt depth','NU',2,tauref)
+
+         if (tracer.and.(dustbin.ne.0)) then
+c          call WRITEDIAGFI(ngridmx,'tau','taudust','SI',2,tau(1,1))
+           if (doubleq) then
+cc            call WRITEDIAGFI(ngridmx,'qsurf','qsurf',
+cc    &                       'kg.m-2',2,qsurf(1,1))
+cc            call WRITEDIAGFI(ngridmx,'Nsurf','N particles',
+cc    &                       'N.m-2',2,qsurf(1,2))
+cc            call WRITEDIAGFI(ngridmx,'dqsdev','ddevil lift',
+cc    &                       'kg.m-2.s-1',2,zdqsdev(1,1))
+cc            call WRITEDIAGFI(ngridmx,'dqssed','sedimentation',
+cc    &                       'kg.m-2.s-1',2,zdqssed(1,1))
+c             call WRITEDIAGFI(ngridmx,'reffdust','reffdust',
+c     &                        'm',3,rdust*ref_r0)
+             call WRITEDIAGFI(ngridmx,'dustq','Dust mass mr',
+     &                        'kg/kg',3,pq(1,1,igcm_dust_mass))
+            call WRITEDIAGFI(ngridmx,'dustN','Dust number',
+     &                        'part/kg',3,pq(1,1,igcm_dust_number))
+           else
+             do iq=1,dustbin
+               write(str2(1:2),'(i2.2)') iq
+               call WRITEDIAGFI(ngridmx,'q'//str2,'mix. ratio',
+     &                         'kg/kg',3,zq(1,1,iq))
+               call WRITEDIAGFI(ngridmx,'qsurf'//str2,'qsurf',
+     &                         'kg.m-2',2,qsurf(1,iq))
+             end do
+           endif ! (doubleq)
+c          if (submicron) then
+c            call WRITEDIAGFI(ngridmx,'dustsubm','subm mass mr',
+c    &                        'kg/kg',3,pq(1,1,igcm_dust_submicron))
+c          endif ! (submicron)
+         end if  ! (tracer.and.(dustbin.ne.0))
+
+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        ==========================================================
+
+      ELSE     ! if(ngrid.eq.1)
+
+         print*,'Ls =',zls*180./pi,
+     &  '  tauref(700 Pa) =',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')
+
+! or output in diagfi.nc (for testphys1d)
+         call WRITEDIAGFI(ngridmx,'ps','Surface pressure','Pa',0,ps)
+         call WRITEDIAGFI(ngridmx,'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(ngridmx,trim(noms(iq)),
+     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
+            end do
+         end if
+
+         zlocal(1)=-log(pplay(1,1)/pplev(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(pplay(1,l)/pplay(1,l-1))*rnew(1,l)*tmean/g
+         enddo
+         zlocal(nlayer)= zlocal(nlayer-1)-
+     &                   log(pplay(1,nlayer)/pplay(1,nlayer-1))*
+     &                   rnew(1,nlayer)*tmean/g
+
+      END IF       ! if(ngrid.ne.1)
+
+      icount=icount+1
+      RETURN
+      END
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity.F	(revision 308)
@@ -0,0 +1,1 @@
+link aeropacity_tachemobile_z.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachefixe.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachefixe.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachefixe.F	(revision 308)
@@ -0,0 +1,634 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &    pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d,dsodust)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   update J FAURE & A SPIGA
+c       - dust storm in a stationnary case
+c
+c
+c
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL dsodust(ngridmx,nlayermx)
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL nueffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+      REAL qdust(ngridmx,nlayermx) ! True dust mass mixing ratio
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL qtot(ngridmx)           ! Dust column (kg m-2)
+
+c     CCN reduction factor
+      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
+
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+c     Level under which the dust mixing ratio is held constant
+c       when computing the dust opacity in each layer
+c       (this applies when doubleq and active are true)
+      INTEGER, PARAMETER :: cstdustlevel = 7
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c **********************************************************
+c    Declaration special local dust storm TASI
+         logical localstorm
+         real taulocref,ztoploc,radloc,lonloc,latloc,ray
+         integer ltoploc
+         real taureftache(ngrid)
+         real tauloc ! diagnostic only
+c **********************************************************
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: txt ! to temporarly store text
+      CHARACTER(LEN=1) :: txt2 ! to temporarly store text
+! indexes of dust scatterers:
+      INTEGER,SAVE :: iaerdust(naerkind)
+      INTEGER,SAVE :: naerdust ! number of dust scatterers
+
+      tau(1:ngrid,1:naerkind)=0
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify scatterers that are dust
+        naerdust=0
+        DO iaer=1,naerkind
+          txt=name_iaer(iaer)
+          IF (txt(1:4).eq."dust") THEN
+            naerdust=naerdust+1
+            iaerdust(naerdust)=iaer
+          ENDIF
+        ENDDO
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          txt=noms(iq)
+          IF (txt(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        msolsir(1:nlayer,1:naerkind)=0
+        mqextsqabs(1:nlayer,1:naerkind)=0
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+        firstcall=.false.
+
+      END IF
+
+c     Vertical column optical depth at 700.Pa 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF(iaervar.eq.1) THEN 
+         do ig=1, ngridmx
+          tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                       ! or read in starfi
+        end do
+      ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+        tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+
+      ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+        taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+        tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+        tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+        do ig=1,ngrid/2  ! Northern hemisphere
+          tauref(ig)= tauN +
+     &    (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+        end do
+        do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+          tauref(ig)= tauS +
+     &    (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+        end do
+      ELSE IF ((iaervar.eq.4).or.
+     &        ((iaervar.ge.24).and.(iaervar.le.26)))
+     &     THEN  ! << "TES assimilated dust scenarios >>
+        call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+      ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+        tauref(1) = 2.5
+        if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+      ELSE
+        stop 'problem with iaervar in aeropacity.F'
+      ENDIF
+
+
+
+
+c -----------------------------------------------------------------
+c Computing the opacity in each layer
+c -----------------------------------------------------------------
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind      ! Typical dust profile
+c==================================================================
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+
+          expfactor=0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+            ENDDO
+          ENDDO
+
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c==================================================================
+        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) =
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("dust_submicron") aerkind   ! Small dust population
+c==================================================================
+
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("h2o_ice") aerkind             ! Water ice crystals
+c==================================================================
+
+c       1. Initialization
+        aerosol(1:ngrid,1:nlayer,iaer) = 0.
+        taucloudvis(1:ngrid) = 0.
+        taucloudtes(1:ngrid) = 0.
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) = max(1E-20,
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        pq(ig,l,i_ice) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+     &                              )
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauVIS','tauext VIS refwvl',
+     &      ' ',2,taucloudvis)
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'tauVIS','tauext VIS refwvl',
+     &        ' ',2,taucloudvis)
+            CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &        ' ',2,taucloudtes)
+          ENDIF
+        ELSE
+c         CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+c==================================================================
+        END SELECT aerkind
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+c -----------------------------------------------------------------
+c Rescaling each layer to reproduce the choosen (or assimilated)
+c   dust extinction opacity at visible reference wavelength, which
+c   is originally scaled to an equivalent 700Pa pressure surface.
+c -----------------------------------------------------------------
+
+      taudusttmp(1:ngrid)=0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+
+c----------------------------------
+c           Scaling factor:
+c---------------------------------
+            taudusttmp(ig) = taudusttmp(ig) +
+     &                       aerosol(ig,l,iaerdust(iaer))
+          ENDDO
+        ENDDO
+      ENDDO
+
+
+c----------------------------------------------------------------------
+c  Case without opacity perturbation: localstorm=false
+c  Case with an opacity perturbation: localstorm=true
+c-----------------------------------------------------------------------
+
+      localstorm=.true.
+
+      if (localstorm. NE. .true.) then 
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            aerosol(ig,l,iaerdust(iaer)) = max(1E-20,
+     &                   tauref(ig) *
+     &                   pplev(ig,1) / 700.E0 *
+     &                   aerosol(ig,l,iaerdust(iaer)) / 
+     &                   taudusttmp(ig)
+     &                                        )
+          ENDDO
+        ENDDO
+      ENDDO
+       else
+c--------------------------------------------------
+c  Parameters of the opacity perturbation
+c--------------------------------------------------
+
+         taulocref = 4.25 !10  ! ref optical depth of the local dust storm
+         ztoploc = 25    ! target pseudo-altitude of local storm (km)
+         radloc = 4     ! radius of dust storm (degree)
+         lonloc=25       ! center longitude of storm (deg)
+         latloc=-3.      ! center latitude of storm (deg)
+
+
+
+      DO ig=1,ngrid
+c---------------------------------------
+c        distance to the center:
+c-----------------------------------------
+         ray=SQRT((lati(ig)*180./pi-latloc)**2 +
+     &          (long(ig)*180./pi -lonloc)**2) 
+c-------------------------------------------------
+c           Tau's new map:
+c------------------------------------------
+                 taureftache(ig)=max(tauref(ig)*pplev(ig,1)/700.E0
+     &                      ,taulocref*(TANH(2.+(radloc-ray)*8)+1.)/2.)
+      ENDDO
+
+c-----------------------------------------------------
+c Computing optical depth
+c-----------------------------------------------------
+
+
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            aerosol(ig,l,iaerdust(iaer)) = max(1E-20,
+     &                   taureftache(ig) *
+     &                   aerosol(ig,l,iaerdust(iaer)) /
+     &                   taudusttmp(ig)
+     &                                        )
+          ENDDO
+         ENDDO
+       ENDDO
+
+         endif
+c -----------------------------------------------------------------
+c Computing the number of condensation nuclei
+c -----------------------------------------------------------------
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind2: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind2     ! Typical dust profile
+c==================================================================
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              ccn(ig,l) = max(aerosol(ig,l,iaer) /
+     &                  pi / QREFvis3d(ig,l,iaer) *
+     &                  (1.+nueffrad(ig,l,iaer))**3. /
+     &                  reffrad(ig,l,iaer)**2. * g /
+     &                  (pplev(ig,l)-pplev(ig,l+1)),1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        CASE("dust_doubleq") aerkind2!Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+          qtot(1:ngridmx) = 0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+
+       if (localstorm. NE. .true.) then
+              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * tauref(ig) *
+     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+       else
+              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * taureftache(ig) *
+     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+       endif
+             qdust(ig,l) = qdust(ig,l) * (pplev(ig,l)-pplev(ig,l+1)) / g
+              qtot(ig) = qtot(ig) + qdust(ig,l)
+              ccn(ig,l) = max( ( ref_r0 /
+     &                    reffrad(ig,l,iaer) )**3. *
+     &                    r3n_q * qdust(ig,l) ,1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        END SELECT aerkind2
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+c  Reduce number of nuclei
+!         TEMPORAIRE : r�duction du nombre de nuclei FF 04/200
+!         reduction facteur 3
+!         ccn(ig,l) = ccn(ig,l) / 27.
+!         reduction facteur 2
+!         ccn(ig,l) = ccn(ig,l) / 8.
+c -----------------------------------------------------------------
+       write(*,*) "water_param CCN reduc. fac. ", ccn_factor
+       DO l=1,nlayer
+         DO ig=1,ngrid
+            ccn(ig,l) = ccn(ig,l) / ccn_factor
+         ENDDO
+       ENDDO
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+      DO iaer=1,naerkind
+        do l=1,nlayer
+           do ig=1,ngrid
+             tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+           end do
+        end do
+      ENDDO
+
+
+c -----------------------------------------------------------------
+c Density scaled opacity and column opacity output
+c -----------------------------------------------------------------
+      dsodust(1:ngrid,1:nlayer) = 0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            dsodust(ig,l) = dsodust(ig,l) +
+     &                      aerosol(ig,l,iaerdust(iaer)) * g /
+     &                      (pplev(ig,l) - pplev(ig,l+1))
+          ENDDO
+        ENDDO
+
+
+        IF (ngrid.NE.1) THEN
+          write(txt2,'(i1.1)') iaer
+          call WRITEDIAGFI(ngridmx,'taudust'//txt2,
+     &                    'Dust col opacity',
+     &                    ' ',2,tau(1,iaerdust(iaer)))
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'taudust'//txt2,
+     &                 'Dust col opacity',
+     &                 ' ',2,tau(1,iaerdust(iaer)))
+          ENDIF
+        ENDIF
+      ENDDO
+
+      IF (ngrid.NE.1) THEN
+c       CALL WRITEDIAGFI(ngridmx,'dsodust','tau*g/dp',
+c    &                    'm2.kg-1',3,dsodust)
+        IF (callstats) THEN
+          CALL wstats(ngridmx,'dsodust',
+     &               'tau*g/dp',
+     &               'm2.kg-1',3,dsodust)
+        ENDIF
+c       CALL WRITEDIAGFI(ngridmx,'ccn','Cond. nuclei',
+c    &                    'part kg-1',3,ccn)
+      ELSE
+        CALL writeg1d(ngrid,nlayer,dsodust,'dsodust','m2.kg-1')
+      ENDIF
+c -----------------------------------------------------------------
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachemobile_mmr.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachemobile_mmr.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachemobile_mmr.F	(revision 308)
@@ -0,0 +1,688 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &    pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d,zdqnorm,dsodust)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   update J FAURE & A SPIGA
+c      -Interactive dust for regional dust storms
+c    With this version of aeropacity.F, dust storm opacity perturbation 
+c    and added dust are constant in different simulations but the altitude
+c    of the top of the storm may vary
+c
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL dsodust(ngridmx,nlayermx)                       !optical depth in each layer. Diagnostic.
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL nueffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+      REAL zdqnorm(ngridmx,nlayermx,2)                       !mass mixing ratio perturbation due to the dust storm. Output for meso_physiq.F
+
+
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+      REAL qdust(ngridmx,nlayermx) ! True dust mass mixing ratio
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL qtot(ngridmx)           ! Dust column (kg m-2)
+
+c     CCN reduction factor
+      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
+
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+c     Level under which the dust mixing ratio is held constant
+c       when computing the dust opacity in each layer
+c       (this applies when doubleq and active are true)
+      INTEGER, PARAMETER :: cstdustlevel = 7
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+! Local dust storms
+
+         logical justbackground    !to switch on/off dust absorption
+         logical localstorm        ! =true to create a local dust storm
+         real taulocref,added_pq,radloc,lonloc,latloc  !local dust storm parameters
+         REAL ray(ngridmx)                            !distance from dust storm center
+         REAL tauuser(ngridmx)                        !opacity perturbation due to dust storm
+         REAL more_dust(ngridmx,nlayermx,2)           !Mass mixing ratio perturbation due to the dust storm
+         real l_top                                   !layer of the dust storm's top
+         REAL integrule                               !usefull factor to compute l_top
+
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: txt ! to temporarly store text
+      CHARACTER(LEN=1) :: txt2 ! to temporarly store text
+! indexes of dust scatterers:
+      INTEGER,SAVE :: iaerdust(naerkind)
+      INTEGER,SAVE :: naerdust ! number of dust scatterers
+
+      tau(1:ngrid,1:naerkind)=0
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify scatterers that are dust
+        naerdust=0
+        DO iaer=1,naerkind
+          txt=name_iaer(iaer)
+          IF (txt(1:4).eq."dust") THEN
+            naerdust=naerdust+1
+            iaerdust(naerdust)=iaer
+          ENDIF
+        ENDDO
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          txt=noms(iq)
+          IF (txt(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        msolsir(1:nlayer,1:naerkind)=0
+        mqextsqabs(1:nlayer,1:naerkind)=0
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+c        firstcall=.false.
+
+      END IF
+
+c     Vertical column optical depth at 700.Pa 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF(iaervar.eq.1) THEN 
+         do ig=1, ngridmx
+          tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                       ! or read in starfi
+        end do
+      ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+        tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+
+      ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+        taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+        tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+        tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+        do ig=1,ngrid/2  ! Northern hemisphere
+          tauref(ig)= tauN +
+     &    (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+        end do
+        do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+          tauref(ig)= tauS +
+     &    (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+        end do
+      ELSE IF ((iaervar.eq.4).or.
+     &        ((iaervar.ge.24).and.(iaervar.le.26)))
+     &     THEN  ! << "TES assimilated dust scenarios >>
+        call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+      ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+        tauref(1) = 2.5
+        if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+      ELSE
+        stop 'problem with iaervar in aeropacity.F'
+      ENDIF
+
+
+
+c -----------------------------------------------------------------
+c Computing the opacity in each layer
+c -----------------------------------------------------------------
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind      ! Typical dust profile
+c==================================================================
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+
+          expfactor=0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+            ENDDO
+          ENDDO
+
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c==================================================================
+        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+             
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) =
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("dust_submicron") aerkind   ! Small dust population
+c==================================================================
+
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("h2o_ice") aerkind             ! Water ice crystals
+c==================================================================
+
+c       1. Initialization
+        aerosol(1:ngrid,1:nlayer,iaer) = 0.
+        taucloudvis(1:ngrid) = 0.
+        taucloudtes(1:ngrid) = 0.
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) = max(1E-20,
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        pq(ig,l,i_ice) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+     &                              )
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauVIS','tauext VIS refwvl',
+     &      ' ',2,taucloudvis)
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'tauVIS','tauext VIS refwvl',
+     &        ' ',2,taucloudvis)
+            CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &        ' ',2,taucloudtes)
+          ENDIF
+        ELSE
+c         CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+c==================================================================
+        END SELECT aerkind
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+c -----------------------------------------------------------------
+c Rescaling each layer to reproduce the choosen (or assimilated)
+c   dust extinction opacity at visible reference wavelength, which
+c   is originally scaled to an equivalent 700Pa pressure surface.
+c -----------------------------------------------------------------
+
+c-----------------------------------------------------------------
+c Chose justbakground=false to create an interactive local dust storm 
+c Switch justbackground to false to enable storm dust absoption
+c 
+c Note that if justbackground=false, dust background has a conrath
+c repartition and absorb ligth.
+c--------------------------------------------------------------------
+
+           justbackground=.false.
+
+      IF (justbackground .eq. .true.)  THEN
+
+      taudusttmp(1:ngrid)=0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+c------------------------------------------------------------------
+c     compute scaling factor
+c-------------------------------------------------------------------
+            taudusttmp(ig) = taudusttmp(ig) +
+     &                       aerosol(ig,l,iaerdust(iaer))
+          ENDDO
+        ENDDO
+      ENDDO
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            aerosol(ig,l,iaerdust(iaer)) = max(1E-20,
+     &                   tauref(ig) *
+     &                   pplev(ig,1) / 700.E0 *
+     &                   aerosol(ig,l,iaerdust(iaer)) /
+     &                   taudusttmp(ig)
+     &                                        )
+          ENDDO
+        ENDDO
+      ENDDO
+
+      ENDIF
+
+c -----------------------------------------------------------------
+c the quantity of dust to add at the first time step is calculated to match
+c a tunable opacity perturbation.
+c -----------------------------------------------------------------
+
+      IF (firstcall) THEN
+      WRITE(*,*) " RENORMALISATION !!! "
+c--------------------------------------------------
+c  Parameters of the opacity perturbation
+c--------------------------------------------------
+
+      iaer=1  !!!! PROVISOIRE !!!!
+      taulocref = 4.25 !10  ! ref optical depth of the local dust storm
+      radloc = 0.5      ! radius of dust storm (degree)
+      lonloc = 85       ! center longitude of storm (deg)
+      latloc = 25       ! center latitude of storm (deg)
+      added_pq = 1.e-4  ! added dust in the dust storm is a constant, top's altitude may vary
+
+      DO ig=1,ngrid
+
+c---------------------------------------
+c        distance to the center:
+c-----------------------------------------
+
+      ray(ig)=SQRT((lati(ig)*180./pi-latloc)**2 +
+     &          (long(ig)*180./pi -lonloc)**2)
+
+c-------------------------------------------------
+c           Tau's new map:
+c------------------------------------------
+
+      tauuser(ig)=max(tauref(ig) * pplev(ig,1) / 700.E0 , taulocref
+     &          * (TANH(2.+(radloc-ray(ig))*2)+1.)/2.)
+
+c----------------------------------------------------
+c            Compute l_top
+c-----------------------------------------------------
+
+            l_top=nlayer-1
+            integrule=0
+            DO l=1, l_top+1
+            integrule = integrule + added_pq*
+     &                  (  0.75 * QREFvis3d(ig,l,iaer) /
+     &                  ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &                  ( pplev(ig,l) - pplev(ig,l+1) ) / g
+
+              IF (integrule .ge. taulocref) THEN
+               l_top=l
+              ELSE
+              PRINT*, 'tau is too big or added_pq is too small!!!!'
+              ENDIF
+
+c-------------------------------------------------------------------------
+c Mass mixing ratio perturbation due to the local dust storm in each layer
+c-------------------------------------------------------------------------
+
+            more_dust(ig,l,1) = added_pq *
+     &                        (TANH(2.+(radloc-ray(ig))*2)+1.)/2.
+            more_dust(ig,l,2) = more_dust(ig,l,1) * 
+     &                      ((ref_r0/reffrad(ig,l,iaer))**3)
+     &                      * r3n_q 
+   
+
+            ENDDO
+      ENDDO
+
+c--------------------------------------------------------------------------------------
+c   quantity of dust whiwh is added at the first time step in dynamical core.
+c--------------------------------------------------------------------------------------
+      DO l=1, l_top
+      zdqnorm(:,l,1) = more_dust(:,l,1)
+      zdqnorm(:,l,2) = more_dust(:,l,2)
+      ENDDO
+
+!        DO ig=1, ngrid
+!            DO l=1, l_top
+!                aerosol(ig,l,iaer) =
+!     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+!     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+!     &          more_dust(ig,l,1) *
+!     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!             ENDDO
+!        ENDDO
+
+
+      firstcall = .false.
+      ENDIF  !!! firstcall
+
+c -----------------------------------------------------------------
+c Computing the number of condensation nuclei
+c -----------------------------------------------------------------
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind2: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind2     ! Typical dust profile
+c==================================================================
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              ccn(ig,l) = max(aerosol(ig,l,iaer) /
+     &                  pi / QREFvis3d(ig,l,iaer) *
+     &                  (1.+nueffrad(ig,l,iaer))**3. /
+     &                  reffrad(ig,l,iaer)**2. * g /
+     &                  (pplev(ig,l)-pplev(ig,l+1)),1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        CASE("dust_doubleq") aerkind2!Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+          qtot(1:ngridmx) = 0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+
+c--------------------------------------------------------------
+c commented useless because (mass mixing ration have a real physical sense now)
+c---------------------------------------------------------------------
+c       if (localstorm. NE. .true.) then
+c              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * tauref(ig) *
+c     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+c       else
+c              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * taureftache(ig) *
+c     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+c       endif
+c              qtot(ig) = qtot(ig) + qdust(ig,l) *
+c     &                   (pplev(ig,l)-pplev(ig,l+1)) / g
+              ccn(ig,l) = max( ( ref_r0 /
+     &                    reffrad(ig,l,iaer) )**3. *
+     &                    r3n_q * pq(ig,l,igcm_dust_mass) ,1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        END SELECT aerkind2
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+c  Reduce number of nuclei
+!         TEMPORAIRE : r�duction du nombre de nuclei FF 04/200
+!         reduction facteur 3
+!         ccn(ig,l) = ccn(ig,l) / 27.
+!         reduction facteur 2
+!         ccn(ig,l) = ccn(ig,l) / 8.
+c -----------------------------------------------------------------
+       write(*,*) "water_param CCN reduc. fac. ", ccn_factor
+       DO l=1,nlayer
+         DO ig=1,ngrid
+            ccn(ig,l) = ccn(ig,l) / ccn_factor
+         ENDDO
+       ENDDO
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+      DO iaer=1,naerkind
+        do l=1,nlayer
+           do ig=1,ngrid
+             tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+           end do
+        end do
+      ENDDO
+
+                
+c -----------------------------------------------------------------
+c Density scaled opacity and column opacity output
+c -----------------------------------------------------------------
+      dsodust(1:ngrid,1:nlayer) = 0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            dsodust(ig,l) = dsodust(ig,l) +
+     &                      aerosol(ig,l,iaerdust(iaer)) * g /
+     &                      (pplev(ig,l) - pplev(ig,l+1))
+          ENDDO
+        ENDDO
+        IF (ngrid.NE.1) THEN
+          write(txt2,'(i1.1)') iaer
+          call WRITEDIAGFI(ngridmx,'taudust'//txt2,
+     &                    'Dust col opacity',
+     &                    ' ',2,tau(1,iaerdust(iaer)))
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'taudust'//txt2,
+     &                 'Dust col opacity',
+     &                 ' ',2,tau(1,iaerdust(iaer)))
+          ENDIF
+        ENDIF
+      ENDDO
+
+      IF (ngrid.NE.1) THEN
+c       CALL WRITEDIAGFI(ngridmx,'dsodust','tau*g/dp',
+c    &                    'm2.kg-1',3,dsodust)
+        IF (callstats) THEN
+          CALL wstats(ngridmx,'dsodust',
+     &               'tau*g/dp',
+     &               'm2.kg-1',3,dsodust)
+        ENDIF
+c       CALL WRITEDIAGFI(ngridmx,'ccn','Cond. nuclei',
+c    &                    'part kg-1',3,ccn)
+      ELSE
+        CALL writeg1d(ngrid,nlayer,dsodust,'dsodust','m2.kg-1')
+      ENDIF
+c -----------------------------------------------------------------
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachemobile_z.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachemobile_z.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_tachemobile_z.F	(revision 308)
@@ -0,0 +1,708 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &    pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d,zdqnorm,dsodust,pt)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   update J FAURE & A SPIGA
+c      -Interactive dust for regional dust storms
+c    With this version of aeropacity.F, dust storm opacity perturbation 
+c    and the altitude of the top of the storm are constant but the initial
+c    dust loading may vary
+c
+c
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL dsodust(ngridmx,nlayermx)                       !optical depth in each layer. Diagnostic.
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL nueffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+      REAL zdqnorm(ngridmx,nlayermx,2)                       !mass mixing ratio perturbation due to the dust storm. Output for meso_physiq.F
+      REAL pt(ngrid,nlayer)                                 !input: temperature. usefull to compute precisely the l_top parameter
+
+
+
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+      REAL qdust(ngridmx,nlayermx) ! True dust mass mixing ratio
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL qtot(ngridmx)           ! Dust column (kg m-2)
+
+c     CCN reduction factor
+      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
+
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+c     Level under which the dust mixing ratio is held constant
+c       when computing the dust opacity in each layer
+c       (this applies when doubleq and active are true)
+      INTEGER, PARAMETER :: cstdustlevel = 7
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+! Local dust storms
+
+         logical justbackground    !to switch on/off dust absorption
+         logical localstorm        ! =true to create a local dust storm
+         real taulocref,ztoploc,radloc,lonloc,latloc  !local dust storm parameters
+         REAL ray(ngridmx)                            !distance from dust storm center
+         REAL tauuser(ngridmx)                        !opacity perturbation due to dust storm
+         REAL more_dust(ngridmx,nlayermx,2)           !Mass mixing ratio perturbation due to the dust storm
+         REAL int_factor(ngridmx)                     !usefull factor to compute mmr perturbation
+         real l_top                                   !layer of the dust storm's top
+         REAL zalt(ngridmx, nlayer)                   !usefull factor to compute l_top
+
+
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: txt ! to temporarly store text
+      CHARACTER(LEN=1) :: txt2 ! to temporarly store text
+! indexes of dust scatterers:
+      INTEGER,SAVE :: iaerdust(naerkind)
+      INTEGER,SAVE :: naerdust ! number of dust scatterers
+
+      tau(1:ngrid,1:naerkind)=0
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify scatterers that are dust
+        naerdust=0
+        DO iaer=1,naerkind
+          txt=name_iaer(iaer)
+          IF (txt(1:4).eq."dust") THEN
+            naerdust=naerdust+1
+            iaerdust(naerdust)=iaer
+          ENDIF
+        ENDDO
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          txt=noms(iq)
+          IF (txt(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        msolsir(1:nlayer,1:naerkind)=0
+        mqextsqabs(1:nlayer,1:naerkind)=0
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+c        firstcall=.false.
+
+      END IF
+
+c     Vertical column optical depth at 700.Pa 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF(iaervar.eq.1) THEN 
+         do ig=1, ngridmx
+          tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                       ! or read in starfi
+        end do
+      ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+        tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+
+      ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+        taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+        tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+        tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+        do ig=1,ngrid/2  ! Northern hemisphere
+          tauref(ig)= tauN +
+     &    (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+        end do
+        do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+          tauref(ig)= tauS +
+     &    (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+        end do
+      ELSE IF ((iaervar.eq.4).or.
+     &        ((iaervar.ge.24).and.(iaervar.le.26)))
+     &     THEN  ! << "TES assimilated dust scenarios >>
+        call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+      ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+        tauref(1) = 2.5
+        if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+      ELSE
+        stop 'problem with iaervar in aeropacity.F'
+      ENDIF
+
+
+
+c -----------------------------------------------------------------
+c Computing the opacity in each layer
+c -----------------------------------------------------------------
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind      ! Typical dust profile
+c==================================================================
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+
+          expfactor=0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+            ENDDO
+          ENDDO
+
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c==================================================================
+        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+             
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) =
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("dust_submicron") aerkind   ! Small dust population
+c==================================================================
+
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("h2o_ice") aerkind             ! Water ice crystals
+c==================================================================
+
+c       1. Initialization
+        aerosol(1:ngrid,1:nlayer,iaer) = 0.
+        taucloudvis(1:ngrid) = 0.
+        taucloudtes(1:ngrid) = 0.
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) = max(1E-20,
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        pq(ig,l,i_ice) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+     &                              )
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauVIS','tauext VIS refwvl',
+     &      ' ',2,taucloudvis)
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'tauVIS','tauext VIS refwvl',
+     &        ' ',2,taucloudvis)
+            CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &        ' ',2,taucloudtes)
+          ENDIF
+        ELSE
+c         CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+c==================================================================
+        END SELECT aerkind
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+c -----------------------------------------------------------------
+c Rescaling each layer to reproduce the choosen (or assimilated)
+c   dust extinction opacity at visible reference wavelength, which
+c   is originally scaled to an equivalent 700Pa pressure surface.
+c -----------------------------------------------------------------
+
+c-----------------------------------------------------------------
+c Chose justbakground=false to create an interactive local dust storm 
+c Switch justbackground to false to enable storm dust absoption
+c 
+c Note that if justbackground=false, dust background has a conrath
+c repartition and absorb ligth.
+c--------------------------------------------------------------------
+
+      justbackground=.false.
+
+      IF (justbackground .eq. .true.)  THEN
+
+      taudusttmp(1:ngrid)=0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+c           Scaling factor
+            taudusttmp(ig) = taudusttmp(ig) +
+     &                       aerosol(ig,l,iaerdust(iaer))
+          ENDDO
+        ENDDO
+      ENDDO
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            aerosol(ig,l,iaerdust(iaer)) = max(1E-20,
+     &                   tauref(ig) *
+     &                   pplev(ig,1) / 700.E0 *
+     &                   aerosol(ig,l,iaerdust(iaer)) /
+     &                   taudusttmp(ig)
+     &                                        )
+          ENDDO
+        ENDDO
+      ENDDO
+
+      ENDIF
+
+c -----------------------------------------------------------------
+c the quantity of dust to add at the first time step is calculated to match
+c a tunable opacity perturbation.
+c -----------------------------------------------------------------
+
+      IF (firstcall) THEN
+      WRITE(*,*) " RENORMALISATION !!! "
+c--------------------------------------------------
+c  Parameters of the opacity perturbation
+c--------------------------------------------------
+
+      iaer=1  !!!! PROVISOIRE !!!!
+      taulocref = 4.25 !10  ! ref optical depth of the local dust storm
+      ztoploc = 10      ! target pseudo-altitude of local storm (km)
+      radloc = 0.5      ! radius of dust storm (degree)
+      lonloc = 80       ! center longitude of storm (deg)
+      latloc = -25      ! center latitude of storm (deg)
+
+      DO ig=1,ngrid
+
+c---------------------------------------
+c        distance to the center:
+c-----------------------------------------
+
+      ray(ig)=SQRT((lati(ig)*180./pi-latloc)**2 +
+     &          (long(ig)*180./pi -lonloc)**2)
+
+c-------------------------------------------------
+c           Tau's new map:
+c------------------------------------------
+
+      tauuser(ig)=max(tauref(ig) * pplev(ig,1) / 700.E0 , taulocref
+     &          * (TANH(2.+(radloc-ray(ig))*2)+1.)/2.)
+
+c---------------------------------------------------------
+c           compute l_top
+c----------------------------------------------------------
+
+          DO l=1,nlayer
+
+            zalt(ig,l) = LOG( pplev(ig,1)/pplev(ig,l) )
+     &                      / g / 44.01
+     &                    * 8.31 * pt(ig,l).
+                IF (     (ztoploc .lt. zalt(ig,l)  )
+     &          .and. (ztoploc .gt. zalt(ig,l-1)) ) l_top=l-1
+
+          ENDDO
+      ENDDO
+
+c----------------------------------------------------------------------------
+c    compute int_factor
+c---------------------------------------------------------------------------
+
+
+      DO ig=1,ngrid
+          int_factor(ig)=0.
+          DO l=1,nlayer
+             IF (l .lt. l_top+1) THEN
+                      int_factor(ig) =
+     &                int_factor(ig) +
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+             ENDIF
+          ENDDO
+          DO l=1, nlayer
+
+c-------------------------------------------------------------------------
+c Mass mixing ratio perturbation due to the local dust storm in each layer
+c-------------------------------------------------------------------------
+          more_dust(ig,l,1)=
+     &                     (tauuser(ig)-(tauref(ig)
+     &                      * pplev(ig,1) / 700.E0)) /
+     &                      int_factor(ig)
+          more_dust(ig,l,2)=
+     &                     (tauuser(ig)-(tauref(ig) *
+     &                     pplev(ig,1) / 700.E0))
+     &                      / int_factor(ig) *
+     &                     ((ref_r0/reffrad(ig,l,iaer))**3)
+     &                      * r3n_q 
+          ENDDO
+      ENDDO
+
+c--------------------------------------------------------------------------------------
+c   quantity of dust whiwh is added at the first time step in dynamical core.
+c--------------------------------------------------------------------------------------
+      DO l=1, l_top
+      zdqnorm(:,l,1) = more_dust(:,l,1)
+      zdqnorm(:,l,2) = more_dust(:,l,2)
+      ENDDO
+
+!        DO ig=1, ngrid
+!            DO l=1, l_top
+!                aerosol(ig,l,iaer) =
+!     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+!     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+!     &          more_dust(ig,l,1) *
+!     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!             ENDDO
+!        ENDDO
+
+
+      firstcall = .false.
+      ENDIF  !!! firstcall
+
+c -----------------------------------------------------------------
+c Computing the number of condensation nuclei
+c -----------------------------------------------------------------
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind2: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind2     ! Typical dust profile
+c==================================================================
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              ccn(ig,l) = max(aerosol(ig,l,iaer) /
+     &                  pi / QREFvis3d(ig,l,iaer) *
+     &                  (1.+nueffrad(ig,l,iaer))**3. /
+     &                  reffrad(ig,l,iaer)**2. * g /
+     &                  (pplev(ig,l)-pplev(ig,l+1)),1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        CASE("dust_doubleq") aerkind2!Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+          qtot(1:ngridmx) = 0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+
+c--------------------------------------------------------------
+c commented useless because (mass mixing ration have a real physical sense now)
+c---------------------------------------------------------------------
+c       if (localstorm. NE. .true.) then
+c              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * tauref(ig) *
+c     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+c       else
+c              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * taureftache(ig) *
+c     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+c       endif
+c              qtot(ig) = qtot(ig) + qdust(ig,l) *
+c     &                   (pplev(ig,l)-pplev(ig,l+1)) / g
+              ccn(ig,l) = max( ( ref_r0 /
+     &                    reffrad(ig,l,iaer) )**3. *
+     &                    r3n_q * pq(ig,l,igcm_dust_mass) ,1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        END SELECT aerkind2
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+c  Reduce number of nuclei
+!         TEMPORAIRE : r�duction du nombre de nuclei FF 04/200
+!         reduction facteur 3
+!         ccn(ig,l) = ccn(ig,l) / 27.
+!         reduction facteur 2
+!         ccn(ig,l) = ccn(ig,l) / 8.
+c -----------------------------------------------------------------
+       write(*,*) "water_param CCN reduc. fac. ", ccn_factor
+       DO l=1,nlayer
+         DO ig=1,ngrid
+            ccn(ig,l) = ccn(ig,l) / ccn_factor
+         ENDDO
+       ENDDO
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+      DO iaer=1,naerkind
+        do l=1,nlayer
+           do ig=1,ngrid
+             tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+           end do
+        end do
+      ENDDO
+
+                
+c -----------------------------------------------------------------
+c Density scaled opacity and column opacity output
+c -----------------------------------------------------------------
+      dsodust(1:ngrid,1:nlayer) = 0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            dsodust(ig,l) = dsodust(ig,l) +
+     &                      aerosol(ig,l,iaerdust(iaer)) * g /
+     &                      (pplev(ig,l) - pplev(ig,l+1))
+          ENDDO
+        ENDDO
+        IF (ngrid.NE.1) THEN
+          write(txt2,'(i1.1)') iaer
+          call WRITEDIAGFI(ngridmx,'taudust'//txt2,
+     &                    'Dust col opacity',
+     &                    ' ',2,tau(1,iaerdust(iaer)))
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'taudust'//txt2,
+     &                 'Dust col opacity',
+     &                 ' ',2,tau(1,iaerdust(iaer)))
+          ENDIF
+        ENDIF
+      ENDDO
+
+      IF (ngrid.NE.1) THEN
+c       CALL WRITEDIAGFI(ngridmx,'dsodust','tau*g/dp',
+c    &                    'm2.kg-1',3,dsodust)
+        IF (callstats) THEN
+          CALL wstats(ngridmx,'dsodust',
+     &               'tau*g/dp',
+     &               'm2.kg-1',3,dsodust)
+        ENDIF
+c       CALL WRITEDIAGFI(ngridmx,'ccn','Cond. nuclei',
+c    &                    'part kg-1',3,ccn)
+      ELSE
+        CALL writeg1d(ngrid,nlayer,dsodust,'dsodust','m2.kg-1')
+      ENDIF
+c -----------------------------------------------------------------
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_used.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_used.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/aeropacity_used.F	(revision 308)
@@ -0,0 +1,704 @@
+      SUBROUTINE aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &    pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+     &    QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d,zdqnorm,dsodust)
+                                                   
+! to use  'getin'
+      USE ioipsl_getincom 
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Computing aerosol optical depth in each gridbox.
+c
+c   author: F.Forget 
+c   ------
+c   update F. Montmessin (water ice scheme) 
+c      and S. Lebonnois (12/06/2003) compatibility dust/ice/chemistry
+c   update J.-B. Madeleine 2008-2009:
+c       - added 3D scattering by aerosols;
+c       - dustopacity transferred from physiq.F to callradite.F,
+c           and renamed into aeropacity.F;
+c   update J FAURE & A SPIGA
+c      -Interactive dust for regional dust storms
+c
+c
+c   
+c   input:
+c   ----- 
+c   ngrid             Number of gridpoint of horizontal grid
+c   nlayer            Number of layer
+c   nq                Number of tracer
+c   zday                  Date (time since Ls=0, in martian days)
+c   ls                Solar longitude (Ls) , radian
+c   pplay,pplev       pressure (Pa) in the middle and boundary of each layer
+c   pq                Dust mixing ratio (used if tracer =T and active=T).
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
+c   QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c   omegaREFvis3d(ngridmx,nlayermx,naerkind) \ 3d single scat. albedo
+c   omegaREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths;
+c
+c   output:
+c   -------
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol      aerosol(ig,l,1) is the dust optical
+c                depth in layer l, grid point ig
+
+c
+c=======================================================================
+#include "dimensions.h"
+#include "dimphys.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "comgeomfi.h"
+#include "dimradmars.h"
+#include "yomaer.h"
+#include "tracer.h"
+#include "planete.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c
+c    Declarations :
+c    --------------
+c
+c    Input/Output
+c    ------------
+      INTEGER ngrid,nlayer,nq
+
+      REAL ls,zday,expfactor    
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pq(ngrid,nlayer,nq)
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL dsodust(ngridmx,nlayermx)                       !optical depth in each layer. Diagnostic.
+      REAL reffrad(ngrid,nlayer,naerkind)
+      REAL nueffrad(ngrid,nlayer,naerkind)
+      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL QREFir3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL omegaREFir3d(ngridmx,nlayermx,naerkind)
+      REAL zdqnorm(ngridmx,nlayermx,2)                       !mass mixing ratio perturbation due to the dust storm. Output for meso_physiq.F
+
+
+
+c
+c    Local variables :
+c    -----------------
+      INTEGER l,ig,iq,i,j
+      INTEGER iaer           ! Aerosol index
+      real topdust(ngridmx)
+      real zlsconst, zp
+      real taueq,tauS,tauN
+c     Mean Qext(vis)/Qext(ir) profile
+      real msolsir(nlayermx,naerkind)
+c     Mean Qext(ir)/Qabs(ir) profile
+      real mqextsqabs(nlayermx,naerkind)
+c     Variables used when multiple particle sizes are used
+c       for dust or water ice particles in the radiative transfer
+c       (see callradite.F for more information).
+      REAL taudusttmp(ngridmx)! Temporary dust opacity
+                               !   used before scaling
+      REAL taudustvis(ngridmx) ! Dust opacity after scaling
+      REAL taudusttes(ngridmx) ! Dust opacity at IR ref. wav. as
+                               !   "seen" by the GCM.
+      REAL taucloudvis(ngridmx)! Cloud opacity at visible
+                               !   reference wavelength
+      REAL taucloudtes(ngridmx)! Cloud opacity at infrared
+                               !   reference wavelength using
+                               !   Qabs instead of Qext
+                               !   (direct comparison with TES)
+      REAL qdust(ngridmx,nlayermx) ! True dust mass mixing ratio
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL qtot(ngridmx)           ! Dust column (kg m-2)
+
+c     CCN reduction factor
+      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
+
+c
+c   local saved variables
+c   ---------------------
+
+      REAL topdust0(ngridmx) 
+      SAVE topdust0
+c     Level under which the dust mixing ratio is held constant
+c       when computing the dust opacity in each layer
+c       (this applies when doubleq and active are true)
+      INTEGER, PARAMETER :: cstdustlevel = 7
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+! Local dust storms
+
+         logical justbackground    !to switch on/off dust absorption
+         logical localstorm        ! =true to create a local dust storm
+         real taulocref,ztoploc,radloc,lonloc,latloc  !local dust storm parameters
+         REAL ray(ngridmx)                            !distance from dust storm center
+         REAL tauuser(ngridmx)                        !opacity perturbation due to dust storm
+         REAL more_dust(ngridmx,nlayermx,2)           !Mass mixing ratio perturbation due to the dust storm
+         REAL int_factor(ngridmx)                     !usefull factor to compute mmr perturbation
+         real l_top                                   !layer of the dust storm's top
+         REAL zalt(ngridmx, nlayer)                   !usefull factor to compute l_top
+
+
+
+! indexes of water ice and dust tracers:
+      INTEGER,SAVE :: nqdust(nqmx) ! to store the indexes of dust tracers
+      INTEGER,SAVE :: i_ice=0  ! water ice
+      CHARACTER(LEN=20) :: txt ! to temporarly store text
+      CHARACTER(LEN=1) :: txt2 ! to temporarly store text
+! indexes of dust scatterers:
+      INTEGER,SAVE :: iaerdust(naerkind)
+      INTEGER,SAVE :: naerdust ! number of dust scatterers
+
+      tau(1:ngrid,1:naerkind)=0
+
+! identify tracers
+
+      IF (firstcall) THEN
+        ! identify scatterers that are dust
+        naerdust=0
+        DO iaer=1,naerkind
+          txt=name_iaer(iaer)
+          IF (txt(1:4).eq."dust") THEN
+            naerdust=naerdust+1
+            iaerdust(naerdust)=iaer
+          ENDIF
+        ENDDO
+        ! identify tracers which are dust
+        i=0
+        DO iq=1,nq
+          txt=noms(iq)
+          IF (txt(1:4).eq."dust") THEN
+          i=i+1
+          nqdust(i)=iq
+          ENDIF
+        ENDDO
+
+        IF (water.AND.activice) THEN
+          i_ice=igcm_h2o_ice
+          write(*,*) "aeropacity: i_ice=",i_ice
+        ENDIF
+
+c       altitude of the top of the aerosol layer (km) at Ls=2.76rad:
+c       in the Viking year scenario
+        DO ig=1,ngrid
+            topdust0(ig)=60. -22.*SIN(lati(ig))**2
+        END DO
+
+c       typical profile of solsir and (1-w)^(-1):
+        msolsir(1:nlayer,1:naerkind)=0
+        mqextsqabs(1:nlayer,1:naerkind)=0
+        WRITE(*,*) "Typical profiles of solsir and Qext/Qabs(IR):"
+        DO iaer = 1, naerkind ! Loop on aerosol kind
+          WRITE(*,*) "Aerosol # ",iaer
+          DO l=1,nlayer
+            DO ig=1,ngridmx
+              msolsir(l,iaer)=msolsir(l,iaer)+
+     &              QREFvis3d(ig,l,iaer)/
+     &              QREFir3d(ig,l,iaer)
+              mqextsqabs(l,iaer)=mqextsqabs(l,iaer)+
+     &              (1.E0-omegaREFir3d(ig,l,iaer))**(-1)
+            ENDDO
+            msolsir(l,iaer)=msolsir(l,iaer)/REAL(ngridmx)
+            mqextsqabs(l,iaer)=mqextsqabs(l,iaer)/REAL(ngridmx)
+          ENDDO
+          WRITE(*,*) "solsir: ",msolsir(:,iaer)
+          WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer)
+        ENDDO
+
+!       load value of tauvis from callphys.def (if given there,
+!       otherwise default value read from starfi.nc file will be used)
+        call getin("tauvis",tauvis)
+
+c        firstcall=.false.
+
+      END IF
+
+c     Vertical column optical depth at 700.Pa 
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF(iaervar.eq.1) THEN 
+         do ig=1, ngridmx
+          tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def
+                                       ! or read in starfi
+        end do
+      ELSE IF (iaervar.eq.2) THEN   ! << "Viking" Scenario>>
+
+        tauref(1) = 0.7+.3*cos(ls+80.*pi/180.) ! like seen by VL1
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+
+      ELSE IF (iaervar.eq.3) THEN  ! << "MGS" scenario >>
+
+        taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls-4.363)))**14
+        tauS= 0.1 +(0.5-0.1)  *(cos(0.5*(ls-4.363)))**14
+        tauN = 0.1
+c	   if (peri_day.eq.150) then
+c	     tauS=0.1
+c	     tauN=0.1 +(0.5-0.1)  *(cos(0.5*(ls+pi-4.363)))**14
+c	     taueq= 0.2 +(0.5-0.2) *(cos(0.5*(ls+pi-4.363)))**14
+c           endif
+        do ig=1,ngrid/2  ! Northern hemisphere
+          tauref(ig)= tauN +
+     &    (taueq-tauN)*0.5*(1+tanh((45-lati(ig)*180./pi)*6/60))
+        end do
+        do ig=ngrid/2+1, ngridmx  ! Southern hemisphere
+          tauref(ig)= tauS +
+     &    (taueq-tauS)*0.5*(1+tanh((45+lati(ig)*180./pi)*6/60))
+        end do
+      ELSE IF ((iaervar.eq.4).or.
+     &        ((iaervar.ge.24).and.(iaervar.le.26)))
+     &     THEN  ! << "TES assimilated dust scenarios >>
+        call readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+      ELSE IF (iaervar.eq.5) THEN   ! << Escalier Scenario>>
+c         tauref(1) = 0.2
+c         if ((ls.ge.210.*pi/180.).and.(ls.le.330.*pi/180.))
+c    &                              tauref(1) = 2.5
+        tauref(1) = 2.5
+        if ((ls.ge.30.*pi/180.).and.(ls.le.150.*pi/180.))
+     &                              tauref(1) = .2
+
+        do ig=2,ngrid
+          tauref(ig) = tauref(1)
+        end do
+      ELSE
+        stop 'problem with iaervar in aeropacity.F'
+      ENDIF
+
+
+
+c -----------------------------------------------------------------
+c Computing the opacity in each layer
+c -----------------------------------------------------------------
+
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind      ! Typical dust profile
+c==================================================================
+
+c       Altitude of the top of the dust layer
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        zlsconst=SIN(ls-2.76)
+        if (iddist.eq.1) then
+          do ig=1,ngrid
+             topdust(ig)=topdustref         ! constant dust layer top
+          end do
+
+        else if (iddist.eq.2) then          ! "Viking" scenario
+          do ig=1,ngrid
+            topdust(ig)=topdust0(ig)+18.*zlsconst
+          end do
+
+        else if(iddist.eq.3) then         !"MGS" scenario
+          do ig=1,ngrid
+            topdust(ig)=60.+18.*zlsconst
+     &                -(32+18*zlsconst)*sin(lati(ig))**4
+     &                 - 8*zlsconst*(sin(lati(ig)))**5
+          end do
+        endif
+
+c       Optical depth in each layer :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        if(iddist.ge.1) then
+
+          expfactor=0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+c             Typical mixing ratio profile 
+              if(pplay(ig,l).gt.700.
+     $                        /(988.**(topdust(ig)/70.))) then
+                zp=(700./pplay(ig,l))**(70./topdust(ig))
+                 expfactor=max(exp(0.007*(1.-max(zp,1.))),1.e-3)
+              else    
+                expfactor=1.e-3
+              endif
+c             Vertical scaling function
+              aerosol(ig,l,iaer)= (pplev(ig,l)-pplev(ig,l+1)) *
+     &          expfactor *
+     &          QREFvis3d(ig,l,iaer) / QREFvis3d(ig,1,iaer)
+            ENDDO
+          ENDDO
+
+        else if(iddist.eq.0) then   
+c         old dust vertical distribution function (pollack90)
+          DO l=1,nlayer
+             DO ig=1,ngrid
+                zp=700./pplay(ig,l)
+                aerosol(ig,l,1)= tauref(ig)/700. *
+     s           (pplev(ig,l)-pplev(ig,l+1))
+     s           *max( exp(.03*(1.-max(zp,1.))) , 1.E-3 )
+             ENDDO
+          ENDDO
+        end if
+
+c==================================================================
+        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+             
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) =
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_mass) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("dust_submicron") aerkind   ! Small dust population
+c==================================================================
+
+          DO l=1,nlayer
+            IF (l.LE.cstdustlevel) THEN
+c           Opacity in the first levels is held constant to 
+c             avoid unrealistic values due to constant lifting:
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,cstdustlevel,iaer) /
+     &          ( rho_dust * reffrad(ig,cstdustlevel,iaer) )  ) *
+     &          pq(ig,cstdustlevel,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ELSE
+              DO ig=1,ngrid
+                aerosol(ig,l,iaer) = 
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          pq(ig,l,igcm_dust_submicron) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+              ENDDO
+            ENDIF
+          ENDDO
+
+c==================================================================
+        CASE("h2o_ice") aerkind             ! Water ice crystals
+c==================================================================
+
+c       1. Initialization
+        aerosol(1:ngrid,1:nlayer,iaer) = 0.
+        taucloudvis(1:ngrid) = 0.
+        taucloudtes(1:ngrid) = 0.
+c       2. Opacity calculation
+        DO ig=1, ngrid
+          DO l=1,nlayer
+            aerosol(ig,l,iaer) = max(1E-20,
+     &        (  0.75 * QREFvis3d(ig,l,iaer) /
+     &        ( rho_ice * reffrad(ig,l,iaer) )  ) *
+     &        pq(ig,l,i_ice) *
+     &        ( pplev(ig,l) - pplev(ig,l+1) ) / g
+     &                              )
+            taucloudvis(ig) = taucloudvis(ig) + aerosol(ig,l,iaer)
+            taucloudtes(ig) = taucloudtes(ig) + aerosol(ig,l,iaer)*
+     &        QREFir3d(ig,l,iaer) / QREFvis3d(ig,l,iaer) *
+     &        ( 1.E0 - omegaREFir3d(ig,l,iaer) )
+          ENDDO
+        ENDDO
+c       3. Outputs
+        IF (ngrid.NE.1) THEN
+          CALL WRITEDIAGFI(ngridmx,'tauVIS','tauext VIS refwvl',
+     &      ' ',2,taucloudvis)
+          CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl',
+     &      ' ',2,taucloudtes)
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'tauVIS','tauext VIS refwvl',
+     &        ' ',2,taucloudvis)
+            CALL wstats(ngridmx,'tauTES','tauabs IR refwvl',
+     &        ' ',2,taucloudtes)
+          ENDIF
+        ELSE
+c         CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU')
+        ENDIF
+c==================================================================
+        END SELECT aerkind
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+c -----------------------------------------------------------------
+c Rescaling each layer to reproduce the choosen (or assimilated)
+c   dust extinction opacity at visible reference wavelength, which
+c   is originally scaled to an equivalent 700Pa pressure surface.
+c -----------------------------------------------------------------
+
+c-----------------------------------------------------------------
+c Chose justbakground=false to create an interactive local dust storm 
+c Switch justbackground to false to enable storm dust absoption
+c 
+c Note that if justbackground=false, dust background has a conrath
+c repartition and absorb ligth.
+c--------------------------------------------------------------------
+
+      justbackground=.false.
+
+      IF (justbackground .eq. .true.)  THEN
+
+      taudusttmp(1:ngrid)=0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+c           Scaling factor
+            taudusttmp(ig) = taudusttmp(ig) +
+     &                       aerosol(ig,l,iaerdust(iaer))
+          ENDDO
+        ENDDO
+      ENDDO
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            aerosol(ig,l,iaerdust(iaer)) = max(1E-20,
+     &                   tauref(ig) *
+     &                   pplev(ig,1) / 700.E0 *
+     &                   aerosol(ig,l,iaerdust(iaer)) /
+     &                   taudusttmp(ig)
+     &                                        )
+          ENDDO
+        ENDDO
+      ENDDO
+
+      ENDIF
+
+c -----------------------------------------------------------------
+c the quantity of dust to add at the first time step is calculated to match
+c a tunable opacity perturbation.
+c -----------------------------------------------------------------
+
+      IF (firstcall) THEN
+      WRITE(*,*) " RENORMALISATION !!! "
+c--------------------------------------------------
+c  Parameters of the opacity perturbation
+c--------------------------------------------------
+
+      iaer=1  !!!! PROVISOIRE !!!!
+      taulocref = 4.25 !10  ! ref optical depth of the local dust storm
+      ztoploc = 10      ! target pseudo-altitude of local storm (km)
+      radloc = 0.5      ! radius of dust storm (degree)
+      lonloc = 85       ! center longitude of storm (deg)
+      latloc = 25       ! center latitude of storm (deg)
+
+      DO ig=1,ngrid
+
+c---------------------------------------
+c        distance to the center:
+c-----------------------------------------
+
+      ray(ig)=SQRT((lati(ig)*180./pi-latloc)**2 +
+     &          (long(ig)*180./pi -lonloc)**2)
+
+c-------------------------------------------------
+c           Tau's new map:
+c------------------------------------------
+
+      tauuser(ig)=max(tauref(ig) * pplev(ig,1) / 700.E0 , taulocref
+     &          * (TANH(2.+(radloc-ray(ig))*2)+1.)/2.)
+
+c---------------------------------------------------------
+c           compute l_top
+c----------------------------------------------------------
+
+          DO l=1,nlayer
+
+            zalt(ig,l) = LOG( pplev(ig,1)/pplev(ig,l) )
+     &                      / g / 44.01
+     &                    * 8.31 * 210.
+                IF (     (ztoploc .lt. zalt(ig,l)  )
+     &          .and. (ztoploc .gt. zalt(ig,l-1)) ) l_top=l-1
+
+          ENDDO
+      ENDDO
+
+c----------------------------------------------------------------------------
+c    compute int_factor
+c---------------------------------------------------------------------------
+
+
+      DO ig=1,ngrid
+          int_factor(ig)=0.
+          DO l=1,nlayer
+             IF (l .lt. l_top+1) THEN
+                      int_factor(ig) =
+     &                int_factor(ig) +
+     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+             ENDIF
+          ENDDO
+          DO l=1, nlayer
+
+c-------------------------------------------------------------------------
+c Mass mixing ratio perturbation due to the local dust storm in each layer
+c-------------------------------------------------------------------------
+          more_dust(ig,l,1)=
+     &                     (tauuser(ig)-(tauref(ig)
+     &                      * pplev(ig,1) / 700.E0)) /
+     &                      int_factor(ig)
+          more_dust(ig,l,2)=
+     &                     (tauuser(ig)-(tauref(ig) *
+     &                     pplev(ig,1) / 700.E0))
+     &                      / int_factor(ig) *
+     &                     ((ref_r0/reffrad(ig,l,iaer))**3)
+     &                      * r3n_q 
+          ENDDO
+      ENDDO
+
+c--------------------------------------------------------------------------------------
+c   quantity of dust whiwh is added at the first time step in dynamical core.
+c--------------------------------------------------------------------------------------
+      DO l=1, l_top
+      zdqnorm(:,l,1) = more_dust(:,l,1)
+      zdqnorm(:,l,2) = more_dust(:,l,2)
+      ENDDO
+
+!        DO ig=1, ngrid
+!            DO l=1, l_top
+!                aerosol(ig,l,iaer) =
+!     &          (  0.75 * QREFvis3d(ig,l,iaer) /
+!     &          ( rho_dust * reffrad(ig,l,iaer) )  ) *
+!     &          more_dust(ig,l,1) *
+!     &          ( pplev(ig,l) - pplev(ig,l+1) ) / g
+!             ENDDO
+!        ENDDO
+
+
+      firstcall = .false.
+      ENDIF  !!! firstcall
+
+c -----------------------------------------------------------------
+c Computing the number of condensation nuclei
+c -----------------------------------------------------------------
+      DO iaer = 1, naerkind ! Loop on aerosol kind
+c     --------------------------------------------
+        aerkind2: SELECT CASE (name_iaer(iaer))
+c==================================================================
+        CASE("dust_conrath") aerkind2     ! Typical dust profile
+c==================================================================
+          DO l=1,nlayer
+            DO ig=1,ngrid
+              ccn(ig,l) = max(aerosol(ig,l,iaer) /
+     &                  pi / QREFvis3d(ig,l,iaer) *
+     &                  (1.+nueffrad(ig,l,iaer))**3. /
+     &                  reffrad(ig,l,iaer)**2. * g /
+     &                  (pplev(ig,l)-pplev(ig,l+1)),1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        CASE("dust_doubleq") aerkind2!Two-moment scheme for dust
+c        (transport of mass and number mixing ratio)
+c==================================================================
+          qtot(1:ngridmx) = 0.
+          DO l=1,nlayer
+            DO ig=1,ngrid
+
+c--------------------------------------------------------------
+c commented useless because (mass mixing ration have a real physical sense now)
+c---------------------------------------------------------------------
+c       if (localstorm. NE. .true.) then
+c              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * tauref(ig) *
+c     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+c       else
+c              qdust(ig,l) = pq(ig,l,igcm_dust_mass) * taureftache(ig) *
+c     &                      pplev(ig,1) / 700.E0 / taudusttmp(ig)
+c       endif
+c              qtot(ig) = qtot(ig) + qdust(ig,l) *
+c     &                   (pplev(ig,l)-pplev(ig,l+1)) / g
+              ccn(ig,l) = max( ( ref_r0 /
+     &                    reffrad(ig,l,iaer) )**3. *
+     &                    r3n_q * pq(ig,l,igcm_dust_mass) ,1e-30)
+            ENDDO
+          ENDDO
+c==================================================================
+        END SELECT aerkind2
+c     -----------------------------------
+      ENDDO ! iaer (loop on aerosol kind)
+
+
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+c  Reduce number of nuclei
+!         TEMPORAIRE : r�duction du nombre de nuclei FF 04/200
+!         reduction facteur 3
+!         ccn(ig,l) = ccn(ig,l) / 27.
+!         reduction facteur 2
+!         ccn(ig,l) = ccn(ig,l) / 8.
+c -----------------------------------------------------------------
+       write(*,*) "water_param CCN reduc. fac. ", ccn_factor
+       DO l=1,nlayer
+         DO ig=1,ngrid
+            ccn(ig,l) = ccn(ig,l) / ccn_factor
+         ENDDO
+       ENDDO
+c -----------------------------------------------------------------
+c -----------------------------------------------------------------
+
+
+c -----------------------------------------------------------------
+c Column integrated visible optical depth in each point
+c -----------------------------------------------------------------
+      DO iaer=1,naerkind
+        do l=1,nlayer
+           do ig=1,ngrid
+             tau(ig,iaer) = tau(ig,iaer) + aerosol(ig,l,iaer)
+           end do
+        end do
+      ENDDO
+
+                
+c -----------------------------------------------------------------
+c Density scaled opacity and column opacity output
+c -----------------------------------------------------------------
+      dsodust(1:ngrid,1:nlayer) = 0.
+      DO iaer=1,naerdust
+        DO l=1,nlayer
+          DO ig=1,ngrid
+            dsodust(ig,l) = dsodust(ig,l) +
+     &                      aerosol(ig,l,iaerdust(iaer)) * g /
+     &                      (pplev(ig,l) - pplev(ig,l+1))
+          ENDDO
+        ENDDO
+        IF (ngrid.NE.1) THEN
+          write(txt2,'(i1.1)') iaer
+          call WRITEDIAGFI(ngridmx,'taudust'//txt2,
+     &                    'Dust col opacity',
+     &                    ' ',2,tau(1,iaerdust(iaer)))
+          IF (callstats) THEN
+            CALL wstats(ngridmx,'taudust'//txt2,
+     &                 'Dust col opacity',
+     &                 ' ',2,tau(1,iaerdust(iaer)))
+          ENDIF
+        ENDIF
+      ENDDO
+
+      IF (ngrid.NE.1) THEN
+c       CALL WRITEDIAGFI(ngridmx,'dsodust','tau*g/dp',
+c    &                    'm2.kg-1',3,dsodust)
+        IF (callstats) THEN
+          CALL wstats(ngridmx,'dsodust',
+     &               'tau*g/dp',
+     &               'm2.kg-1',3,dsodust)
+        ENDIF
+c       CALL WRITEDIAGFI(ngridmx,'ccn','Cond. nuclei',
+c    &                    'part kg-1',3,ccn)
+      ELSE
+        CALL writeg1d(ngrid,nlayer,dsodust,'dsodust','m2.kg-1')
+      ENDIF
+c -----------------------------------------------------------------
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite.F	(revision 308)
@@ -0,0 +1,1 @@
+link callradite_tachemobile_z.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite_tachemobile_z.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite_tachemobile_z.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite_tachemobile_z.F	(revision 308)
@@ -0,0 +1,563 @@
+      SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice,zdqnorm,dsodust)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call the main canonic
+c   radiative transfer subroutine "lwmain" et "swmain"
+c   to compute radiative heating and cooling rate and
+c   radiative fluxes to the surface.
+c
+c   These calculations are only valid on the part of the atmosphere
+c   where Local Thermal Equilibrium (NLTE) is verified. In practice
+c   The calculations are only performed for the first "nlaylte"
+c   parameters (nlaylte is calculated by subroutine "nlthermeq"
+c   and stored in common "yomlw.h").
+c
+c   The purpose of this subroutine is to:
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h
+c      3) Compute the 3D scattering parameters depending on the
+c        size distribution of the different tracers (added by JBM)
+c      4) call "lwmain" and "swmain"
+c
+c
+c   authors:   
+c   ------
+c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
+c
+c
+c   3D scattering scheme user's guide (J.-B. Madeleine)
+c   ---------------------------------
+c
+c   This routine has been modified to take into account 3D, time
+c   dependent scattering properties of the aerosols.
+c---- The look-up tables that contain the scattering parameters
+c   of a given tracer, for different sizes, are read by SUAER.F90.
+c   The names of the corresponding ASCII files have to be set in
+c   this subroutine (file_id variable), and files must be in the
+c   directory specified in datafile.h. Please make sure that the
+c   ASCII files are correctly written, and that the range
+c   of particle sizes is consistent with what you would expect.
+c---- SUAER.F90 is in charge of reading the ASCII files and averaging
+c   the scattering parameters in each GCM channel, using the three last
+c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
+c---- These look-up tables, loaded during the firstcall, are then
+c   constantly used by the subroutine "aeroptproperties.F" to compute,
+c   online, the 3D scattering parameters, based on the size distribution
+c   (reffrad and nueffrad) of the different tracers, in each grid box.
+c   These 3D size distributions are loaded by the "updatereffrad.F"
+c   subroutine. A log-normal distribution is then assumed in
+c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+c---- The optical depth at the visible reference wavelength (set in
+c   SUAER.F90, after the file_id variable) is then computed by
+c   the subroutine "aeropacity.F", by using the size and spatial
+c   distribution of the corresponding tracer. This connection has to
+c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
+c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
+c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
+c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and 
+c   swmain.F to solve the radiative transfer equation.
+c
+c   changes:
+c   -------
+c
+c   > SRL 7/2000
+c   
+c   This version has been modified to only calculate radiative tendencies
+c   over layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+c   layers, if any.
+c   In other routines, nlayermx -> nflev.
+c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
+c
+c   > J.-B. Madeleine 10W12
+c   This version uses the variable's splitting, which can be usefull
+c     when performing very high resolution simulation like LES.
+c
+c   ----------
+c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
+c   set in dimradmars.h 
+c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
+c   set in dimradmars.h 
+c
+c   input:
+c   ----- 
+c   icount                counter of call to subroutine physic by gcm
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   nq                    Number of tracer
+c   ls                    Solar longitude (Ls) , radian
+c   zday                  Date (time since Ls=0, in martian days)
+c   pq(ngrid,nlayer,nq)   Advected fields
+c
+c   albedo (ngrid,2)      hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1 
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c   emis                  Thermal IR surface emissivity (no unit)
+c   mu0(ngridmx)           cos of solar zenith angle
+c                           (=1 when sun at zenith)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
+c   tsurf(ngrid)           surface temperature (K)
+c   fract(ngridmx)         day fraction of the time interval 
+c                          =1 during the full day ; =0 during the night
+c   declin                 latitude of subsolar point
+c   dist_sol               sun-Mars distance (AU)
+c   igout                  coordinate of analysed point for debugging
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
+
+c
+c  output:
+c  -------
+c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
+c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
+c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
+c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
+c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
+c
+c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
+c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
+c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
+
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical
+c                         properties.
+
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "yomlw.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER icount        
+      INTEGER ngrid,nlayer,nq 
+      INTEGER igout
+
+      REAL pq(ngrid,nlayer,nq)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL albedo(ngrid,2),emis(ngrid)
+      REAL ls,zday
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer)         ! Usefull in Aeropacity.F
+      REAL tsurf(ngrid)
+      REAL dist_sol,mu0(ngrid),fract(ngrid)
+      REAL dtlw(ngridmx,nlayermx),dtsw(ngridmx,nlayermx)
+      REAL fluxsurf_lw(ngridmx), fluxtop_lw(ngridmx)
+      REAL fluxsurf_sw(ngridmx,2), fluxtop_sw(ngridmx,2)
+
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL rdust(ngridmx,nlayermx)  ! Dust geometric mean radius (m)
+      REAL rice(ngridmx,nlayermx)   ! Ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)  ! Estimated effective variance
+      REAL zdqnorm(ngridmx,nlayermx,2) !Usefull in Aeropacity.F
+      REAL dsodust(ngridmx,nlayermx)   !Usefull in aeropacity.F
+c
+c    Local variables :
+c    -----------------
+
+      INTEGER j,l,ig,n,ich
+      INTEGER aer_count,iaer
+      INTEGER jd,ig0,nd
+
+      real  cste_mars ! solar constant on Mars (Wm-2)
+      REAL ptlev(ngridmx,nlayermx+1)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+c     Thermal IR net radiative budget (W m-2)
+
+      real znetrad(ndomainsz,nflev)
+
+      real zfluxd_sw(ndomainsz,nflev+1,2)
+      real zfluxu_sw(ndomainsz,nflev+1,2)
+
+      REAL zplev(ndomainsz,nflev+1)
+      REAL zztlev(ndomainsz,nflev+1)
+      REAL zplay(ndomainsz,nflev)
+      REAL zt(ndomainsz,nflev)
+      REAL zaerosol(ndomainsz,nflev,naerkind)
+      REAL zalbedo(ndomainsz,2)
+      REAL zdp(ndomainsz,nflev)
+      REAL zdt0(ndomainsz)
+
+      REAL zzdtlw(ndomainsz,nflev)
+      REAL zzdtsw(ndomainsz,nflev)
+      REAL zzflux(ndomainsz,6)
+      real zrmuz
+
+      REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
+
+      REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
+
+c     Aerosol size distribution
+      REAL :: reffrad(ngrid,nlayer,naerkind)
+      REAL :: nueffrad(ngrid,nlayer,naerkind)
+c     Aerosol optical properties
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+c   local saved variables
+c   ---------------------
+
+      real pview(ngridmx)
+      save pview
+      
+      real zco2   ! volume fraction of CO2 in Mars atmosphere
+      DATA zco2/0.95/
+      SAVE zco2
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+
+c        Please name the different scatterers here ----------------
+c        PLEASE MAKE SURE that you set up the right number of
+c          scatterers in dimradmars.h (naerkind);
+c          name_iaer(1) = "dust_conrath"   !! poussiere classique
+          name_iaer(1) = "dust_doubleq"
+cc        name_iaer(2) = "dust_submicron" !! JB: experimental
+c          name_iaer(2) = "h2o_ice"
+c        ----------------------------------------------------------
+
+c        Assign a number to the different scatterers
+c        -------------------------------------------
+
+         iaer_dust_conrath=0
+         iaer_dust_doubleq=0
+         iaer_dust_submicron=0
+         iaer_h2o_ice=0
+
+         aer_count=0
+         if (.NOT.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_conrath") then
+               iaer_dust_conrath = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (doubleq.AND.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_doubleq") then
+               iaer_dust_doubleq = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (submicron.AND.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_submicron") then
+               iaer_dust_submicron = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (water.AND.activice) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."h2o_ice") then
+               iaer_h2o_ice = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+
+c        Check that we identified all tracers:
+         if (aer_count.ne.naerkind) then
+           write(*,*) "callradite: found only ",aer_count," scatterers"
+           write(*,*) "               expected ",naerkind
+           write(*,*) "please make sure that the number of"
+           write(*,*) "scatterers in dimradmars.h, the names"
+           write(*,*) "in callradite.F, and the flags in"
+           write(*,*) "callphys.def are all consistent!"
+           do iaer=1,naerkind
+             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
+           enddo
+           stop
+         else
+           write(*,*) "callradite: found all scatterers, namely:"
+           do iaer=1,naerkind
+             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
+           enddo
+         endif
+c        -------------------------------------------
+
+         DO ig=1,ngrid
+            pview(ig)=1.66     ! cosecant of viewing angle
+         ENDDO
+         gcp = g/cpp
+
+c        Logical tests for radiatively active water-ice clouds:
+         IF ( (activice.AND.(.NOT.water)).OR.
+     &        (activice.AND.(naerkind.LT.2)) ) THEN
+           WRITE(*,*) 'If activice is TRUE, water has to be set'
+           WRITE(*,*) 'to TRUE, and "naerkind" must be at least'
+           WRITE(*,*) 'equal to 2 in dimradmars.h.'
+           CALL ABORT
+         ELSE IF ( (.NOT.activice).AND.(naerkind.GT.1) ) THEN
+           WRITE(*,*) 'naerkind is greater than unity, but'
+           WRITE(*,*) 'activice has not been set to .true.'
+           WRITE(*,*) 'in callphys.def; this is not logical!'
+           CALL ABORT
+         ENDIF
+
+c        Loading the optical properties in external look-up tables:
+         CALL SUAER
+         CALL SULW
+
+         write(*,*) 'Splitting radiative calculations: ',
+     $              ' ngridmx,ngrid,ndomainsz,ndomain',
+     $                ngridmx,ngrid,ndomainsz,ndomain
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+         firstcall=.false.
+      END IF
+
+c     Computing aerosol optical properties and opacity
+c     ------------------------------------------------
+
+c     Updating aerosol size distributions:
+      CALL updatereffrad(ngrid,nlayer,
+     &                rdust,rice,nuice,
+     &                reffrad,nueffrad,
+     &                pq)
+
+c     Computing 3D scattering parameters:
+      CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                      QIRsQREF3d,omegaIR3d,gIR3d,
+     &                      QREFvis3d,QREFir3d,
+     &                      omegaREFvis3d,omegaREFir3d)
+
+c     Computing aerosol optical depth in each layer:
+      CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &      pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+     &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d,
+     &      zdqnorm,dsodust,pt)
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+         nd=ngridmx-ig0
+        else
+         nd=ndomainsz
+        endif
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+           do iaer = 1, naerkind
+             do ich = 1, nsun
+               zQVISsQREF3d(ig,l,ich,iaer) = 
+     &                           QVISsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaVIS3d(ig,l,ich,iaer) = 
+     &                           omegaVIS3d(ig0+ig,l,ich,iaer)
+               zgVIS3d(ig,l,ich,iaer) = 
+     &                           gVIS3d(ig0+ig,l,ich,iaer)
+             enddo
+             do ich = 1, nir
+               zQIRsQREF3d(ig,l,ich,iaer) = 
+     &                           QIRsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaIR3d(ig,l,ich,iaer) = 
+     &                           omegaIR3d(ig0+ig,l,ich,iaer)
+               zgIR3d(ig,l,ich,iaer) = 
+     &                           gIR3d(ig0+ig,l,ich,iaer)
+             enddo
+           enddo
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          zplev(ig,l) = pplev(ig0+ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          zplay(ig,l) = pplay(ig0+ig,l)
+          zt(ig,l) = pt(ig0+ig,l)
+c         Thickness of each layer (Pa) :
+          zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
+         enddo
+        enddo
+
+        do n=1,naerkind
+          do l=1,nlaylte
+            do ig=1,nd
+              zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+            enddo
+          enddo
+        enddo
+
+        do j=1,2
+          do ig = 1,nd
+           zalbedo(ig,j) = albedo(ig0+ig,j)
+          enddo
+        enddo
+
+c       Intermediate  levels: (computing tlev)
+c       ---------------------------------------
+c       Extrapolation for the air temperature above the surface
+        DO ig=1,nd
+              zztlev(ig,1)=zt(ig,1)+
+     s        (zplev(ig,1)-zplay(ig,1))*
+     s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
+
+              zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
+        ENDDO
+
+        DO l=2,nlaylte
+         DO ig=1, nd
+               zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l)) 
+         ENDDO
+        ENDDO
+
+        DO ig=1, nd
+           zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
+        ENDDO
+
+
+c       Longwave ("lw") radiative transfer (= thermal infrared)
+c       -------------------------------------------------------
+        call lwmain (ig0,icount,nd,nflev
+     .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
+     .        ,zaerosol,zzdtlw
+     .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
+     .        ,znetrad
+     &        ,zQIRsQREF3d,zomegaIR3d,zgIR3d)
+
+c       Shortwave ("sw") radiative transfer (= solar radiation)
+c       -------------------------------------------------------
+c          Mars solar constant (W m-2)
+c          1370 W.m-2 is the solar constant at 1 AU.
+           cste_mars=1370./(dist_sol*dist_sol)
+
+           call swmain ( nd, nflev,
+     S     cste_mars, zalbedo,
+     S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
+     S     zzdtsw, zfluxd_sw, zfluxu_sw,
+     &     zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
+
+c       ------------------------------------------------------------
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          dtlw(ig0+ig,l) = zzdtlw(ig,l)
+          dtsw(ig0+ig,l) = zzdtsw(ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          ptlev(ig0+ig,l) = zztlev(ig,l)
+         enddo
+        enddo
+
+        do ig = 1,nd
+          fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+          fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+          fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+          fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+c     Zero tendencies for any remaining layers between nlaylte and nlayer
+      if (nlayer.gt.nlaylte) then
+         do l = nlaylte+1, nlayer
+            do ig = 1, ngrid
+               dtlw(ig, l) = 0.
+               dtsw(ig, l) = 0.
+            enddo
+         enddo
+      endif
+
+c     Output for debugging if lwrite=T
+c     --------------------------------
+c     Write all nlayer layers, even though only nlaylte layers may have
+c     non-zero tendencies.
+
+         IF(lwrite) THEN
+            PRINT*,'Diagnotique for the radiation'
+            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
+            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
+     s           fract(igout), fluxsurf_lw(igout),
+     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
+            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
+            PRINT*,'daysec',daysec
+            DO l=1,nlayer
+               PRINT*,pt(igout,l),ptlev(igout,l),
+     s         pplay(igout,l),pplev(igout,l),
+     s         dtsw(igout,l),dtlw(igout,l)
+            ENDDO
+         ENDIF
+
+
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite_used.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite_used.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/callradite_used.F	(revision 308)
@@ -0,0 +1,563 @@
+      SUBROUTINE callradite(icount,ngrid,nlayer,nq,zday,ls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice,zdqnorm,dsodust)
+
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Subroutine designed to call the main canonic
+c   radiative transfer subroutine "lwmain" et "swmain"
+c   to compute radiative heating and cooling rate and
+c   radiative fluxes to the surface.
+c
+c   These calculations are only valid on the part of the atmosphere
+c   where Local Thermal Equilibrium (NLTE) is verified. In practice
+c   The calculations are only performed for the first "nlaylte"
+c   parameters (nlaylte is calculated by subroutine "nlthermeq"
+c   and stored in common "yomlw.h").
+c
+c   The purpose of this subroutine is to:
+c      1) Make some initial calculation at first call
+c      2) Split the calculation in several sub-grid
+c        ("sub-domain") to save memory and
+c        be able run on a workstation at high resolution
+c        The sub-grid size is defined in dimradmars.h
+c      3) Compute the 3D scattering parameters depending on the
+c        size distribution of the different tracers (added by JBM)
+c      4) call "lwmain" and "swmain"
+c
+c
+c   authors:   
+c   ------
+c   Francois Forget / Christophe Hourdin / J.-B. Madeleine (2009)
+c
+c
+c   3D scattering scheme user's guide (J.-B. Madeleine)
+c   ---------------------------------
+c
+c   This routine has been modified to take into account 3D, time
+c   dependent scattering properties of the aerosols.
+c---- The look-up tables that contain the scattering parameters
+c   of a given tracer, for different sizes, are read by SUAER.F90.
+c   The names of the corresponding ASCII files have to be set in
+c   this subroutine (file_id variable), and files must be in the
+c   directory specified in datafile.h. Please make sure that the
+c   ASCII files are correctly written, and that the range
+c   of particle sizes is consistent with what you would expect.
+c---- SUAER.F90 is in charge of reading the ASCII files and averaging
+c   the scattering parameters in each GCM channel, using the three last
+c   equations of Forget et al. 1998 (GRL 25, No.7, p.1105-1108).
+c---- These look-up tables, loaded during the firstcall, are then
+c   constantly used by the subroutine "aeroptproperties.F" to compute,
+c   online, the 3D scattering parameters, based on the size distribution
+c   (reffrad and nueffrad) of the different tracers, in each grid box.
+c   These 3D size distributions are loaded by the "updatereffrad.F"
+c   subroutine. A log-normal distribution is then assumed in
+c   "aeroptproperties.F", along with a Gauss-Legendre integration.
+c---- The optical depth at the visible reference wavelength (set in
+c   SUAER.F90, after the file_id variable) is then computed by
+c   the subroutine "aeropacity.F", by using the size and spatial
+c   distribution of the corresponding tracer. This connection has to
+c   be implemented in "aeropacity.F" when adding a new tracer. To do so,
+c   one can use equation 2 of Forget et al. 1998 (Icarus 131, p.302-316).
+c---- The resulting variables "aerosol", "QVISsQREF3d", "omegaVIS3d" and
+c   "gVIS3d" (same in the infrared) are finally used by lwmain.F and 
+c   swmain.F to solve the radiative transfer equation.
+c
+c   changes:
+c   -------
+c
+c   > SRL 7/2000
+c   
+c   This version has been modified to only calculate radiative tendencies
+c   over layers 1..NFLEV (set in dimradmars.h).  Returns zero for higher
+c   layers, if any.
+c   In other routines, nlayermx -> nflev.
+c   Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn.
+c
+c   > J.-B. Madeleine 10W12
+c   This version uses the variable's splitting, which can be usefull
+c     when performing very high resolution simulation like LES.
+c
+c   ----------
+c   Here, solar band#1 is spectral interval between "long1vis" and "long2vis"
+c   set in dimradmars.h 
+c   Here, solar band#2 is spectral interval between "long2vis" and "long3vis"
+c   set in dimradmars.h 
+c
+c   input:
+c   ----- 
+c   icount                counter of call to subroutine physic by gcm
+c   ngrid                 number of gridpoint of horizontal grid
+c   nlayer                Number of layer
+c   nq                    Number of tracer
+c   ls                    Solar longitude (Ls) , radian
+c   zday                  Date (time since Ls=0, in martian days)
+c   pq(ngrid,nlayer,nq)   Advected fields
+c
+c   albedo (ngrid,2)      hemispheric surface albedo
+c                         albedo (i,1) : mean albedo for solar band#1 
+c                                        (see below)
+c                         albedo (i,2) : mean albedo for solar band#2
+c                                        (see below)
+c   emis                  Thermal IR surface emissivity (no unit)
+c   mu0(ngridmx)           cos of solar zenith angle
+c                           (=1 when sun at zenith)
+c   pplay(ngrid,nlayer)    pressure (Pa) in the middle of each layer
+c   pplev(ngrid,nlayer+1)  pressure (Pa) at boundaries of each layer
+c   pt(ngrid,nlayer)       atmospheric temperature in each layer (K)
+c   tsurf(ngrid)           surface temperature (K)
+c   fract(ngridmx)         day fraction of the time interval 
+c                          =1 during the full day ; =0 during the night
+c   declin                 latitude of subsolar point
+c   dist_sol               sun-Mars distance (AU)
+c   igout                  coordinate of analysed point for debugging
+c   reffrad(ngrid,nlayer,naerkind)  Aerosol effective radius
+c   nueffrad(ngrid,nlayer,naerkind) Aerosol effective variance
+
+c
+c  output:
+c  -------
+c dtlw (ngrid,nlayer)       longwave (IR) heating rate (K/s)
+c dtsw(ngrid,nlayer)        shortwave (Solar) heating rate (K/s)
+c fluxsurf_lw(ngrid)        surface downward flux tota LW (thermal IR) (W.m-2)
+c fluxsurf_sw(ngrid,1)      surface downward flux SW for solar band#1 (W.m-2)
+c fluxsurf_sw(ngrid,2)      surface downward flux SW for solar band#2 (W.m-2)
+c
+c fluxtop_lw(ngrid)         outgoing upward flux tota LW (thermal IR) (W.m-2)
+c fluxtop_sw(ngrid,1)       outgoing upward flux SW for solar band#1 (W.m-2)
+c fluxtop_sw(ngrid,2)       outgoing upward flux SW for solar band#2 (W.m-2)
+
+c   tauref       Prescribed mean column optical depth at 700 Pa 
+c   tau          Column total visible dust optical depth at each point
+c   aerosol(ngrid,nlayer,naerkind)    aerosol extinction optical depth
+c                         at reference wavelength "longrefvis" set
+c                         in dimradmars.h , in each layer, for one of
+c                         the "naerkind" kind of aerosol optical
+c                         properties.
+
+c=======================================================================
+c
+c    Declarations :
+c    -------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "yomlw.h"
+#include "aerkind.h"
+
+c-----------------------------------------------------------------------
+c    Input/Output
+c    ------------
+      INTEGER icount        
+      INTEGER ngrid,nlayer,nq 
+      INTEGER igout
+
+      REAL pq(ngrid,nlayer,nq)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      REAL albedo(ngrid,2),emis(ngrid)
+      REAL ls,zday
+
+      REAL pplev(ngrid,nlayer+1),pplay(ngrid,nlayer)
+      REAL pt(ngrid,nlayer)
+      REAL tsurf(ngrid)
+      REAL dist_sol,mu0(ngrid),fract(ngrid)
+      REAL dtlw(ngridmx,nlayermx),dtsw(ngridmx,nlayermx)
+      REAL fluxsurf_lw(ngridmx), fluxtop_lw(ngridmx)
+      REAL fluxsurf_sw(ngridmx,2), fluxtop_sw(ngridmx,2)
+
+      REAL tauref(ngrid), tau(ngrid,naerkind)
+      REAL aerosol(ngrid,nlayer,naerkind)
+      REAL rdust(ngridmx,nlayermx)  ! Dust geometric mean radius (m)
+      REAL rice(ngridmx,nlayermx)   ! Ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)  ! Estimated effective variance
+      REAL zdqnorm(ngridmx,nlayermx,2)  !Usefull in aeropacity.F
+      REAL dsodust(ngridmx,nlayermx)    !Usefull in aeropacity.F
+c
+c    Local variables :
+c    -----------------
+
+      INTEGER j,l,ig,n,ich
+      INTEGER aer_count,iaer
+      INTEGER jd,ig0,nd
+
+      real  cste_mars ! solar constant on Mars (Wm-2)
+      REAL ptlev(ngridmx,nlayermx+1)
+
+      INTEGER ndomain
+      parameter (ndomain = (ngridmx-1) / ndomainsz + 1)
+
+c     Thermal IR net radiative budget (W m-2)
+
+      real znetrad(ndomainsz,nflev)
+
+      real zfluxd_sw(ndomainsz,nflev+1,2)
+      real zfluxu_sw(ndomainsz,nflev+1,2)
+
+      REAL zplev(ndomainsz,nflev+1)
+      REAL zztlev(ndomainsz,nflev+1)
+      REAL zplay(ndomainsz,nflev)
+      REAL zt(ndomainsz,nflev)
+      REAL zaerosol(ndomainsz,nflev,naerkind)
+      REAL zalbedo(ndomainsz,2)
+      REAL zdp(ndomainsz,nflev)
+      REAL zdt0(ndomainsz)
+
+      REAL zzdtlw(ndomainsz,nflev)
+      REAL zzdtsw(ndomainsz,nflev)
+      REAL zzflux(ndomainsz,6)
+      real zrmuz
+
+      REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind)
+      REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind)
+
+      REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind)
+      REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind)
+
+c     Aerosol size distribution
+      REAL :: reffrad(ngrid,nlayer,naerkind)
+      REAL :: nueffrad(ngrid,nlayer,naerkind)
+c     Aerosol optical properties
+      REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind)
+      REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind)
+
+      REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind)
+      REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind)
+
+      REAL :: QREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: QREFir3d(ngridmx,nlayermx,naerkind)
+
+      REAL :: omegaREFvis3d(ngridmx,nlayermx,naerkind)
+      REAL :: omegaREFir3d(ngridmx,nlayermx,naerkind)
+
+c   local saved variables
+c   ---------------------
+
+      real pview(ngridmx)
+      save pview
+      
+      real zco2   ! volume fraction of CO2 in Mars atmosphere
+      DATA zco2/0.95/
+      SAVE zco2
+
+      LOGICAL firstcall
+      DATA firstcall/.true./
+      SAVE firstcall
+
+c----------------------------------------------------------------------
+
+c     Initialisation
+c     --------------
+
+      IF (firstcall) THEN
+
+c        Please name the different scatterers here ----------------
+c        PLEASE MAKE SURE that you set up the right number of
+c          scatterers in dimradmars.h (naerkind);
+c          name_iaer(1) = "dust_conrath"   !! poussiere classique
+          name_iaer(1) = "dust_doubleq"
+cc        name_iaer(2) = "dust_submicron" !! JB: experimental
+c          name_iaer(2) = "h2o_ice"
+c        ----------------------------------------------------------
+
+c        Assign a number to the different scatterers
+c        -------------------------------------------
+
+         iaer_dust_conrath=0
+         iaer_dust_doubleq=0
+         iaer_dust_submicron=0
+         iaer_h2o_ice=0
+
+         aer_count=0
+         if (.NOT.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_conrath") then
+               iaer_dust_conrath = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (doubleq.AND.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_doubleq") then
+               iaer_dust_doubleq = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (submicron.AND.active) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."dust_submicron") then
+               iaer_dust_submicron = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+         if (water.AND.activice) then
+           do iaer=1,naerkind
+             if (name_iaer(iaer).eq."h2o_ice") then
+               iaer_h2o_ice = iaer
+               aer_count = aer_count + 1
+             endif
+           enddo
+         endif
+
+c        Check that we identified all tracers:
+         if (aer_count.ne.naerkind) then
+           write(*,*) "callradite: found only ",aer_count," scatterers"
+           write(*,*) "               expected ",naerkind
+           write(*,*) "please make sure that the number of"
+           write(*,*) "scatterers in dimradmars.h, the names"
+           write(*,*) "in callradite.F, and the flags in"
+           write(*,*) "callphys.def are all consistent!"
+           do iaer=1,naerkind
+             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
+           enddo
+           stop
+         else
+           write(*,*) "callradite: found all scatterers, namely:"
+           do iaer=1,naerkind
+             write(*,*)'      ',iaer,' ',trim(name_iaer(iaer))
+           enddo
+         endif
+c        -------------------------------------------
+
+         DO ig=1,ngrid
+            pview(ig)=1.66     ! cosecant of viewing angle
+         ENDDO
+         gcp = g/cpp
+
+c        Logical tests for radiatively active water-ice clouds:
+         IF ( (activice.AND.(.NOT.water)).OR.
+     &        (activice.AND.(naerkind.LT.2)) ) THEN
+           WRITE(*,*) 'If activice is TRUE, water has to be set'
+           WRITE(*,*) 'to TRUE, and "naerkind" must be at least'
+           WRITE(*,*) 'equal to 2 in dimradmars.h.'
+           CALL ABORT
+         ELSE IF ( (.NOT.activice).AND.(naerkind.GT.1) ) THEN
+           WRITE(*,*) 'naerkind is greater than unity, but'
+           WRITE(*,*) 'activice has not been set to .true.'
+           WRITE(*,*) 'in callphys.def; this is not logical!'
+           CALL ABORT
+         ENDIF
+
+c        Loading the optical properties in external look-up tables:
+         CALL SUAER
+         CALL SULW
+
+         write(*,*) 'Splitting radiative calculations: ',
+     $              ' ngridmx,ngrid,ndomainsz,ndomain',
+     $                ngridmx,ngrid,ndomainsz,ndomain
+         if (ngridmx .EQ. 1) then
+           if (ndomainsz .NE. 1) then
+             print*
+             print*,'ATTENTION !!!'
+             print*,'pour tourner en 1D, '
+             print*,'fixer ndomainsz=1 dans phymars/dimradmars.h'
+             print*
+             call exit(1)
+           endif
+         endif
+         firstcall=.false.
+      END IF
+
+c     Computing aerosol optical properties and opacity
+c     ------------------------------------------------
+
+c     Updating aerosol size distributions:
+      CALL updatereffrad(ngrid,nlayer,
+     &                rdust,rice,nuice,
+     &                reffrad,nueffrad,
+     &                pq)
+
+c     Computing 3D scattering parameters:
+      CALL aeroptproperties(ngrid,nlayer,reffrad,nueffrad,
+     &                      QVISsQREF3d,omegaVIS3d,gVIS3d,
+     &                      QIRsQREF3d,omegaIR3d,gIR3d,
+     &                      QREFvis3d,QREFir3d,
+     &                      omegaREFvis3d,omegaREFir3d)
+
+c     Computing aerosol optical depth in each layer:
+      CALL aeropacity(ngrid,nlayer,nq,zday,pplay,pplev,ls,
+     &      pq,ccn,tauref,tau,aerosol,reffrad,nueffrad,
+     &      QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d,
+     &      zdqnorm,dsodust)
+
+c     Starting loop on sub-domain
+c     ----------------------------
+
+      DO jd=1,ndomain
+        ig0=(jd-1)*ndomainsz
+        if (jd.eq.ndomain) then
+         nd=ngridmx-ig0
+        else
+         nd=ndomainsz
+        endif
+
+c       Spliting input variable in sub-domain input variables
+c       ---------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+           do iaer = 1, naerkind
+             do ich = 1, nsun
+               zQVISsQREF3d(ig,l,ich,iaer) = 
+     &                           QVISsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaVIS3d(ig,l,ich,iaer) = 
+     &                           omegaVIS3d(ig0+ig,l,ich,iaer)
+               zgVIS3d(ig,l,ich,iaer) = 
+     &                           gVIS3d(ig0+ig,l,ich,iaer)
+             enddo
+             do ich = 1, nir
+               zQIRsQREF3d(ig,l,ich,iaer) = 
+     &                           QIRsQREF3d(ig0+ig,l,ich,iaer)
+               zomegaIR3d(ig,l,ich,iaer) = 
+     &                           omegaIR3d(ig0+ig,l,ich,iaer)
+               zgIR3d(ig,l,ich,iaer) = 
+     &                           gIR3d(ig0+ig,l,ich,iaer)
+             enddo
+           enddo
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          zplev(ig,l) = pplev(ig0+ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          zplay(ig,l) = pplay(ig0+ig,l)
+          zt(ig,l) = pt(ig0+ig,l)
+c         Thickness of each layer (Pa) :
+          zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1)
+         enddo
+        enddo
+
+        do n=1,naerkind
+          do l=1,nlaylte
+            do ig=1,nd
+              zaerosol(ig,l,n) = aerosol(ig0+ig,l,n)
+            enddo
+          enddo
+        enddo
+
+        do j=1,2
+          do ig = 1,nd
+           zalbedo(ig,j) = albedo(ig0+ig,j)
+          enddo
+        enddo
+
+c       Intermediate  levels: (computing tlev)
+c       ---------------------------------------
+c       Extrapolation for the air temperature above the surface
+        DO ig=1,nd
+              zztlev(ig,1)=zt(ig,1)+
+     s        (zplev(ig,1)-zplay(ig,1))*
+     s        (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2))
+
+              zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1)
+        ENDDO
+
+        DO l=2,nlaylte
+         DO ig=1, nd
+               zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l)) 
+         ENDDO
+        ENDDO
+
+        DO ig=1, nd
+           zztlev(ig,nlaylte+1)=zt(ig,nlaylte)
+        ENDDO
+
+
+c       Longwave ("lw") radiative transfer (= thermal infrared)
+c       -------------------------------------------------------
+        call lwmain (ig0,icount,nd,nflev
+     .        ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt
+     .        ,zaerosol,zzdtlw
+     .        ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1)
+     .        ,znetrad
+     &        ,zQIRsQREF3d,zomegaIR3d,zgIR3d)
+
+c       Shortwave ("sw") radiative transfer (= solar radiation)
+c       -------------------------------------------------------
+c          Mars solar constant (W m-2)
+c          1370 W.m-2 is the solar constant at 1 AU.
+           cste_mars=1370./(dist_sol*dist_sol)
+
+           call swmain ( nd, nflev,
+     S     cste_mars, zalbedo,
+     S     mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1),
+     S     zzdtsw, zfluxd_sw, zfluxu_sw,
+     &     zQVISsQREF3d,zomegaVIS3d,zgVIS3d)
+
+c       ------------------------------------------------------------
+c       Un-spliting output variable from sub-domain input variables
+c       ------------------------------------------------------------
+
+        do l=1,nlaylte
+         do ig = 1,nd
+          dtlw(ig0+ig,l) = zzdtlw(ig,l)
+          dtsw(ig0+ig,l) = zzdtsw(ig,l)
+         enddo
+        enddo
+
+        do l=1,nlaylte+1
+         do ig = 1,nd
+          ptlev(ig0+ig,l) = zztlev(ig,l)
+         enddo
+        enddo
+
+        do ig = 1,nd
+          fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1)
+          fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2)
+          fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1)
+          fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2)
+        enddo
+
+      ENDDO         !   (boucle jd=1, ndomain)
+
+c     Zero tendencies for any remaining layers between nlaylte and nlayer
+      if (nlayer.gt.nlaylte) then
+         do l = nlaylte+1, nlayer
+            do ig = 1, ngrid
+               dtlw(ig, l) = 0.
+               dtsw(ig, l) = 0.
+            enddo
+         enddo
+      endif
+
+c     Output for debugging if lwrite=T
+c     --------------------------------
+c     Write all nlayer layers, even though only nlaylte layers may have
+c     non-zero tendencies.
+
+         IF(lwrite) THEN
+            PRINT*,'Diagnotique for the radiation'
+            PRINT*,'albedo, emissiv, mu0,fract,fluxsurf_lw,fluxsurf_sw'
+            PRINT*,albedo(igout,1),emis(igout),mu0(igout),
+     s           fract(igout), fluxsurf_lw(igout),
+     $     fluxsurf_sw(igout,1)+fluxsurf_sw(igout,2)
+            PRINT*,'Tlay Tlev Play Plev dT/dt SW dT/dt LW (K/s)'
+            PRINT*,'daysec',daysec
+            DO l=1,nlayer
+               PRINT*,pt(igout,l),ptlev(igout,l),
+     s         pplay(igout,l),pplev(igout,l),
+     s         dtsw(igout,l),dtlw(igout,l)
+            ENDDO
+         ENDIF
+
+
+      return
+      end 
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/dustlift_boosted_area.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/dustlift_boosted_area.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/dustlift_boosted_area.F	(revision 308)
@@ -0,0 +1,180 @@
+      SUBROUTINE dustlift(ngrid,nlay,nq,rho,
+     $                  pcdh_true,pcdh,co2ice,
+     $                  dqslift)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Dust lifting by surface winds
+c  Computing flux to the middle of the first layer
+c  (Called by vdifc)
+c
+c=======================================================================
+c--------------------------------------------------------------
+c          Update J FAURE & A SPIGA
+c               -easier lifting where dust storm is located at the beginning
+c------------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+#include "comgeomfi.h"
+
+c
+c   arguments:
+c   ----------
+
+c   INPUT
+      integer ngrid, nlay, nq  
+      real rho(ngrid)  ! density (kg.m-3) at surface
+      real pcdh_true(ngrid) ! Cd 
+      real pcdh(ngrid) ! Cd * |V| 
+      real co2ice(ngrid)
+
+c   OUTPUT
+      real dqslift(ngrid,nq) !surface dust flux to mid-layer (<0 when lifing)
+c     real pb(ngrid,nlay) ! diffusion to surface coeff.
+
+c   local:
+c   ------
+      INTEGER ig,iq
+      REAL fhoriz(ngridmx)  ! Horizontal dust flux 
+      REAL ust,us
+!!!!cc      REAL stress_seuil
+!!!!cc      SAVE stress_seuil
+      REAL stress_seuil(ngridmx)   ! stress seuil soulevement (N.m2)
+      REAL alpha_use(ngridmx,nq)
+      REAL radloc
+      REAL lonloc
+      REAL latloc
+      REAL ray(ngridmx)
+
+#ifdef MESOSCALE
+!!!! AS: In the mesoscale model we'd like to easily set
+!!!! AS: ... stress for lifting
+!!!! AS: you have to compile with -DMESOSCALE to do so
+      REAL alpha
+      INTEGER ierr
+        OPEN(99,file='stress.def',status='old',form='formatted'
+     .   ,iostat=ierr)
+        !!! no file => default values
+        IF(ierr.EQ.0) THEN
+          READ(99,*) stress_seuil
+          READ(99,*) alpha
+          write(*,*) 'USER-DEFINED threshold: ', stress_seuil, alpha
+          CLOSE(99)
+
+        ENDIF
+#endif
+
+c-------------------------------------------------------------
+c     Computing lifting parameters
+c--------------------------------------------------------------
+
+
+
+      radloc = 2.      ! radius of dust storm (degree)
+      lonloc = 85       ! center longitude of storm (deg)
+      latloc = 25       ! center latitude of storm (deg)
+
+      DO iq=1,nq
+      DO ig=1,ngrid
+
+        !!!! distance to the center
+        ray(ig)=SQRT((lati(ig)*180./pi-latloc)**2 +
+     &          (long(ig)*180./pi -lonloc)**2)
+
+
+
+            IF (ray(ig) .lt. radloc) THEN
+c-------------------------------------------------------------
+c   lifting parameters where dust storm is located at the first time step
+c--------------------------------------------------------------------------
+          alpha_use(ig,iq) = alpha_lift(iq)
+          stress_seuil(ig) = 0.000225
+            ELSE
+c-------------------------------------------------------------------------------
+c     lifting parameters everywhere else
+c-----------------------------------------------------------------------------
+          alpha_use(ig,iq) = 0
+          stress_seuil(ig) = 1
+            END IF
+      ENDDO
+      ENDDO
+
+           PRINT*, 'alpha'
+           PRINT*, MAXVAL(alpha_use(:,igcm_dust_mass))
+           PRINT*, 'Seuil'
+           PRINT*, MINVAL(stress_seuil)
+
+
+
+c     ---------------------------------
+c     Computing horizontal flux: fhoriz
+c     ---------------------------------
+
+      do ig=1,ngrid
+          fhoriz(ig) = 0.      ! initialisation
+
+c         Selection of points where surface dust is available
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         if (latid(ig).ge.80.) goto 99  ! N permanent  polar caps
+c         if (latid(ig).le.-80.) goto 99 ! S polar deposits
+c         if  ((longd(ig).ge.-141. .and. longd(ig).le.-127.)
+c    &   .and.(latid(ig).ge.12.   .and. latid(ig).le.23.))goto 99 ! olympus
+c         if  ((longd(ig).ge.-125. .and. longd(ig).le.-118.)
+c    &   .and.(latid(ig).ge.-12.   .and. latid(ig).le.-6.))goto 99 ! Arsia
+c         if  ((longd(ig).ge.-116. .and. longd(ig).le.-109.)
+c    &   .and.(latid(ig).ge.-5.   .and. latid(ig).le. 5.))goto 99 ! pavonis
+c         if  ((longd(ig).ge.-109. .and. longd(ig).le.-100.)
+c    &   .and.(latid(ig).ge. 7.   .and. latid(ig).le. 16.))goto 99 ! ascraeus
+c         if  ((longd(ig).ge.  61. .and. longd(ig).le.  63.)
+c    &   .and.(latid(ig).ge. 63. .and. latid(ig).le. 64.))goto 99 !weird point
+          if (co2ice(ig).gt.0.) goto 99
+
+
+c         Is the wind strong enough ?
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          ust = sqrt(stress_seuil(ig)/rho(ig))
+          us = pcdh(ig) /  sqrt(pcdh_true(ig)) ! ustar=cd*v /sqrt(cd)
+          if (us.gt.ust) then
+c            If lifting ? 
+c            Calcul du flux suivant Marticorena ( en fait white (1979))
+
+             fhoriz(ig) = 2.61*(rho(ig)/g) *
+     &      (us -ust) * (us + ust)**2
+          end if
+ 99      continue
+      end do
+
+c     -------------------------------------
+c     Computing vertical flux and diffusion
+c     -------------------------------------
+ 
+       do iq=1,nq
+         do ig=1,ngrid
+             dqslift(ig,iq)= -alpha_use(ig,iq)* fhoriz(ig)
+
+
+cc  le  flux vertical remplace le terme de diffusion turb. qui est mis a zero
+c            zb(ig,1) = 0.
+cc           If surface deposition by turbulence diffusion (impaction...)
+cc           if(fhoriz(ig).ne.0) then
+cc           zb(ig,1) = zcdh(ig)*zb0(ig,1)
+cc           AMount of Surface deposition !
+cc           pdqs_dif(ig,iq)=pdqs_dif(ig,iq) +
+cc    &      zb(ig,1)*zq(ig,1,iq)/ptimestep
+cc          write(*,*) 'zb(1)  = ' ,  zb(ig,1),zcdh(ig),zb0(ig,1)
+cc
+
+         enddo
+       enddo
+
+      RETURN
+      END
+
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/dustlift_mmr-dependent.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/dustlift_mmr-dependent.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/dustlift_mmr-dependent.F	(revision 308)
@@ -0,0 +1,167 @@
+      SUBROUTINE dustlift(ngrid,nlay,nq,rho,
+     $                  pcdh_true,pcdh,co2ice,
+     $                  dqslift,pq)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c  Dust lifting by surface winds
+c  Computing flux to the middle of the first layer
+c  (Called by vdifc)
+c
+c=======================================================================
+
+c--------------------------------------------------------------
+c          Update J FAURE & A SPIGA
+c               -lifting depends on mass mixing ratio in the first layer
+c                (more dust -> easier to lift more dust)
+c------------------------------------------------------------------------
+
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "tracer.h"
+
+c
+c   arguments:
+c   ----------
+
+c   INPUT
+      integer ngrid, nlay, nq  
+      real rho(ngrid)  ! density (kg.m-3) at surface
+      real pcdh_true(ngrid) ! Cd 
+      real pcdh(ngrid) ! Cd * |V| 
+      real co2ice(ngrid)
+
+c   OUTPUT
+      real dqslift(ngrid,nq) !surface dust flux to mid-layer (<0 when lifing)
+c     real pb(ngrid,nlay) ! diffusion to surface coeff.
+
+c   local:
+c   ------
+      INTEGER ig,iq
+      REAL fhoriz(ngridmx)  ! Horizontal dust flux 
+      REAL ust,us
+!!!!cc      REAL stress_seuil
+!!!!cc      SAVE stress_seuil
+      REAL stress_seuil(ngridmx)   ! stress seuil soulevement (N.m2)
+      REAL pq(ngridmx,nlayermx,nq)
+      REAL alpha_use(ngridmx,nq)
+
+#ifdef MESOSCALE
+!!!! AS: In the mesoscale model we'd like to easily set
+!!!! AS: ... stress for lifting
+!!!! AS: you have to compile with -DMESOSCALE to do so
+      REAL alpha
+      INTEGER ierr
+        OPEN(99,file='stress.def',status='old',form='formatted'
+     .   ,iostat=ierr)
+        !!! no file => default values
+        IF(ierr.EQ.0) THEN
+!!!          READ(99,*) stress_seuil
+          READ(99,*) alpha
+!!!          write(*,*) 'USER-DEFINED threshold: ', stress_seuil, alpha
+          CLOSE(99)
+        ENDIF
+#endif
+
+
+c--------------------------------------------------------------------------------------
+c         Lifting parameters depends on mass mixing ratio pq
+c----------------------------------------------------------------------------------------
+
+       do iq=1,nq
+           do ig=1,ngrid
+
+          alpha_use(ig,iq) = alpha_lift(iq)
+     &                  * max(pq(ig,1,igcm_dust_mass),0)
+     &                           * 1.e6
+          stress_seuil(ig) = 0.0225 / max( pq(ig,1,igcm_dust_mass)
+     &                                     * 1.e6,  1            )
+
+
+
+
+      enddo
+           enddo
+
+
+          PRINT*, 'pqqqqqq'
+          PRINT*, MAXVAL(pq(:,1,igcm_dust_mass))
+          PRINT*, MINVAL(pq(:,1,igcm_dust_mass))
+          PRINT*, 'alpha'
+          PRINT*, MAXVAL(alpha_use(:,igcm_dust_mass))
+          PRINT*, MINVAL(alpha_use(:,igcm_dust_mass))
+          PRINT*, 'stress'
+          PRINT*, MAXVAL(stress_seuil)
+          PRINT*, MINVAL(stress_seuil)
+
+c     ---------------------------------
+c     Computing horizontal flux: fhoriz
+c     ---------------------------------
+
+      do ig=1,ngrid
+          fhoriz(ig) = 0.      ! initialisation
+
+c         Selection of points where surface dust is available
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         if (latid(ig).ge.80.) goto 99  ! N permanent  polar caps
+c         if (latid(ig).le.-80.) goto 99 ! S polar deposits
+c         if  ((longd(ig).ge.-141. .and. longd(ig).le.-127.)
+c    &   .and.(latid(ig).ge.12.   .and. latid(ig).le.23.))goto 99 ! olympus
+c         if  ((longd(ig).ge.-125. .and. longd(ig).le.-118.)
+c    &   .and.(latid(ig).ge.-12.   .and. latid(ig).le.-6.))goto 99 ! Arsia
+c         if  ((longd(ig).ge.-116. .and. longd(ig).le.-109.)
+c    &   .and.(latid(ig).ge.-5.   .and. latid(ig).le. 5.))goto 99 ! pavonis
+c         if  ((longd(ig).ge.-109. .and. longd(ig).le.-100.)
+c    &   .and.(latid(ig).ge. 7.   .and. latid(ig).le. 16.))goto 99 ! ascraeus
+c         if  ((longd(ig).ge.  61. .and. longd(ig).le.  63.)
+c    &   .and.(latid(ig).ge. 63. .and. latid(ig).le. 64.))goto 99 !weird point
+          if (co2ice(ig).gt.0.) goto 99
+
+
+c         Is the wind strong enough ?
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          ust = sqrt(stress_seuil(ig)/rho(ig))
+          us = pcdh(ig) /  sqrt(pcdh_true(ig)) ! ustar=cd*v /sqrt(cd)
+          if (us.gt.ust) then
+c            If lifting ? 
+c            Calcul du flux suivant Marticorena ( en fait white (1979))
+
+             fhoriz(ig) = 2.61*(rho(ig)/g) *
+     &      (us -ust) * (us + ust)**2
+          end if
+ 99      continue
+      end do
+
+c     -------------------------------------
+c     Computing vertical flux and diffusion
+c     -------------------------------------
+ 
+       do iq=1,nq
+         do ig=1,ngrid
+             dqslift(ig,iq)= -alpha_use(ig,iq)* fhoriz(ig)
+
+
+cc  le  flux vertical remplace le terme de diffusion turb. qui est mis a zero
+c            zb(ig,1) = 0.
+cc           If surface deposition by turbulence diffusion (impaction...)
+cc           if(fhoriz(ig).ne.0) then
+cc           zb(ig,1) = zcdh(ig)*zb0(ig,1)
+cc           AMount of Surface deposition !
+cc           pdqs_dif(ig,iq)=pdqs_dif(ig,iq) +
+cc    &      zb(ig,1)*zq(ig,1,iq)/ptimestep
+cc          write(*,*) 'zb(1)  = ' ,  zb(ig,1),zcdh(ig),zb0(ig,1)
+cc
+
+         enddo
+       enddo
+
+      RETURN
+      END
+
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq.F	(revision 308)
@@ -0,0 +1,1 @@
+link meso_physiq_used.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq_tachefixe.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq_tachefixe.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq_tachefixe.F	(revision 308)
@@ -0,0 +1,1971 @@
+      SUBROUTINE meso_physiq(ngrid,nlayer,nq,
+     $            firstcall,lastcall,
+     $            wday_ini,
+     $            pday,ptime,ptimestep,
+     $            pplev,pplay,pphi,
+     $            pu,pv,pt,pq,pw,
+     $            wtnom,
+     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn,
+     $            wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,
+     $            wisoil,wdsoil,
+     $            wecritphys,
+#ifdef MESOSCALE
+     $            output_tab2d, output_tab3d,
+#endif
+     $            flag_LES)
+
+
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+c
+c       ... CHECK THE ****WRF lines
+c
+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. dust bomb propagative perturbation
+c     11. 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     12. 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           new WRF version: Aymeric Spiga (01/2009)
+c           
+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    pw(ngrid,?)           vertical velocity
+c
+c
+c    ****WRF 
+c       day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs
+c               and locally saved variables
+c                       (no need to call phyetat0)
+c
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx,nqmx)   /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"     !!! new soil common 
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "watercap.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+!!!!**** SPECIFIC TO MESOSCALE
+#ifdef MESOSCALE
+#include "meso_slope.h"
+#include "wrf_output_2d.h"
+#include "wrf_output_3d.h"
+#endif
+
+#include "advtrac.h"   !!! this is necessary for tracers (in dyn3d)
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+!!! ****WRF WRF specific to mesoscale
+      INTEGER wday_ini
+      REAL wtsurf(ngridmx)  ! input only ay firstcall - output
+      REAL wtsoil(ngridmx,nsoilmx)
+      REAL wisoil(ngridmx,nsoilmx)  !! new soil scheme
+      REAL wdsoil(ngridmx,nsoilmx)   !! new soil scheme
+      REAL wco2ice(ngridmx)
+      REAL wemis(ngridmx)
+      REAL wqsurf(ngridmx,nqmx)
+      REAL wq2(ngridmx,nlayermx+1)
+      REAL wecritphys
+#ifdef MESOSCALE
+      REAL output_tab2d(ngridmx,n2d)
+      REAL output_tab3d(ngridmx,nlayer,n3d)
+#endif
+      REAL sl_ls, sl_lct, sl_lat, sl_tau, sl_alb, sl_the, sl_psi
+      REAL sl_fl0, sl_flu
+      REAL sl_ra, sl_di0
+      REAL sky
+      REAL hfx(ngridmx)    !! pour LES avec isfflx!=0
+      REAL ust(ngridmx)    !! pour LES avec isfflx!=0
+      LOGICAL flag_LES     !! pour LES avec isfflx!=0
+      REAL qsurfice(ngridmx) !!usefull for diagnostics
+      REAL qsurfice_dust(ngridmx) !! usefull for dust diagnostics
+      real alpha,lay1 ! coefficients for building layers
+      integer iloop
+      INTEGER tracerset    !!! this corresponds to config%mars
+!!! ****WRF WRF specific to mesoscale
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+      CHARACTER (len=20) :: wtnom(nqmx) ! tracer name
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx) ! surface pressure tendency
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind)
+      REAL TAU_lay(ngridmx) !true opacity (it's not e reference life tauref)
+      REAL dsodust(ngridmx,nlayermx)
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad_sky(ngridmx)      ! rad. flux from sky absorbed by surface (W.m-2)
+      REAL fluxrad(ngridmx)          ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy 
+      INTEGER ig_vl1                 ! Grid Point near VL1   (for diagnostic) 
+
+c     Variables used by the water ice microphysical scheme:
+      REAL rice(ngridmx,nlayermx)    ! Water ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+                                     !   of the size distribution
+c     Albedo of deposited surface ice
+      !!REAL, PARAMETER :: alb_surfice = 0.4 ! 0.45
+      REAL, PARAMETER :: alb_surfice = 0.45 !!TESTS_JB
+
+      SAVE day_ini, icount
+      SAVE aerosol, tsurf,tsoil
+      SAVE co2ice,albedo,emis, q2
+      SAVE capcal,fluxgrd,dtrad,fluxrad,fluxrad_sky,qsurf
+      SAVE ig_vl1
+
+      REAL stephan   
+      DATA stephan/5.67e-08/  ! Stephan Boltzman constant
+      SAVE stephan
+
+c Local variables :
+c -----------------
+
+      REAL CBRT
+      EXTERNAL CBRT
+
+      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq,i, tapphys
+
+      REAL fluxsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngridmx)           ! Reference column optical depth at 700 Pa
+                                     ! (used if active=F) 
+      REAL tau(ngridmx,naerkind)     ! Column dust optical depth at each point
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngridmx,nlayermx)   ! altitude at the middle of the layers
+      REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries
+      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngridmx,nqmx)
+      REAL zdtlw(ngridmx,nlayermx)     ! (K/s)
+      REAL zdtsw(ngridmx,nlayermx)     ! (K/s)
+      REAL cldtlw(ngridmx,nlayermx)     ! (K/s) LW heating rate for clear area
+      REAL cldtsw(ngridmx,nlayermx)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngridmx,nlayermx) ! (K/s)
+      REAL zdtnlte(ngridmx,nlayermx)   ! (K/s)
+      REAL zdtsurf(ngridmx)            ! (K/s)
+      REAL zdtcloud(ngridmx,nlayermx)
+      REAL zdvdif(ngridmx,nlayermx),zdudif(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhdif(ngridmx,nlayermx), zdtsdif(ngridmx)         ! (K/s)
+      REAL zdvadj(ngridmx,nlayermx),zduadj(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhadj(ngridmx,nlayermx)                           ! (K/s)
+      REAL zdtgw(ngridmx,nlayermx)                            ! (K/s)
+      REAL zdugw(ngridmx,nlayermx),zdvgw(ngridmx,nlayermx)    ! (m.s-2)
+      REAL zdtc(ngridmx,nlayermx),zdtsurfc(ngridmx)
+      REAL zdvc(ngridmx,nlayermx),zduc(ngridmx,nlayermx)
+
+      REAL zdqdif(ngridmx,nlayermx,nqmx), zdqsdif(ngridmx,nqmx)
+cc      variables de diagnostiques detendences
+      REAL zdqsdif_diag(ngridmx)      !Usefull for lifting diagnostics
+      REAL zdqssed_diag(ngridmx)      !Usefull for sedimentation diagnostics
+      REAL pdq_diag(ngridmx)          !Usefull for dust perturbation diagnosctics
+cccccc!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      REAL zdqsed(ngridmx,nlayermx,nqmx), zdqssed(ngridmx,nqmx)
+      REAL zdqdev(ngridmx,nlayermx,nqmx), zdqsdev(ngridmx,nqmx)
+      REAL zdqadj(ngridmx,nlayermx,nqmx)
+      REAL zdqc(ngridmx,nlayermx,nqmx)
+      REAL zdqcloud(ngridmx,nlayermx,nqmx)
+      REAL zdqscloud(ngridmx,nqmx)
+      REAL zdqchim(ngridmx,nlayermx,nqmx)
+      REAL zdqschim(ngridmx,nqmx)
+
+      REAL zdteuv(ngridmx,nlayermx)    ! (K/s)
+      REAL zdtconduc(ngridmx,nlayermx) ! (K/s)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngridmx)
+      REAL zplanck(ngridmx),zpopsk(ngridmx,nlayermx)
+      REAL zdum1(ngridmx,nlayermx)
+      REAL zdum2(ngridmx,nlayermx)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngridmx,nlayermx)
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngridmx), zt(ngridmx,nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL fluxtop_sw_tot(ngridmx), fluxsurf_sw_tot(ngridmx)
+      character*2 str2
+      character*5 str5
+      real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      SAVE ccn  !! in case iradia != 1 
+      real rdust(ngridmx,nlayermx) ! dust geometric mean radius (m)
+      real qtot1,qtot2 ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+      real co2col(ngridmx)        ! CO2 column
+      REAL zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      REAL zstress(ngrid), cd
+      real hco2(nqmx),tmean, zlocal(nlayermx)
+      real rho(ngridmx,nlayermx)  ! density
+      real vmr(ngridmx,nlayermx)  ! volume mixing ratio
+      REAL mtot(ngridmx)          ! Total mass of water vapor (kg/m2)
+      REAL dustot(ngridmx)        ! Total mass of dust integrated along vertical axe (kg/m2)
+      REAL icetot(ngridmx)        ! Total mass of water ice (kg/m2)
+      REAL rave(ngridmx)          ! Mean water ice effective radius (m)
+      REAL opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+      REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! Water ice absorption coefficient
+
+
+      REAL time_phys
+
+c=======================================================================
+#ifdef MESOSCALE
+
+c 1. Initialisation:
+c -----------------
+
+c  1.1   Initialisation only at first call
+c  ---------------------------------------
+      IF (firstcall) THEN
+
+c        variables set to 0
+c        ~~~~~~~~~~~~~~~~~~
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         call zerophys(ngrid*nlayer,dtrad)
+         call zerophys(ngrid,fluxrad)
+
+c        read startfi 
+c        ~~~~~~~~~~~~
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c ****WRF
+c 
+c       No need to use startfi.nc
+c               > part of the job of phyetat0 is done in inifis
+c               > remaining initializations are passed here from the WRF variables
+c               > beware, some operations were done by phyetat0 (ex: tracers)
+c                       > if any problems, look in phyetat0
+c
+      tsurf(:)=wtsurf(:)
+      PRINT*,'check: tsurf ',tsurf(1),tsurf(ngridmx)
+      tsoil(:,:)=wtsoil(:,:)
+      PRINT*,'check: tsoil ',tsoil(1,1),tsoil(ngridmx,nsoilmx)
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+     !!!new physics
+      inertiedat(:,:)=wisoil(:,:)
+      PRINT*,'check: inert ',inertiedat(1,1),inertiedat(ngridmx,nsoilmx)
+      mlayer(0:nsoilmx-1)=wdsoil(1,:)
+      PRINT*,'check: layer ', mlayer
+            !!!!!!!!!!!!!!!!! DONE in soil_setting.F 
+            ! 1.5 Build layer(); following the same law as mlayer()
+            ! Assuming layer distribution follows mid-layer law:
+            ! layer(k)=lay1*alpha**(k-1)
+            lay1=sqrt(mlayer(0)*mlayer(1))
+            alpha=mlayer(1)/mlayer(0)
+            do iloop=1,nsoilmx
+              layer(iloop)=lay1*(alpha**(iloop-1))
+            enddo
+            !!!!!!!!!!!!!!!!! DONE in soil_setting.F
+      tnom(:)=wtnom(:)   !! est rempli dans advtrac.h
+      PRINT*,'check: tracernames ', tnom
+     !!!new physics
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      emis(:)=wemis(:)
+      PRINT*,'check: emis ',emis(1),emis(ngridmx)
+      q2(:,:)=wq2(:,:)
+      PRINT*,'check: q2 ',q2(1,1),q2(ngridmx,nlayermx+1)
+      qsurf(:,:)=wqsurf(:,:)
+      PRINT*,'check: qsurf ',qsurf(1,1),qsurf(ngridmx,nqmx)
+      co2ice(:)=wco2ice(:)
+      PRINT*,'check: co2 ',co2ice(1),co2ice(ngridmx)
+      day_ini=wday_ini
+
+c       artificially filling dyn3d/control.h is also required
+c       > iphysiq is put in WRF to be set easily (cf ptimestep)
+c       > day_step is simply deduced:
+c
+      day_step=daysec/ptimestep
+      PRINT*,'Call to LMD physics:',day_step,' per Martian day'
+c
+      iphysiq=ptimestep
+c
+      ecritphy=wecritphys
+      PRINT*,'Write LMD physics each:',ecritphy,' seconds'
+              !!PRINT*,ecri_phys
+              !!PRINT*,float(ecri_phys) ...
+              !!renvoient tous deux des nombres absurdes
+              !!pourtant callkeys.h est inclus ...
+              !!
+              !!donc ecritphys est passe en argument ...
+      PRINT*,'Write LMD physics each:',ecritphy,' seconds'
+c
+      !DO iq=1, nq 
+      !  PRINT*, tnom(iq), pq(:,:,iq)
+      !ENDDO
+
+c
+c ****WRF
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+
+
+!! Read netcdf initial physical parameters.
+!         CALL phyetat0 ("startfi.nc",0,0,
+!     &         nsoilmx,nq,
+!     &         day_ini,time_phys,
+!     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+
+         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
+
+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
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         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
+
+
+c        initialize tracers
+c        ~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         ENDIF  ! end tracer
+
+      !!!!!! WRF WRF WRF MARS MARS 
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!! 
+      !!!! principe: une option 'caps=T' specifique au mesoscale
+      !!!! ... en vue d'un meso_initracer ????
+      !!!! 
+      !!!! depots permanents => albedo TES du PDS
+      !!!! depots saisonniers => alb_surfice (~0.4, cf plus bas)
+      !!!!     [!!!! y compris pour les depots saisonniers sur les depots permanents]
+      !!!!
+      !!!! --> todo: il faut garder les depots saisonniers qui viennent
+      !!!!           du GCM lorsqu'ils sont consequents
+      !!!! 
+      IF ( caps .and. (igcm_h2o_ice .ne. 0) ) THEN
+          PRINT *, 'OVERWRITING watercaptag DEFINITION in INITRACER'
+          PRINT *, 'lat>70 et alb>0.26 => watercaptag=T' 
+          !! Perennial H20 north cap defined by watercaptag=true (allows surface to be
+          !! hollowed by sublimation in vdifc).
+          do ig=1,ngridmx
+            qsurf(ig,igcm_h2o_ice)=0.  !! on jette les inputs GCM
+            if ( (lati(ig)*180./pi.gt.70.) .and.
+     .           (albedodat(ig).ge.0.26) )  then
+                    watercaptag(ig)=.true.
+                    dryness(ig) = 1.
+            else
+                    watercaptag(ig)=.false.
+                    dryness(ig) = 1.
+            endif  ! (lati, albedodat)
+          end do ! (ngridmx)
+      ELSE  ! (caps)
+          print *,'Blork !!!'
+          print *,'caps=T avec water=F ????'
+      ENDIF ! (caps)
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c ****WRF
+c
+c nosense in mesoscale modeling
+c
+cc        Determining gridpoint near Viking Lander 1 (used for diagnostic only)
+cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c         if(ngrid.ne.1) then
+c           latvl1= 22.27 
+c           lonvl1= -47.94 
+c           ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.)  -2 )*iim +
+c     &              int(1.5+(lonvl1+180)*iim/360.)
+c           write(*,*) 'Viking Lander 1 GCM point: lat,lon',
+c     &              lati(ig_vl1)*180/pi, long(ig_vl1)*180/pi
+c         end if 
+c ****WRF
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c        Initialize thermospheric parameters
+!c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!         if (callthermos) call param_read
+
+
+c        Initialize R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+
+        IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+          write(*,*)"physiq: water_param Surface ice alb:",alb_surfice
+        ENDIF
+                   
+      ENDIF        !  (end of "if firstcall")
+
+
+c ---------------------------------------------------
+c 1.2   Initializations done at every physical timestep:
+c ---------------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+c     Initialize various variables
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      call zerophys(ngrid*nlayer, pdv)
+      call zerophys(ngrid*nlayer, pdu)
+      call zerophys(ngrid*nlayer, pdt)
+      call zerophys(ngrid*nlayer*nq, pdq)
+      call zerophys(ngrid, pdpsrf)
+      call zerophys(ngrid, zflubid)
+      call zerophys(ngrid, zdtsurf)
+      call zerophys(ngrid*nq, dqsurf)
+      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     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=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Compute potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      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)
+         ENDDO
+      ENDDO
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c-----------------------------------------------------------------------
+!c    1.2.5 Compute mean mass, cp, and R
+!c    --------------------------------
+!
+!      if(photochem.or.callthermos) then
+!         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+!      endif
+
+c-----------------------------------------------------------------------
+c    2. Compute radiative tendencies :
+c------------------------------------
+
+
+      IF (callrad) THEN 
+         IF( MOD(icount-1,iradia).EQ.0) THEN
+
+           write (*,*) 'call radiative transfer'
+
+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, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+     &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+
+c          Note: Dustopacity.F has been transferred to callradite.F
+         
+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          ------------------
+cc
+cc **WRF: desormais dust_opacity est dans callradite -- modifications
+cc nveaux arguments: tauref,tau,aerosol,rice,nuice
+cc
+           CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice,dsodust)
+
+
+
+c        write(*,*) icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
+c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+c     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+c     &     tauref,tau,aerosol,rice,nuice
+c        write(*,*) fluxsurf_lw
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccc
+ccccc PARAM SLOPE : Insolation (direct + scattered)
+ccccc
+      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.*long(ig)/pi/15.
+           sl_ra  = pi*(1.0-sl_lct/12.)
+           sl_lat = 180.*lati(ig)/pi
+           sl_tau = tau(ig,1)
+           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
+           ! sait-on jamais (a cause des arrondis)
+           if (sl_fl0 .lt. sl_di0) sl_di0=sl_fl0
+     !!!!!!!!!!!!!!!!!!!!!!!!!!
+        CALL meso_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
+                !!      sl_ls = 180.*zls/pi
+                !!      sl_lct = ptime*24. + 180.*long(ig)/pi/15.
+                !!      sl_lat = 180.*lati(ig)/pi
+                !!      sl_tau = tau(ig,1)
+                !!      sl_alb = albedo(ig,l)
+                !!      sl_the = theta_sl(ig)
+                !!      sl_psi = psi_sl(ig)
+                !!      sl_fl0 = fluxsurf_sw(ig,l)
+                !!      CALL param_slope_full(sl_ls, sl_lct, sl_lat, 
+                !!     &                   sl_tau, sl_alb, 
+                !!     &                   sl_the, sl_psi, sl_fl0, 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
+ccccc
+ccccc PARAM SLOPE
+ccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+c          CO2 near infrared absorption
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           call zerophys(ngrid*nlayer,zdtnirco2)
+           if (callnirco2) then
+              call nirco2abs (ngrid,nlayer,pplay,dist_sol,
+     .                       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))
+
+            !print*,'RAD ', fluxrad_sky(ig)
+            !print*,'LW ', emis(ig)*fluxsurf_lw(ig)
+            !print*,'SW ', 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, pplay,
+     &             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)
+cccc
+cccc param slope
+cccc
+               sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
+               fluxrad(ig)=fluxrad(ig)+(1.-sky)*zplanck(ig)
+cccc
+cccc
+cccc
+           ENDDO
+
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
+            ENDDO
+         ENDDO
+
+      ENDIF ! of IF (callrad)
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c-----------------------------------------------------------------------
+!c    3. Gravity wave and subgrid scale topography drag :
+!c    -------------------------------------------------
+!
+!
+!      IF(calllott)THEN
+!
+!        CALL calldrag_noro(ngrid,nlayer,ptimestep,
+!     &                 pplay,pplev,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    -----------------------------------------
+c
+      IF (calldifv) THEN
+
+
+         DO ig=1,ngrid
+            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
+            !write (*,*), fluxrad(ig), fluxgrd(ig), zflubid(ig) 
+         ENDDO
+
+         CALL zerophys(ngrid*nlayer,zdum1)
+         CALL zerophys(ngrid*nlayer,zdum2)
+         do l=1,nlayer
+            do ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            enddo
+         enddo
+         
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif)
+
+         DO ig=1,ngrid
+          !! sensible heat flux in W/m2
+          hfx(ig) = zflubid(ig)-capcal(ig)*zdtsdif(ig)
+          !! u star in similarity theory in m/s
+          ust(ig) = 0.4
+     .               * sqrt( pu(ig,1)*pu(ig,1) + pv(ig,1)*pv(ig,1) )
+     .               / log( 1.E+0 + zzlay(ig,1)/z0 )
+         ENDDO   
+
+!         write (*,*) 'PHYS HFX cp zdts', hfx(100), zflubid(100), 
+!     .       capcal(100), 
+!     .       zdtsdif(100)
+!         write (*,*) 'PHYS UST', ust(100) 
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! LES LES 
+       IF (flag_LES) THEN        
+
+         write (*,*) '************************************************' 
+         write (*,*) '** LES mode: the difv part is only used to'
+         write (*,*) '**  provide HFX and UST to the dynamics'
+         write (*,*) '** NB: - dudif, dvdif, dhdif, dqdif are set to 0'
+         write (*,*) '**     - tsurf is updated'     
+         write (*,*) '************************************************'
+
+!!!
+!!! WRF WRF LES LES : en fait le subgrid scale n'etait pas mis a zero !!
+!!!         
+         DO ig=1,ngrid
+!          !! sensible heat flux in W/m2
+!          hfx(ig) = zflubid(ig)-capcal(ig)*zdtsdif(ig)
+!          !! u star in similarity theory in m/s
+!          ust(ig) = 0.4
+!     .               * sqrt( pu(ig,1)*pu(ig,1) + pv(ig,1)*pv(ig,1) )
+!     .               / log( 1.E+0 + zzlay(ig,1)/z0 )
+!
+          DO l=1,nlayer
+            zdvdif(ig,l) = 0.
+            zdudif(ig,l) = 0.
+            zdhdif(ig,l) = 0.
+            DO iq=1, nq
+              zdqdif(ig,l,iq) = 0.
+              zdqsdif(ig,iq) = 0. !! sortir de la boucle
+            ENDDO 
+          ENDDO
+!
+         ENDDO
+         !write (*,*) 'RAD ',fluxrad(igout)
+         !write (*,*) 'GRD ',fluxgrd(igout)
+         !write (*,*) 'dTs/dt ',capcal(igout)*zdtsurf(igout)
+         !write (*,*) 'HFX ', hfx(igout)
+         !write (*,*) 'UST ', ust(igout)
+      ENDIF
+!!! LES LES        
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+         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
+
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+zdtsdif(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)+ 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
+
+c--------------------------------------------------------------
+c   Check mass conservation
+c     3.6e9 factor correspond to the horizontal surface of one element of your grid
+
+              DO ig=1,ngrid
+                 zdqsdif_diag(ig)=zdqsdif(ig,igcm_dust_mass)*3.6e9
+              ENDDO
+
+c-------------------------------------------------------------------
+
+         end if ! of if (tracer)
+
+      ELSE    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     &      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         IF (flag_LES) THEN
+            write(*,*) 'LES mode !' 
+            write(*,*) 'Please set calldifv to T in callphys.def'
+            STOP
+         ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ENDIF ! of IF (calldifv)
+
+
+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
+         CALL zerophys(ngrid*nlayer,zduadj)
+         CALL zerophys(ngrid*nlayer,zdvadj)
+         CALL zerophys(ngrid*nlayer,zdhadj)
+
+         CALL convadj(ngrid,nlayer,nq,ptimestep,
+     $                pplay,pplev,zpopsk,
+     $                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. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      IF (callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,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)
+!!!**WRF: newphys: ici la pression n'est plus mise a jour ds le GCM
+!!!**WRF: mais il faut retablir ca dans le cas du mesoscale ?
+!!!**WRF: ...non probablement OK
+!            ps(ig)=pplev(ig,1) + pdpsrf(ig)*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)+ zdqc(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         ENDIF ! of IF (tracer)
+
+      ENDIF  ! of IF (callcond)
+
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if (tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+c **WRF: new arguments here rnuclei,rice,nuice
+c  plus no more iqmin +igcm_h2o_vap replaces iq, what are the consequences?
+c  checks needed when tracers simulations
+
+           call watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,
+     &                ccn,rdust,rice,nuice)
+           if (activice) then
+c Temperature variation due to latent heat release
+           DO l=1,nlayer
+             DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+             ENDDO
+           ENDDO
+           endif
+
+! increment water vapour and ice atmospheric tracers tendencies
+           IF (water) THEN
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o_vap)=pdq(ig,l,igcm_h2o_vap)+
+     &                                   zdqcloud(ig,l,igcm_h2o_vap)
+                 pdq(ig,l,igcm_h2o_ice)=pdq(ig,l,igcm_h2o_ice)+
+     &                                   zdqcloud(ig,l,igcm_h2o_ice)
+               ENDDO
+             ENDDO
+           ENDIF ! of IF (water) THEN
+! Increment water ice surface tracer tendency
+         DO ig=1,ngrid
+           dqsurf(ig,igcm_h2o_ice)=dqsurf(ig,igcm_h2o_ice)+
+     &                               zdqscloud(ig,igcm_h2o_ice)
+         ENDDO
+         
+         END IF  ! of IF (water)
+
+c   7b. Chemical species
+c     ------------------
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c        --------------
+!c        photochemistry :
+!c        --------------
+!         IF (photochem .or. thermochem) then
+!          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+!     &      zzlay,zday,pq,pdq,rice,
+!     &      zdqchim,zdqschim,zdqcloud,zdqscloud)
+!!NB: Photochemistry includes condensation of H2O2
+!
+!           ! 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)
+
+c   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,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 
+           !call zerophys(ngrid*nlayer*nq, zdqsed)
+           zdqsed(1:ngrid,1:nlayer,1:nq)=0
+           !call zerophys(ngrid*nq, zdqssed)
+           zdqssed(1:ngrid,1:nq)=0
+
+c
+c **WRF: new arguments rnuclei, rice, need checks
+c
+           call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt, rdust, rice,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           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
+c--------------------------------------------------------------
+c   Check mass conservation
+c     3.6e9 factor correspond to the horizontal surface of one element of your grid
+
+             DO ig=1,ngrid
+              zdqssed_diag(ig)= zdqssed(ig,igcm_dust_mass)*3.6e9
+             ENDDO
+c----------------------------------------------------------------------
+         END IF   ! of IF (sedimentation)
+
+c   7d. 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) 
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c-----------------------------------------------------------------------
+!c   8. THERMOSPHERE CALCULATION
+!c-----------------------------------------------------------------------
+!
+!      if (callthermos) then
+!        call thermosphere(pplev,pplay,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)
+
+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
+
+ccc
+ccc  **WRF very specific to GCM
+ccc
+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.(ngridmx.NE.1)) THEN
+!         if (caps.and.(obliquit.lt.27.)) then
+!           ! NB: Updated surface pressure, at grid point 'ngrid', is
+!           !     ps(ngrid)=pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
+!           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
+!     &                     (pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
+!         endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!! note WRF MESOSCALE AYMERIC -- mot cle "caps"
+!!!!! watercaptag n'est plus utilise que dans vdifc
+!!!!! ... pour que la sublimation ne soit pas stoppee 
+!!!!! ... dans la calotte permanente nord si qsurf=0
+!!!!! on desire garder cet effet regle par caps=T
+!!!!! on a donc commente "if (caps.and.(obliquit.lt.27.))" ci-dessus
+!!!!! --- remplacer ces lignes par qqch de plus approprie
+!!!!!      si on s attaque a la calotte polaire sud
+!!!!! pas d'autre occurrence majeure du mot-cle "caps"
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+c       -------------------------------------------------------------
+c       Change of surface albedo (set to 0.4) 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       -------------------------------------------------------------
+c **WRF : OK avec le mesoscale, pas d'indices bizarres au pole
+         do ig=1,ngrid
+           if ((co2ice(ig).eq.0).and.
+     &        (qsurf(ig,igcm_h2o_ice).gt.0.005)) then
+              albedo(ig,1) = alb_surfice
+              albedo(ig,2) = alb_surfice
+           endif
+         enddo  ! of do ig=1,ngrid
+      ENDIF  ! of IF (tracer.AND.water.AND.(ngridmx.NE.1))
+
+c
+c   9.2 Compute soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     &          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+      ENDIF
+
+
+
+c----------------------------------------------------------------------
+c   Check mass conservation
+c----------------------------------------------------------------------------
+
+
+                 pdq_diag(:)=0.
+
+           DO ig=1,ngrid
+              DO l=1,nlayer
+                  pdq_diag(ig)=pdq_diag(ig) +
+     &                         pdq(ig,l,igcm_dust_mass)*3.6e9
+     &                      *  (pplev(ig,l) - pplev(ig,l+1)) / g
+              ENDDO
+           ENDDO
+
+c------------------------------------------------------------------------------------
+
+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
+
+      ! surface pressure
+      DO ig=1,ngrid
+          ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+      ENDDO
+
+      ! pressure
+      DO l=1,nlayer
+        DO ig=1,ngrid
+             zplev(ig,l)=pplev(ig,l)/pplev(ig,1)*ps(ig)
+             zplay(ig,l)=pplay(ig,l)/pplev(ig,1)*ps(ig)
+        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
+
+c    Compute surface stress : (NB: z0 is a common in planete.h)
+c     DO ig=1,ngrid
+c        cd = (0.4/log(zzlay(ig,1)/z0))**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   pplev(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)
+
+      IF (ngrid.NE.1) THEN
+         print*,'Ls =',zls*180./pi,
+     &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2)!,
+!     &   ' tau(Viking1) =',tau(ig_vl1,1)
+
+
+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
+
+
+!!!
+!!! WRF WRF WRF WRF
+!!!
+!         IF(lastcall) THEN
+!            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+!            write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+!            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+!     .              ptimestep,pday,
+!     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+!     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+!     .              zgam,zthe)
+!         ENDIF
+
+
+
+c        -------------------------------------------------------------------
+c        Calculation of diagnostic variables written in both stats and
+c          diagfi files
+c        -------------------------------------------------------------------
+             call zerophys(ngrid,dustot)
+
+             do ig=1,ngrid
+               do l=1,nlayermx
+
+c-------------------------------------------------------
+c  Dust quantity integration along the vertical axe
+
+                 dustot(ig) = dustot(ig) +
+     &                        zq(ig,l,igcm_dust_mass)
+     &                      *  (pplev(ig,l) - pplev(ig,l+1)) / g
+c--------------------------------------------------------------
+               enddo
+             enddo
+
+         if (tracer) then
+           if (water) then
+
+!!
+!!***WRF: ok, des nouveaux trucs cools de la nouvelle physique
+!!
+             call zerophys(ngrid,mtot)
+             call zerophys(ngrid,icetot)
+             call zerophys(ngrid,rave)
+             call zerophys(ngrid,tauTES)
+             do ig=1,ngrid 
+               do l=1,nlayermx
+                 mtot(ig) = mtot(ig) + 
+     &                      zq(ig,l,igcm_h2o_vap) * 
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g
+                 icetot(ig) = icetot(ig) + 
+     &                        zq(ig,l,igcm_h2o_ice) * 
+     &                        (pplev(ig,l) - pplev(ig,l+1)) / g
+                 rave(ig) = rave(ig) + 
+     &                      zq(ig,l,igcm_h2o_ice) *
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g * 
+     &                      rice(ig,l) * (1.+nuice_ref)
+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) *
+     &             (pplev(ig,l) - pplev(ig,l+1)) / g
+     &             / (rho_ice * rice(ig,l) * (1.+nuice_ref))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+               rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
+             enddo
+
+           endif ! of if (water)
+         endif ! of if (tracer)
+
+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
+
+           write(*,*) 'callstats' 
+
+!           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,"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,"taudustvis",
+!     &                    "Dust optical depth"," ",2,tau(1,1))
+!           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)
+!c          call wstats(ngrid,"w","Vertical (down-up) wind",
+!c    &                "m.s-1",3,pw)
+!           call wstats(ngrid,"rho","Atmospheric density","none",3,rho)
+!c          call wstats(ngrid,"pressure","Pressure","Pa",3,pplay)
+!c          call wstats(ngrid,"q2",
+!c    &                "Boundary layer eddy kinetic energy",
+!c    &                "m2.s-2",3,q2)
+!c          call wstats(ngrid,"emis","Surface emissivity","w.m-1",2,
+!c    &                emis)
+!c          call wstats(ngrid,"ssurf","Surface stress","N.m-2",
+!c    &                2,zstress)
+!
+!           if (tracer) then
+!             if (water) then
+!               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_vap)
+!     &                  *mugaz/mmol(igcm_h2o_vap)
+!               call wstats(ngrid,"vmr_h2ovapor",
+!     &                    "H2O vapor volume mixing ratio","mol/mol",
+!     &                    3,vmr)
+!               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+!     &                  *mugaz/mmol(igcm_h2o_ice)
+!               call wstats(ngrid,"vmr_h2oice",
+!     &                    "H2O ice volume mixing ratio","mol/mol",
+!     &                    3,vmr)
+!
+!               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)
+!c              If activice is true, tauTES is computed in aeropacity.F;
+!               if (.not.activice) then
+!                 call wstats(ngrid,"tauTES",
+!     &                    "tau abs 825 cm-1","",
+!     &                    2,tauTES)
+!               endif ! of if (activice)
+!
+!             endif ! of if (water)
+!
+!             if (thermochem.or.photochem) then
+!                do iq=1,nq
+!                   if ((noms(iq).eq."o").or.(noms(iq).eq."co2").or.
+!     .                (noms(iq).eq."co").or.(noms(iq).eq."n2").or.
+!     .                (noms(iq).eq."h2").or.
+!     .                (noms(iq).eq."o3")) then
+!                        do l=1,nlayer
+!                          do ig=1,ngrid
+!                            vmr(ig,l)=zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
+!                          end do
+!                        end do
+!                        call wstats(ngrid,"vmr_"//trim(noms(iq)),
+!     .                     "Volume mixing ratio","mol/mol",3,vmr)
+!                   endif
+!                enddo
+!             endif ! of if (thermochem.or.photochem)
+!
+!           endif ! 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
+
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+      !do ig=1,ngrid
+      !   wtsurf(ig) = tsurf(ig)    !! surface temperature
+      !   wco2ice(ig) = co2ice(ig)  !! co2 ice 
+      !
+      !   !!! specific to WRF WRF WRF
+      !   !!! just to output water ice on surface
+      !   !!! uncomment the Registry entry
+      !   IF (igcm_h2o_ice .ne. 0) qsurfice(ig) = qsurf(ig,igcm_h2o_ice)
+      !
+      !   !!! "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"
+      !   IF (igcm_h2o_ice .ne. 0) THEN
+      !     vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)*mugaz/mmol(igcm_h2o_ice)
+      !   ENDIF
+      !
+      !enddo
+      TAU_lay(:)=tau(:,1)!!true opacity (it's not a reference like tauref)
+      wtsurf(1:ngrid) = tsurf(1:ngrid)    !! surface temperature
+      wco2ice(1:ngrid) = co2ice(1:ngrid)  !! co2 ice
+      mtot(1:ngrid) = mtot(1:ngrid) * 1.e6 / rho_ice
+c**********computing surface density of dust****************
+      IF (igcm_dust_mass .ne. 0) THEN
+        qsurfice_dust(1:ngrid) = qsurf(1:ngrid,igcm_dust_mass)
+      ENDIF
+c******************************************************************
+      IF (igcm_h2o_ice .ne. 0) THEN      
+        qsurfice(1:ngrid) = qsurf(1:ngrid,igcm_h2o_ice)
+        vmr=1.e6 * zq(1:ngrid,1:nlayer,igcm_h2o_ice)
+     .           * mugaz / mmol(igcm_h2o_ice)
+      ENDIF
+
+c
+c THIS INCLUDE IS AUTOMATICALLY GENERATED FROM REGISTRY
+c
+#include "fill_save.inc"
+c
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+
+
+cc-----------------------------------
+cc you can still use meso_WRITEDIAGFI (e.g. for debugging purpose), 
+cc though this is not the default strategy now
+cc-----------------------------------
+cc please use cudt in namelist.input to set frequency of outputs
+cc----------------------------------- 
+cc BEWARE: if at least one call to meso_WRITEDIAGFI is performed,
+cc cudt cannot be 0 - otherwise you'll get a "Floating exception"
+cc-----------------------------------         
+!      call meso_WRITEDIAGFI(ngrid,"tauref",
+!     .  "tauref","W.m-2",2,
+!     .       tauref)
+!      call meso_WRITEDIAGFI(ngrid,"dtrad",
+!     .  "dtrad","W.m-2",2,
+!     .       dtrad)
+c      call meso_WRITEDIAGFI(ngrid,"tsurf",
+c     .  "tsurf","K",2,
+c     .       tsurf)
+c
+!      call meso_WRITEDIAGFI(ngrid,"zt",
+!     .  "zt","W.m-2",3,
+!     .       zt)
+!      call meso_WRITEDIAGFI(ngrid,"zdtlw",
+!     .  "zdtlw","W.m-2",2,
+!     .       zdtlw)
+!      call meso_WRITEDIAGFI(ngrid,"zdtsw",
+!     .  "zdtsw","W.m-2",2,
+!     .       zdtsw)
+
+
+!!
+!! ***WRF: everything below is kept for reference
+!!
+!
+!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 !!
+!         call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
+!     &                  emis)
+!         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)
+!c         call WRITEDIAGFI(ngrid,"temp7","temperature in layer 7",
+!c     &                  "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)
+!c        call WRITEDIAGFI(ngrid,"u","Zonal wind","m.s-1",3,zu)
+!c        call WRITEDIAGFI(ngrid,"v","Meridional wind","m.s-1",3,zv)
+!c        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)
+!c        call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,pplay)
+!c        call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2,
+!c    &                  zstress)
+!
+!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
+!         call zerophys(ngrid,co2col)
+!         do l=1,nlayermx
+!           do ig=1,ngrid
+!             co2col(ig)=co2col(ig)+
+!     &                  zq(ig,l,igcm_co2)*(pplev(ig,l)-pplev(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
+!
+!             CALL WRITEDIAGFI(ngridmx,'mtot',
+!     &                       'total mass of water vapor',
+!     &                       'kg/m2',2,mtot)
+!             CALL WRITEDIAGFI(ngridmx,'icetot',
+!     &                       'total mass of water ice',
+!     &                       'kg/m2',2,icetot)
+!c            If activice is true, tauTES is computed in aeropacity.F;
+!             if (.not.activice) then
+!               CALL WRITEDIAGFI(ngridmx,'tauTES',
+!     &                       'tau abs 825 cm-1',
+!     &                       '',2,tauTES)
+!             endif
+!
+!             call WRITEDIAGFI(ngridmx,'h2o_ice_s',
+!     &                       'surface h2o_ice',
+!     &                       'kg.m-2',2,qsurf(1,igcm_h2o_ice))
+!
+!             if (activice) then
+!c            call WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate',
+!c    &                       'w.m-2',3,zdtsw)
+!c            call WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate',
+!c    &                       'w.m-2',3,zdtlw)
+!             endif  !(activice)
+!           endif !(water)
+!
+!
+!           if (water.and..not.photochem) then
+!             iq=nq
+!c            write(str2(1:2),'(i2.2)') iq
+!c            call WRITEDIAGFI(ngridmx,'dqs'//str2,'dqscloud',
+!c    &                       'kg.m-2',2,zdqscloud(1,iq))
+!c            call WRITEDIAGFI(ngridmx,'dqch'//str2,'var chim',
+!c    &                       'kg/kg',3,zdqchim(1,1,iq))
+!c            call WRITEDIAGFI(ngridmx,'dqd'//str2,'var dif',
+!c    &                       'kg/kg',3,zdqdif(1,1,iq))
+!c            call WRITEDIAGFI(ngridmx,'dqa'//str2,'var adj',
+!c    &                       'kg/kg',3,zdqadj(1,1,iq))
+!c            call WRITEDIAGFI(ngridmx,'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(ngridmx,'taudustvis',
+!     &                    'Dust optical depth',' ',2,tau(1,1))
+!
+!         if (tracer.and.(dustbin.ne.0)) then
+!           call WRITEDIAGFI(ngridmx,'tau','taudust','SI',2,tau(1,1))
+!           if (doubleq) then
+!             call WRITEDIAGFI(ngridmx,'qsurf','qsurf',
+!     &                       'kg.m-2',2,qsurf(1,1))
+!             call WRITEDIAGFI(ngridmx,'Nsurf','N particles',
+!     &                       'N.m-2',2,qsurf(1,2))
+!             call WRITEDIAGFI(ngridmx,'dqsdev','ddevil lift',
+!     &                       'kg.m-2.s-1',2,zdqsdev(1,1))
+!             call WRITEDIAGFI(ngridmx,'dqssed','sedimentation',
+!     &                       'kg.m-2.s-1',2,zdqssed(1,1))
+!             do l=1,nlayer
+!               do ig=1, ngrid
+!                 reff(ig,l)= ref_r0 *
+!     &           (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+!                 reff(ig,l)=min(max(reff(ig,l),1.e-10),500.e-6)
+!               end do
+!             end do
+!             call WRITEDIAGFI(ngridmx,'reff','reff','m',3,reff)
+!           else
+!             do iq=1,dustbin
+!               write(str2(1:2),'(i2.2)') iq
+!               call WRITEDIAGFI(ngridmx,'q'//str2,'mix. ratio',
+!     &                         'kg/kg',3,zq(1,1,iq))
+!               call WRITEDIAGFI(ngridmx,'qsurf'//str2,'qsurf',
+!     &                         'kg.m-2',2,qsurf(1,iq))
+!             end do
+!           endif ! (doubleq)
+!         end if  ! (tracer.and.(dustbin.ne.0))
+!
+!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        ==========================================================
+
+      ELSE     ! if(ngrid.eq.1)
+
+         print*,'Ls =',zls*180./pi,
+     &  '  tauref(700 Pa) =',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')
+
+!! or output in diagfi.nc (for testphys1d)
+!         call WRITEDIAGFI(ngridmx,'ps','Surface pressure','Pa',0,ps)
+!         call WRITEDIAGFI(ngridmx,'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(ngridmx,trim(noms(iq)),
+!     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
+!            end do
+!         end if
+!
+!         zlocal(1)=-log(pplay(1,1)/pplev(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(pplay(1,l)/pplay(1,l-1))*rnew(1,l)*tmean/g
+!         enddo
+!         zlocal(nlayer)= zlocal(nlayer-1)-
+!     &                   log(pplay(1,nlayer)/pplay(1,nlayer-1))*
+!     &                   rnew(1,nlayer)*tmean/g
+
+      END IF       ! if(ngrid.ne.1)
+
+      icount=icount+1
+      write(*,*) 'now, back to the dynamical core...'
+#endif
+      RETURN
+      END
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq_used.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq_used.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/meso_physiq_used.F	(revision 308)
@@ -0,0 +1,1986 @@
+      SUBROUTINE meso_physiq(ngrid,nlayer,nq,
+     $            firstcall,lastcall,
+     $            wday_ini,
+     $            pday,ptime,ptimestep,
+     $            pplev,pplay,pphi,
+     $            pu,pv,pt,pq,pw,
+     $            wtnom,
+     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn,
+     $            wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,
+     $            wisoil,wdsoil,
+     $            wecritphys,
+#ifdef MESOSCALE
+     $            output_tab2d, output_tab3d,
+#endif
+     $            flag_LES)
+
+
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!
+c
+c       ... CHECK THE ****WRF lines
+c
+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. dust bomb propagative perturbation
+c     11. 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     12. 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           new WRF version: Aymeric Spiga (01/2009)
+c           
+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    pw(ngrid,?)           vertical velocity
+c
+c
+c    ****WRF 
+c       day_ini,tsurf,tsoil,emis,q2,qsurf,co2ice are inputs
+c               and locally saved variables
+c                       (no need to call phyetat0)
+c
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx,nqmx)   /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"     !!! new soil common 
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "watercap.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+!!!!**** SPECIFIC TO MESOSCALE
+#ifdef MESOSCALE
+#include "meso_slope.h"
+#include "wrf_output_2d.h"
+#include "wrf_output_3d.h"
+#endif
+
+#include "advtrac.h"   !!! this is necessary for tracers (in dyn3d)
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+!!! ****WRF WRF specific to mesoscale
+      INTEGER wday_ini
+      REAL wtsurf(ngridmx)  ! input only ay firstcall - output
+      REAL wtsoil(ngridmx,nsoilmx)
+      REAL wisoil(ngridmx,nsoilmx)  !! new soil scheme
+      REAL wdsoil(ngridmx,nsoilmx)   !! new soil scheme
+      REAL wco2ice(ngridmx)
+      REAL wemis(ngridmx)
+      REAL wqsurf(ngridmx,nqmx)
+      REAL wq2(ngridmx,nlayermx+1)
+      REAL wecritphys
+#ifdef MESOSCALE
+      REAL output_tab2d(ngridmx,n2d)
+      REAL output_tab3d(ngridmx,nlayer,n3d)
+#endif
+      REAL sl_ls, sl_lct, sl_lat, sl_tau, sl_alb, sl_the, sl_psi
+      REAL sl_fl0, sl_flu
+      REAL sl_ra, sl_di0
+      REAL sky
+      REAL hfx(ngridmx)    !! pour LES avec isfflx!=0
+      REAL ust(ngridmx)    !! pour LES avec isfflx!=0
+      LOGICAL flag_LES     !! pour LES avec isfflx!=0
+      REAL qsurfice(ngridmx) !!usefull for diagnostics
+      REAL qsurfice_dust(ngridmx) !! usefull for dust diagnostics
+      real alpha,lay1 ! coefficients for building layers
+      integer iloop
+      INTEGER tracerset    !!! this corresponds to config%mars
+!!! ****WRF WRF specific to mesoscale
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+      CHARACTER (len=20) :: wtnom(nqmx) ! tracer name
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx) ! surface pressure tendency
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind)
+      REAL TAU_lay(ngridmx) !true opacity (it's not e reference life tauref)
+      REAL dsodust(ngridmx,nlayermx)
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad_sky(ngridmx)      ! rad. flux from sky absorbed by surface (W.m-2)
+      REAL fluxrad(ngridmx)          ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy 
+      INTEGER ig_vl1                 ! Grid Point near VL1   (for diagnostic) 
+
+c     Variables used by the water ice microphysical scheme:
+      REAL rice(ngridmx,nlayermx)    ! Water ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+                                     !   of the size distribution
+c     Albedo of deposited surface ice
+      !!REAL, PARAMETER :: alb_surfice = 0.4 ! 0.45
+      REAL, PARAMETER :: alb_surfice = 0.45 !!TESTS_JB
+
+      SAVE day_ini, icount
+      SAVE aerosol, tsurf,tsoil
+      SAVE co2ice,albedo,emis, q2
+      SAVE capcal,fluxgrd,dtrad,fluxrad,fluxrad_sky,qsurf
+      SAVE ig_vl1
+
+      REAL stephan   
+      DATA stephan/5.67e-08/  ! Stephan Boltzman constant
+      SAVE stephan
+
+c Local variables :
+c -----------------
+
+      REAL CBRT
+      EXTERNAL CBRT
+
+      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq,i, tapphys
+
+      REAL fluxsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngridmx)           ! Reference column optical depth at 700 Pa
+                                     ! (used if active=F) 
+      REAL tau(ngridmx,naerkind)     ! Column dust optical depth at each point
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngridmx,nlayermx)   ! altitude at the middle of the layers
+      REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries
+      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngridmx,nqmx)
+      REAL zdtlw(ngridmx,nlayermx)     ! (K/s)
+      REAL zdtsw(ngridmx,nlayermx)     ! (K/s)
+      REAL cldtlw(ngridmx,nlayermx)     ! (K/s) LW heating rate for clear area
+      REAL cldtsw(ngridmx,nlayermx)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngridmx,nlayermx) ! (K/s)
+      REAL zdtnlte(ngridmx,nlayermx)   ! (K/s)
+      REAL zdtsurf(ngridmx)            ! (K/s)
+      REAL zdtcloud(ngridmx,nlayermx)
+      REAL zdvdif(ngridmx,nlayermx),zdudif(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhdif(ngridmx,nlayermx), zdtsdif(ngridmx)         ! (K/s)
+      REAL zdvadj(ngridmx,nlayermx),zduadj(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhadj(ngridmx,nlayermx)                           ! (K/s)
+      REAL zdtgw(ngridmx,nlayermx)                            ! (K/s)
+      REAL zdugw(ngridmx,nlayermx),zdvgw(ngridmx,nlayermx)    ! (m.s-2)
+      REAL zdtc(ngridmx,nlayermx),zdtsurfc(ngridmx)
+      REAL zdvc(ngridmx,nlayermx),zduc(ngridmx,nlayermx)
+
+      REAL zdqdif(ngridmx,nlayermx,nqmx), zdqsdif(ngridmx,nqmx)
+cc      variables de diagnostiques detendences
+      REAL zdqsdif_diag(ngridmx)      !Usefull for lifting diagnostics
+      REAL zdqssed_diag(ngridmx)      !Usefull for sedimentation diagnostics
+      REAL pdq_diag(ngridmx)          !Usefull for dust perturbation diagnosctics
+cccccc!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      REAL zdqsed(ngridmx,nlayermx,nqmx), zdqssed(ngridmx,nqmx)
+      REAL zdqdev(ngridmx,nlayermx,nqmx), zdqsdev(ngridmx,nqmx)
+      REAL zdqadj(ngridmx,nlayermx,nqmx)
+      REAL zdqc(ngridmx,nlayermx,nqmx)
+      REAL zdqcloud(ngridmx,nlayermx,nqmx)
+      REAL zdqscloud(ngridmx,nqmx)
+      REAL zdqchim(ngridmx,nlayermx,nqmx)
+      REAL zdqschim(ngridmx,nqmx)
+      REAL zdqnorm(ngridmx,nlayermx,2)
+
+      REAL zdteuv(ngridmx,nlayermx)    ! (K/s)
+      REAL zdtconduc(ngridmx,nlayermx) ! (K/s)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngridmx)
+      REAL zplanck(ngridmx),zpopsk(ngridmx,nlayermx)
+      REAL zdum1(ngridmx,nlayermx)
+      REAL zdum2(ngridmx,nlayermx)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngridmx,nlayermx)
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngridmx), zt(ngridmx,nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL fluxtop_sw_tot(ngridmx), fluxsurf_sw_tot(ngridmx)
+      character*2 str2
+      character*5 str5
+      real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      SAVE ccn  !! in case iradia != 1 
+      real rdust(ngridmx,nlayermx) ! dust geometric mean radius (m)
+      real qtot1,qtot2 ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+      real co2col(ngridmx)        ! CO2 column
+      REAL zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      REAL zstress(ngrid), cd
+      real hco2(nqmx),tmean, zlocal(nlayermx)
+      real rho(ngridmx,nlayermx)  ! density
+      real vmr(ngridmx,nlayermx)  ! volume mixing ratio
+      REAL mtot(ngridmx)          ! Total mass of water vapor (kg/m2)
+      REAL dustot(ngridmx)        ! Total mass of dust integrated along vertical axe (kg/m2)
+      REAL icetot(ngridmx)        ! Total mass of water ice (kg/m2)
+      REAL rave(ngridmx)          ! Mean water ice effective radius (m)
+      REAL opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+      REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! Water ice absorption coefficient
+
+
+      REAL time_phys
+
+c=======================================================================
+#ifdef MESOSCALE
+
+c 1. Initialisation:
+c -----------------
+
+c  1.1   Initialisation only at first call
+c  ---------------------------------------
+      IF (firstcall) THEN
+
+c        variables set to 0
+c        ~~~~~~~~~~~~~~~~~~
+         call zerophys(ngrid*nlayer*naerkind,aerosol)
+         call zerophys(ngrid*nlayer,dtrad)
+         call zerophys(ngrid,fluxrad)
+
+c        read startfi 
+c        ~~~~~~~~~~~~
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c ****WRF
+c 
+c       No need to use startfi.nc
+c               > part of the job of phyetat0 is done in inifis
+c               > remaining initializations are passed here from the WRF variables
+c               > beware, some operations were done by phyetat0 (ex: tracers)
+c                       > if any problems, look in phyetat0
+c
+      tsurf(:)=wtsurf(:)
+      PRINT*,'check: tsurf ',tsurf(1),tsurf(ngridmx)
+      tsoil(:,:)=wtsoil(:,:)
+      PRINT*,'check: tsoil ',tsoil(1,1),tsoil(ngridmx,nsoilmx)
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+     !!!new physics
+      inertiedat(:,:)=wisoil(:,:)
+      PRINT*,'check: inert ',inertiedat(1,1),inertiedat(ngridmx,nsoilmx)
+      mlayer(0:nsoilmx-1)=wdsoil(1,:)
+      PRINT*,'check: layer ', mlayer
+            !!!!!!!!!!!!!!!!! DONE in soil_setting.F 
+            ! 1.5 Build layer(); following the same law as mlayer()
+            ! Assuming layer distribution follows mid-layer law:
+            ! layer(k)=lay1*alpha**(k-1)
+            lay1=sqrt(mlayer(0)*mlayer(1))
+            alpha=mlayer(1)/mlayer(0)
+            do iloop=1,nsoilmx
+              layer(iloop)=lay1*(alpha**(iloop-1))
+            enddo
+            !!!!!!!!!!!!!!!!! DONE in soil_setting.F
+      tnom(:)=wtnom(:)   !! est rempli dans advtrac.h
+      PRINT*,'check: tracernames ', tnom
+     !!!new physics
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      emis(:)=wemis(:)
+      PRINT*,'check: emis ',emis(1),emis(ngridmx)
+      q2(:,:)=wq2(:,:)
+      PRINT*,'check: q2 ',q2(1,1),q2(ngridmx,nlayermx+1)
+      qsurf(:,:)=wqsurf(:,:)
+      PRINT*,'check: qsurf ',qsurf(1,1),qsurf(ngridmx,nqmx)
+      co2ice(:)=wco2ice(:)
+      PRINT*,'check: co2 ',co2ice(1),co2ice(ngridmx)
+      day_ini=wday_ini
+
+c       artificially filling dyn3d/control.h is also required
+c       > iphysiq is put in WRF to be set easily (cf ptimestep)
+c       > day_step is simply deduced:
+c
+      day_step=daysec/ptimestep
+      PRINT*,'Call to LMD physics:',day_step,' per Martian day'
+c
+      iphysiq=ptimestep
+c
+      ecritphy=wecritphys
+      PRINT*,'Write LMD physics each:',ecritphy,' seconds'
+              !!PRINT*,ecri_phys
+              !!PRINT*,float(ecri_phys) ...
+              !!renvoient tous deux des nombres absurdes
+              !!pourtant callkeys.h est inclus ...
+              !!
+              !!donc ecritphys est passe en argument ...
+      PRINT*,'Write LMD physics each:',ecritphy,' seconds'
+c
+      !DO iq=1, nq 
+      !  PRINT*, tnom(iq), pq(:,:,iq)
+      !ENDDO
+
+c
+c ****WRF
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+
+
+!! Read netcdf initial physical parameters.
+!         CALL phyetat0 ("startfi.nc",0,0,
+!     &         nsoilmx,nq,
+!     &         day_ini,time_phys,
+!     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+
+         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
+
+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
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         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
+
+
+c        initialize tracers
+c        ~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         ENDIF  ! end tracer
+
+      !!!!!! WRF WRF WRF MARS MARS 
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!! 
+      !!!! principe: une option 'caps=T' specifique au mesoscale
+      !!!! ... en vue d'un meso_initracer ????
+      !!!! 
+      !!!! depots permanents => albedo TES du PDS
+      !!!! depots saisonniers => alb_surfice (~0.4, cf plus bas)
+      !!!!     [!!!! y compris pour les depots saisonniers sur les depots permanents]
+      !!!!
+      !!!! --> todo: il faut garder les depots saisonniers qui viennent
+      !!!!           du GCM lorsqu'ils sont consequents
+      !!!! 
+      IF ( caps .and. (igcm_h2o_ice .ne. 0) ) THEN
+          PRINT *, 'OVERWRITING watercaptag DEFINITION in INITRACER'
+          PRINT *, 'lat>70 et alb>0.26 => watercaptag=T' 
+          !! Perennial H20 north cap defined by watercaptag=true (allows surface to be
+          !! hollowed by sublimation in vdifc).
+          do ig=1,ngridmx
+            qsurf(ig,igcm_h2o_ice)=0.  !! on jette les inputs GCM
+            if ( (lati(ig)*180./pi.gt.70.) .and.
+     .           (albedodat(ig).ge.0.26) )  then
+                    watercaptag(ig)=.true.
+                    dryness(ig) = 1.
+            else
+                    watercaptag(ig)=.false.
+                    dryness(ig) = 1.
+            endif  ! (lati, albedodat)
+          end do ! (ngridmx)
+      ELSE  ! (caps)
+          print *,'Blork !!!'
+          print *,'caps=T avec water=F ????'
+      ENDIF ! (caps)
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+      !!!!!! TEST TEST TEST TEST  AS+JBM 28/02/11
+
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c ****WRF
+c
+c nosense in mesoscale modeling
+c
+cc        Determining gridpoint near Viking Lander 1 (used for diagnostic only)
+cc        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c         if(ngrid.ne.1) then
+c           latvl1= 22.27 
+c           lonvl1= -47.94 
+c           ig_vl1= 1+ int( (1.5-(latvl1-90.)*jjm/180.)  -2 )*iim +
+c     &              int(1.5+(lonvl1+180)*iim/360.)
+c           write(*,*) 'Viking Lander 1 GCM point: lat,lon',
+c     &              lati(ig_vl1)*180/pi, long(ig_vl1)*180/pi
+c         end if 
+c ****WRF
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c        Initialize thermospheric parameters
+!c        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!         if (callthermos) call param_read
+
+
+c        Initialize R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+
+        IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+          write(*,*)"physiq: water_param Surface ice alb:",alb_surfice
+        ENDIF
+                   
+      ENDIF        !  (end of "if firstcall")
+
+
+c ---------------------------------------------------
+c 1.2   Initializations done at every physical timestep:
+c ---------------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+c     Initialize various variables
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      call zerophys(ngrid*nlayer, pdv)
+      call zerophys(ngrid*nlayer, pdu)
+      call zerophys(ngrid*nlayer, pdt)
+      call zerophys(ngrid*nlayer*nq, pdq)
+      call zerophys(ngrid, pdpsrf)
+      call zerophys(ngrid, zflubid)
+      call zerophys(ngrid, zdtsurf)
+      call zerophys(ngrid*nq, dqsurf)
+      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     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=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Compute potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      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)
+         ENDDO
+      ENDDO
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c-----------------------------------------------------------------------
+!c    1.2.5 Compute mean mass, cp, and R
+!c    --------------------------------
+!
+!      if(photochem.or.callthermos) then
+!         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+!      endif
+
+c-----------------------------------------------------------------------
+c    2. Compute radiative tendencies :
+c------------------------------------
+
+
+      IF (callrad) THEN 
+         zdqnorm(:,:,:) = 0.          
+         IF( MOD(icount-1,iradia).EQ.0) THEN
+
+           write (*,*) 'call radiative transfer'
+
+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, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+     &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+
+c          Note: Dustopacity.F has been transferred to callradite.F
+         
+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          ------------------
+cc
+cc **WRF: desormais dust_opacity est dans callradite -- modifications
+cc nveaux arguments: tauref,tau,aerosol,rice,nuice
+cc
+           CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
+     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice,zdqnorm,dsodust)
+
+
+
+c        write(*,*) icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
+c     $     emis,mu0,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+c     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+c     &     tauref,tau,aerosol,rice,nuice
+c        write(*,*) fluxsurf_lw
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccc
+ccccc PARAM SLOPE : Insolation (direct + scattered)
+ccccc
+      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.*long(ig)/pi/15.
+           sl_ra  = pi*(1.0-sl_lct/12.)
+           sl_lat = 180.*lati(ig)/pi
+           sl_tau = tau(ig,1)
+           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
+           ! sait-on jamais (a cause des arrondis)
+           if (sl_fl0 .lt. sl_di0) sl_di0=sl_fl0
+     !!!!!!!!!!!!!!!!!!!!!!!!!!
+        CALL meso_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
+                !!      sl_ls = 180.*zls/pi
+                !!      sl_lct = ptime*24. + 180.*long(ig)/pi/15.
+                !!      sl_lat = 180.*lati(ig)/pi
+                !!      sl_tau = tau(ig,1)
+                !!      sl_alb = albedo(ig,l)
+                !!      sl_the = theta_sl(ig)
+                !!      sl_psi = psi_sl(ig)
+                !!      sl_fl0 = fluxsurf_sw(ig,l)
+                !!      CALL param_slope_full(sl_ls, sl_lct, sl_lat, 
+                !!     &                   sl_tau, sl_alb, 
+                !!     &                   sl_the, sl_psi, sl_fl0, 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
+ccccc
+ccccc PARAM SLOPE
+ccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+
+c          CO2 near infrared absorption
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+           call zerophys(ngrid*nlayer,zdtnirco2)
+           if (callnirco2) then
+              call nirco2abs (ngrid,nlayer,pplay,dist_sol,
+     .                       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))
+
+            !print*,'RAD ', fluxrad_sky(ig)
+            !print*,'LW ', emis(ig)*fluxsurf_lw(ig)
+            !print*,'SW ', 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, pplay,
+     &             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)
+cccc
+cccc param slope
+cccc
+               sky= (1.+cos(pi*theta_sl(ig)/180.))/2.
+               fluxrad(ig)=fluxrad(ig)+(1.-sky)*zplanck(ig)
+cccc
+cccc
+cccc
+           ENDDO
+
+
+         DO l=1,nlayer
+            DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+dtrad(ig,l)
+            ENDDO
+         ENDDO
+
+      ENDIF ! of IF (callrad)
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c-----------------------------------------------------------------------
+!c    3. Gravity wave and subgrid scale topography drag :
+!c    -------------------------------------------------
+!
+!
+!      IF(calllott)THEN
+!
+!        CALL calldrag_noro(ngrid,nlayer,ptimestep,
+!     &                 pplay,pplev,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    -----------------------------------------
+c
+      IF (calldifv) THEN
+
+
+         DO ig=1,ngrid
+            zflubid(ig)=fluxrad(ig)+fluxgrd(ig)
+            !write (*,*), fluxrad(ig), fluxgrd(ig), zflubid(ig) 
+         ENDDO
+
+         CALL zerophys(ngrid*nlayer,zdum1)
+         CALL zerophys(ngrid*nlayer,zdum2)
+         do l=1,nlayer
+            do ig=1,ngrid
+               zdh(ig,l)=pdt(ig,l)/zpopsk(ig,l)
+            enddo
+         enddo
+         
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif)
+
+         DO ig=1,ngrid
+          !! sensible heat flux in W/m2
+          hfx(ig) = zflubid(ig)-capcal(ig)*zdtsdif(ig)
+          !! u star in similarity theory in m/s
+          ust(ig) = 0.4
+     .               * sqrt( pu(ig,1)*pu(ig,1) + pv(ig,1)*pv(ig,1) )
+     .               / log( 1.E+0 + zzlay(ig,1)/z0 )
+         ENDDO   
+
+!         write (*,*) 'PHYS HFX cp zdts', hfx(100), zflubid(100), 
+!     .       capcal(100), 
+!     .       zdtsdif(100)
+!         write (*,*) 'PHYS UST', ust(100) 
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! LES LES 
+       IF (flag_LES) THEN        
+
+         write (*,*) '************************************************' 
+         write (*,*) '** LES mode: the difv part is only used to'
+         write (*,*) '**  provide HFX and UST to the dynamics'
+         write (*,*) '** NB: - dudif, dvdif, dhdif, dqdif are set to 0'
+         write (*,*) '**     - tsurf is updated'     
+         write (*,*) '************************************************'
+
+!!!
+!!! WRF WRF LES LES : en fait le subgrid scale n'etait pas mis a zero !!
+!!!         
+         DO ig=1,ngrid
+!          !! sensible heat flux in W/m2
+!          hfx(ig) = zflubid(ig)-capcal(ig)*zdtsdif(ig)
+!          !! u star in similarity theory in m/s
+!          ust(ig) = 0.4
+!     .               * sqrt( pu(ig,1)*pu(ig,1) + pv(ig,1)*pv(ig,1) )
+!     .               / log( 1.E+0 + zzlay(ig,1)/z0 )
+!
+          DO l=1,nlayer
+            zdvdif(ig,l) = 0.
+            zdudif(ig,l) = 0.
+            zdhdif(ig,l) = 0.
+            DO iq=1, nq
+              zdqdif(ig,l,iq) = 0.
+              zdqsdif(ig,iq) = 0. !! sortir de la boucle
+            ENDDO 
+          ENDDO
+!
+         ENDDO
+         !write (*,*) 'RAD ',fluxrad(igout)
+         !write (*,*) 'GRD ',fluxgrd(igout)
+         !write (*,*) 'dTs/dt ',capcal(igout)*zdtsurf(igout)
+         !write (*,*) 'HFX ', hfx(igout)
+         !write (*,*) 'UST ', ust(igout)
+      ENDIF
+!!! LES LES        
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+         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
+
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+zdtsdif(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)+ 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
+
+c--------------------------------------------------------------
+c   Check mass conservation
+c     3.6e9 factor correspond to the horizontal surface of one element of your grid
+
+              DO ig=1,ngrid
+                 zdqsdif_diag(ig)=zdqsdif(ig,igcm_dust_mass)*3.6e9
+              ENDDO
+
+c-------------------------------------------------------------------
+
+         end if ! of if (tracer)
+
+      ELSE    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     &      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         IF (flag_LES) THEN
+            write(*,*) 'LES mode !' 
+            write(*,*) 'Please set calldifv to T in callphys.def'
+            STOP
+         ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ENDIF ! of IF (calldifv)
+
+
+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
+         CALL zerophys(ngrid*nlayer,zduadj)
+         CALL zerophys(ngrid*nlayer,zdvadj)
+         CALL zerophys(ngrid*nlayer,zdhadj)
+
+         CALL convadj(ngrid,nlayer,nq,ptimestep,
+     $                pplay,pplev,zpopsk,
+     $                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. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      IF (callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,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)
+!!!**WRF: newphys: ici la pression n'est plus mise a jour ds le GCM
+!!!**WRF: mais il faut retablir ca dans le cas du mesoscale ?
+!!!**WRF: ...non probablement OK
+!            ps(ig)=pplev(ig,1) + pdpsrf(ig)*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)+ zdqc(ig,l,iq) 
+              ENDDO
+            ENDDO
+           ENDDO
+         ENDIF ! of IF (tracer)
+
+      ENDIF  ! of IF (callcond)
+
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if (tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+c **WRF: new arguments here rnuclei,rice,nuice
+c  plus no more iqmin +igcm_h2o_vap replaces iq, what are the consequences?
+c  checks needed when tracers simulations
+
+           call watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,
+     &                ccn,rdust,rice,nuice)
+           if (activice) then
+c Temperature variation due to latent heat release
+           DO l=1,nlayer
+             DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+             ENDDO
+           ENDDO
+           endif
+
+! increment water vapour and ice atmospheric tracers tendencies
+           IF (water) THEN
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o_vap)=pdq(ig,l,igcm_h2o_vap)+
+     &                                   zdqcloud(ig,l,igcm_h2o_vap)
+                 pdq(ig,l,igcm_h2o_ice)=pdq(ig,l,igcm_h2o_ice)+
+     &                                   zdqcloud(ig,l,igcm_h2o_ice)
+               ENDDO
+             ENDDO
+           ENDIF ! of IF (water) THEN
+! Increment water ice surface tracer tendency
+         DO ig=1,ngrid
+           dqsurf(ig,igcm_h2o_ice)=dqsurf(ig,igcm_h2o_ice)+
+     &                               zdqscloud(ig,igcm_h2o_ice)
+         ENDDO
+         
+         END IF  ! of IF (water)
+
+c   7b. Chemical species
+c     ------------------
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c        --------------
+!c        photochemistry :
+!c        --------------
+!         IF (photochem .or. thermochem) then
+!          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+!     &      zzlay,zday,pq,pdq,rice,
+!     &      zdqchim,zdqschim,zdqcloud,zdqscloud)
+!!NB: Photochemistry includes condensation of H2O2
+!
+!           ! 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)
+
+c   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,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 
+           !call zerophys(ngrid*nlayer*nq, zdqsed)
+           zdqsed(1:ngrid,1:nlayer,1:nq)=0
+           !call zerophys(ngrid*nq, zdqssed)
+           zdqssed(1:ngrid,1:nq)=0
+
+c
+c **WRF: new arguments rnuclei, rice, need checks
+c
+           call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt, rdust, rice,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+           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
+c--------------------------------------------------------------
+c   Check mass conservation
+c     3.6e9 factor correspond to the horizontal surface of one element of your grid
+
+             DO ig=1,ngrid
+              zdqssed_diag(ig)= zdqssed(ig,igcm_dust_mass)*3.6e9
+             ENDDO
+c----------------------------------------------------------------------
+         END IF   ! of IF (sedimentation)
+
+c   7d. 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) 
+
+!!!
+!!! WRF WRF WRF commented for smaller executables
+!!!
+!c-----------------------------------------------------------------------
+!c   8. THERMOSPHERE CALCULATION
+!c-----------------------------------------------------------------------
+!
+!      if (callthermos) then
+!        call thermosphere(pplev,pplay,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)
+
+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
+
+ccc
+ccc  **WRF very specific to GCM
+ccc
+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.(ngridmx.NE.1)) THEN
+!         if (caps.and.(obliquit.lt.27.)) then
+!           ! NB: Updated surface pressure, at grid point 'ngrid', is
+!           !     ps(ngrid)=pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
+!           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
+!     &                     (pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
+!         endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!! note WRF MESOSCALE AYMERIC -- mot cle "caps"
+!!!!! watercaptag n'est plus utilise que dans vdifc
+!!!!! ... pour que la sublimation ne soit pas stoppee 
+!!!!! ... dans la calotte permanente nord si qsurf=0
+!!!!! on desire garder cet effet regle par caps=T
+!!!!! on a donc commente "if (caps.and.(obliquit.lt.27.))" ci-dessus
+!!!!! --- remplacer ces lignes par qqch de plus approprie
+!!!!!      si on s attaque a la calotte polaire sud
+!!!!! pas d'autre occurrence majeure du mot-cle "caps"
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+c       -------------------------------------------------------------
+c       Change of surface albedo (set to 0.4) 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       -------------------------------------------------------------
+c **WRF : OK avec le mesoscale, pas d'indices bizarres au pole
+         do ig=1,ngrid
+           if ((co2ice(ig).eq.0).and.
+     &        (qsurf(ig,igcm_h2o_ice).gt.0.005)) then
+              albedo(ig,1) = alb_surfice
+              albedo(ig,2) = alb_surfice
+           endif
+         enddo  ! of do ig=1,ngrid
+      ENDIF  ! of IF (tracer.AND.water.AND.(ngridmx.NE.1))
+
+c
+c   9.2 Compute soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     &          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+      ENDIF
+c-----------------------------------------------------------
+c   10. Ajout tache de poussière ou 'dust bomb propagative perturbation'
+c------------------------------------------------------------
+            DO l=1,nlayer
+              DO ig=1,ngrid
+
+
+                     pdq(ig,l,igcm_dust_mass)=pdq(ig,l,igcm_dust_mass)+
+     &                                         zdqnorm(ig,l,1)
+                     pdq(ig,l,igcm_dust_number)=
+     &                                       pdq(ig,l,igcm_dust_number) 
+     &                                        +zdqnorm(ig,l,2)
+              ENDDO
+            ENDDO
+
+
+c--------------------------------------------------------------
+c   Check mass conservation
+c     3.6e9 factor correspond to the horizontal surface of one element of your grid
+
+
+                 pdq_diag(:)=0.
+
+           DO ig=1,ngrid
+              DO l=1,nlayer
+                  pdq_diag(ig)=pdq_diag(ig) +
+     &                         pdq(ig,l,igcm_dust_mass)*3.6e9
+     &                      *  (pplev(ig,l) - pplev(ig,l+1)) / g
+              ENDDO
+           ENDDO
+
+c------------------------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c  11. 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
+
+      ! surface pressure
+      DO ig=1,ngrid
+          ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+      ENDDO
+
+      ! pressure
+      DO l=1,nlayer
+        DO ig=1,ngrid
+             zplev(ig,l)=pplev(ig,l)/pplev(ig,1)*ps(ig)
+             zplay(ig,l)=pplay(ig,l)/pplev(ig,1)*ps(ig)
+        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
+
+c    Compute surface stress : (NB: z0 is a common in planete.h)
+c     DO ig=1,ngrid
+c        cd = (0.4/log(zzlay(ig,1)/z0))**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   pplev(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)
+
+      IF (ngrid.NE.1) THEN
+         print*,'Ls =',zls*180./pi,
+     &   ' tauref(700 Pa,lat=0) =',tauref(ngrid/2)!,
+!     &   ' tau(Viking1) =',tau(ig_vl1,1)
+
+
+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
+
+
+!!!
+!!! WRF WRF WRF WRF
+!!!
+!         IF(lastcall) THEN
+!            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+!            write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+!            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+!     .              ptimestep,pday,
+!     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+!     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+!     .              zgam,zthe)
+!         ENDIF
+
+
+
+c        -------------------------------------------------------------------
+c        Calculation of diagnostic variables written in both stats and
+c          diagfi files
+c        -------------------------------------------------------------------
+             call zerophys(ngrid,dustot)
+
+             do ig=1,ngrid
+               do l=1,nlayermx
+
+c-------------------------------------------------------
+c  Dust quantity integration along the vertical axe
+
+                 dustot(ig) = dustot(ig) +
+     &                        zq(ig,l,igcm_dust_mass)
+     &                      *  (pplev(ig,l) - pplev(ig,l+1)) / g
+c--------------------------------------------------------------
+               enddo
+             enddo
+
+         if (tracer) then
+           if (water) then
+
+!!
+!!***WRF: ok, des nouveaux trucs cools de la nouvelle physique
+!!
+             call zerophys(ngrid,mtot)
+             call zerophys(ngrid,icetot)
+             call zerophys(ngrid,rave)
+             call zerophys(ngrid,tauTES)
+             do ig=1,ngrid 
+               do l=1,nlayermx
+                 mtot(ig) = mtot(ig) + 
+     &                      zq(ig,l,igcm_h2o_vap) * 
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g
+                 icetot(ig) = icetot(ig) + 
+     &                        zq(ig,l,igcm_h2o_ice) * 
+     &                        (pplev(ig,l) - pplev(ig,l+1)) / g
+                 rave(ig) = rave(ig) + 
+     &                      zq(ig,l,igcm_h2o_ice) *
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g * 
+     &                      rice(ig,l) * (1.+nuice_ref)
+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) *
+     &             (pplev(ig,l) - pplev(ig,l+1)) / g
+     &             / (rho_ice * rice(ig,l) * (1.+nuice_ref))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+               rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
+             enddo
+
+           endif ! of if (water)
+         endif ! of if (tracer)
+
+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
+
+           write(*,*) 'callstats' 
+
+!           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,"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,"taudustvis",
+!     &                    "Dust optical depth"," ",2,tau(1,1))
+!           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)
+!c          call wstats(ngrid,"w","Vertical (down-up) wind",
+!c    &                "m.s-1",3,pw)
+!           call wstats(ngrid,"rho","Atmospheric density","none",3,rho)
+!c          call wstats(ngrid,"pressure","Pressure","Pa",3,pplay)
+!c          call wstats(ngrid,"q2",
+!c    &                "Boundary layer eddy kinetic energy",
+!c    &                "m2.s-2",3,q2)
+!c          call wstats(ngrid,"emis","Surface emissivity","w.m-1",2,
+!c    &                emis)
+!c          call wstats(ngrid,"ssurf","Surface stress","N.m-2",
+!c    &                2,zstress)
+!
+!           if (tracer) then
+!             if (water) then
+!               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_vap)
+!     &                  *mugaz/mmol(igcm_h2o_vap)
+!               call wstats(ngrid,"vmr_h2ovapor",
+!     &                    "H2O vapor volume mixing ratio","mol/mol",
+!     &                    3,vmr)
+!               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+!     &                  *mugaz/mmol(igcm_h2o_ice)
+!               call wstats(ngrid,"vmr_h2oice",
+!     &                    "H2O ice volume mixing ratio","mol/mol",
+!     &                    3,vmr)
+!
+!               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)
+!c              If activice is true, tauTES is computed in aeropacity.F;
+!               if (.not.activice) then
+!                 call wstats(ngrid,"tauTES",
+!     &                    "tau abs 825 cm-1","",
+!     &                    2,tauTES)
+!               endif ! of if (activice)
+!
+!             endif ! of if (water)
+!
+!             if (thermochem.or.photochem) then
+!                do iq=1,nq
+!                   if ((noms(iq).eq."o").or.(noms(iq).eq."co2").or.
+!     .                (noms(iq).eq."co").or.(noms(iq).eq."n2").or.
+!     .                (noms(iq).eq."h2").or.
+!     .                (noms(iq).eq."o3")) then
+!                        do l=1,nlayer
+!                          do ig=1,ngrid
+!                            vmr(ig,l)=zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
+!                          end do
+!                        end do
+!                        call wstats(ngrid,"vmr_"//trim(noms(iq)),
+!     .                     "Volume mixing ratio","mol/mol",3,vmr)
+!                   endif
+!                enddo
+!             endif ! of if (thermochem.or.photochem)
+!
+!           endif ! 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
+
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+      !do ig=1,ngrid
+      !   wtsurf(ig) = tsurf(ig)    !! surface temperature
+      !   wco2ice(ig) = co2ice(ig)  !! co2 ice 
+      !
+      !   !!! specific to WRF WRF WRF
+      !   !!! just to output water ice on surface
+      !   !!! uncomment the Registry entry
+      !   IF (igcm_h2o_ice .ne. 0) qsurfice(ig) = qsurf(ig,igcm_h2o_ice)
+      !
+      !   !!! "VMR_ICE"   "VOL. MIXING RATIO ICE"           "ppm"
+      !   IF (igcm_h2o_ice .ne. 0) THEN
+      !     vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)*mugaz/mmol(igcm_h2o_ice)
+      !   ENDIF
+      !
+      !enddo
+      TAU_lay(:)=tau(:,1)!!true opacity (it's not a reference like tauref)
+      wtsurf(1:ngrid) = tsurf(1:ngrid)    !! surface temperature
+      wco2ice(1:ngrid) = co2ice(1:ngrid)  !! co2 ice
+      mtot(1:ngrid) = mtot(1:ngrid) * 1.e6 / rho_ice
+c**********computing surface density of dust****************
+      IF (igcm_dust_mass .ne. 0) THEN
+        qsurfice_dust(1:ngrid) = qsurf(1:ngrid,igcm_dust_mass)
+      ENDIF
+c******************************************************************
+      IF (igcm_h2o_ice .ne. 0) THEN      
+        qsurfice(1:ngrid) = qsurf(1:ngrid,igcm_h2o_ice)
+        vmr=1.e6 * zq(1:ngrid,1:nlayer,igcm_h2o_ice)
+     .           * mugaz / mmol(igcm_h2o_ice)
+      ENDIF
+
+c
+c THIS INCLUDE IS AUTOMATICALLY GENERATED FROM REGISTRY
+c
+#include "fill_save.inc"
+c
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+ccc**************** WRF OUTPUT **************************
+
+
+cc-----------------------------------
+cc you can still use meso_WRITEDIAGFI (e.g. for debugging purpose), 
+cc though this is not the default strategy now
+cc-----------------------------------
+cc please use cudt in namelist.input to set frequency of outputs
+cc----------------------------------- 
+cc BEWARE: if at least one call to meso_WRITEDIAGFI is performed,
+cc cudt cannot be 0 - otherwise you'll get a "Floating exception"
+cc-----------------------------------         
+!      call meso_WRITEDIAGFI(ngrid,"tauref",
+!     .  "tauref","W.m-2",2,
+!     .       tauref)
+!      call meso_WRITEDIAGFI(ngrid,"dtrad",
+!     .  "dtrad","W.m-2",2,
+!     .       dtrad)
+c      call meso_WRITEDIAGFI(ngrid,"tsurf",
+c     .  "tsurf","K",2,
+c     .       tsurf)
+c
+!      call meso_WRITEDIAGFI(ngrid,"zt",
+!     .  "zt","W.m-2",3,
+!     .       zt)
+!      call meso_WRITEDIAGFI(ngrid,"zdtlw",
+!     .  "zdtlw","W.m-2",2,
+!     .       zdtlw)
+!      call meso_WRITEDIAGFI(ngrid,"zdtsw",
+!     .  "zdtsw","W.m-2",2,
+!     .       zdtsw)
+
+
+!!
+!! ***WRF: everything below is kept for reference
+!!
+!
+!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 !!
+!         call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
+!     &                  emis)
+!         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)
+!c         call WRITEDIAGFI(ngrid,"temp7","temperature in layer 7",
+!c     &                  "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)
+!c        call WRITEDIAGFI(ngrid,"u","Zonal wind","m.s-1",3,zu)
+!c        call WRITEDIAGFI(ngrid,"v","Meridional wind","m.s-1",3,zv)
+!c        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)
+!c        call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,pplay)
+!c        call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2,
+!c    &                  zstress)
+!
+!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
+!         call zerophys(ngrid,co2col)
+!         do l=1,nlayermx
+!           do ig=1,ngrid
+!             co2col(ig)=co2col(ig)+
+!     &                  zq(ig,l,igcm_co2)*(pplev(ig,l)-pplev(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
+!
+!             CALL WRITEDIAGFI(ngridmx,'mtot',
+!     &                       'total mass of water vapor',
+!     &                       'kg/m2',2,mtot)
+!             CALL WRITEDIAGFI(ngridmx,'icetot',
+!     &                       'total mass of water ice',
+!     &                       'kg/m2',2,icetot)
+!c            If activice is true, tauTES is computed in aeropacity.F;
+!             if (.not.activice) then
+!               CALL WRITEDIAGFI(ngridmx,'tauTES',
+!     &                       'tau abs 825 cm-1',
+!     &                       '',2,tauTES)
+!             endif
+!
+!             call WRITEDIAGFI(ngridmx,'h2o_ice_s',
+!     &                       'surface h2o_ice',
+!     &                       'kg.m-2',2,qsurf(1,igcm_h2o_ice))
+!
+!             if (activice) then
+!c            call WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate',
+!c    &                       'w.m-2',3,zdtsw)
+!c            call WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate',
+!c    &                       'w.m-2',3,zdtlw)
+!             endif  !(activice)
+!           endif !(water)
+!
+!
+!           if (water.and..not.photochem) then
+!             iq=nq
+!c            write(str2(1:2),'(i2.2)') iq
+!c            call WRITEDIAGFI(ngridmx,'dqs'//str2,'dqscloud',
+!c    &                       'kg.m-2',2,zdqscloud(1,iq))
+!c            call WRITEDIAGFI(ngridmx,'dqch'//str2,'var chim',
+!c    &                       'kg/kg',3,zdqchim(1,1,iq))
+!c            call WRITEDIAGFI(ngridmx,'dqd'//str2,'var dif',
+!c    &                       'kg/kg',3,zdqdif(1,1,iq))
+!c            call WRITEDIAGFI(ngridmx,'dqa'//str2,'var adj',
+!c    &                       'kg/kg',3,zdqadj(1,1,iq))
+!c            call WRITEDIAGFI(ngridmx,'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(ngridmx,'taudustvis',
+!     &                    'Dust optical depth',' ',2,tau(1,1))
+!
+!         if (tracer.and.(dustbin.ne.0)) then
+!           call WRITEDIAGFI(ngridmx,'tau','taudust','SI',2,tau(1,1))
+!           if (doubleq) then
+!             call WRITEDIAGFI(ngridmx,'qsurf','qsurf',
+!     &                       'kg.m-2',2,qsurf(1,1))
+!             call WRITEDIAGFI(ngridmx,'Nsurf','N particles',
+!     &                       'N.m-2',2,qsurf(1,2))
+!             call WRITEDIAGFI(ngridmx,'dqsdev','ddevil lift',
+!     &                       'kg.m-2.s-1',2,zdqsdev(1,1))
+!             call WRITEDIAGFI(ngridmx,'dqssed','sedimentation',
+!     &                       'kg.m-2.s-1',2,zdqssed(1,1))
+!             do l=1,nlayer
+!               do ig=1, ngrid
+!                 reff(ig,l)= ref_r0 *
+!     &           (r3n_q*pq(ig,l,1)/max(pq(ig,l,2),0.01))**(1./3.)
+!                 reff(ig,l)=min(max(reff(ig,l),1.e-10),500.e-6)
+!               end do
+!             end do
+!             call WRITEDIAGFI(ngridmx,'reff','reff','m',3,reff)
+!           else
+!             do iq=1,dustbin
+!               write(str2(1:2),'(i2.2)') iq
+!               call WRITEDIAGFI(ngridmx,'q'//str2,'mix. ratio',
+!     &                         'kg/kg',3,zq(1,1,iq))
+!               call WRITEDIAGFI(ngridmx,'qsurf'//str2,'qsurf',
+!     &                         'kg.m-2',2,qsurf(1,iq))
+!             end do
+!           endif ! (doubleq)
+!         end if  ! (tracer.and.(dustbin.ne.0))
+!
+!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        ==========================================================
+
+      ELSE     ! if(ngrid.eq.1)
+
+         print*,'Ls =',zls*180./pi,
+     &  '  tauref(700 Pa) =',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')
+
+!! or output in diagfi.nc (for testphys1d)
+!         call WRITEDIAGFI(ngridmx,'ps','Surface pressure','Pa',0,ps)
+!         call WRITEDIAGFI(ngridmx,'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(ngridmx,trim(noms(iq)),
+!     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
+!            end do
+!         end if
+!
+!         zlocal(1)=-log(pplay(1,1)/pplev(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(pplay(1,l)/pplay(1,l-1))*rnew(1,l)*tmean/g
+!         enddo
+!         zlocal(nlayer)= zlocal(nlayer-1)-
+!     &                   log(pplay(1,nlayer)/pplay(1,nlayer-1))*
+!     &                   rnew(1,nlayer)*tmean/g
+
+      END IF       ! if(ngrid.ne.1)
+
+      icount=icount+1
+      write(*,*) 'now, back to the dynamical core...'
+#endif
+      RETURN
+      END
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/newsedim.F.previous
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/newsedim.F.previous	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/newsedim.F.previous	(revision 308)
@@ -0,0 +1,182 @@
+      SUBROUTINE newsedim(ngrid,nlay,naersize,ptimestep,
+     &  pplev,masse,epaisseur,pt,rd,rho,pqi,wq,beta)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c      Compute sedimentation of 1 tracer 
+c      of radius rd (m) and density rho (kg.m-3) 
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER,INTENT(IN) :: ngrid,nlay,naersize
+      REAL,INTENT(IN) :: ptimestep            ! pas de temps physique (s)
+      REAL,INTENT(IN) :: pplev(ngrid,nlay+1) ! pression aux inter-couches (Pa)
+      REAL,INTENT(IN) :: pt(ngrid,nlay) ! temperature au centre des couches (K)
+      real,intent(in) :: masse (ngrid,nlay) ! masse d'une couche (kg)
+      real,intent(in) :: epaisseur (ngrid,nlay)  ! epaisseur d'une couche (m)
+      real,intent(in) :: rd(naersize)             ! particle radius (m)
+      real,intent(in) :: rho             ! particle density (kg.m-3)
+
+
+c    Traceurs :
+      real,intent(inout) :: pqi(ngrid,nlay)  ! traceur   (e.g. ?/kg)
+      real,intent(out) :: wq(ngridmx,nlay+1)  ! flux de traceur durant timestep (?/m-2)
+      real,intent(in) :: beta ! correction for the shape of the particles
+                !   (see Murphy et al. JGR 1990 vol.95)
+                !   beta=1 for spheres
+                !   beta=0.85 for irregular particles
+                !   beta=0.5 for disk shaped particles
+      
+c   local:
+c   ------
+
+      INTEGER l,ig, k, i
+      REAL rfall
+
+      LOGICAL,SAVE :: firstcall=.true.
+
+c    Traceurs :
+c    ~~~~~~~~ 
+      real traversee (ngridmx,nlayermx)
+      real vstokes(ngridmx,nlayermx)
+      real w(ngridmx,nlayermx)
+      real ptop, dztop, Ep, Stra
+
+
+c    Physical constant
+c    ~~~~~~~~~~~~~~~~~
+c     Gas molecular viscosity (N.s.m-2)
+      real,parameter :: visc=1.e-5       ! CO2
+c     Effective gas molecular radius (m)
+      real,parameter :: molrad=2.2e-10   ! CO2
+
+c     local and saved variable
+      real,save :: a,b
+
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans newsedim'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+         firstcall=.false.
+
+
+c       Preliminary calculations for sedimenation velocity :
+c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c       - Constant to compute stokes speed simple formulae
+c        (Vstokes =  b * rho* r**2   avec   b= (2/9) * rho * g / visc
+         b = 2./9. * g / visc
+      ENDIF ! of IF(firstcall)
+      
+c       - Constant  to compute gas mean free path
+c        l= (T/P)*a, avec a = (  0.707*8.31/(4*pi*molrad**2 * avogadro))
+         a = 0.707*8.31/(4*3.1416* molrad**2  * 6.023e23)
+
+c       - Correction to account for non-spherical shape (Murphy et al.  1990)
+         a = a * beta
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+c     Sedimentation velocity (m/s)
+c     ~~~~~~~~~~~~~~~~~~~~~~
+c     (stokes law corrected for low pressure by the Cunningham
+c     slip-flow correction  according to Rossow (Icarus 36, 1-50, 1978)
+
+        do  l=1,nlay
+          do ig=1, ngrid
+            if (naersize.eq.1) then 
+              rfall=rd(1)
+            else
+              i=ngrid*(l-1)+ig
+              rfall=rd(i)
+            endif  
+            vstokes(ig,l) = b * rho * rfall**2 *
+     &      (1 + 1.333* ( a*pt(ig,l)/pplev(ig,l) )/rfall)
+
+c           Layer crossing time (s) :
+            traversee(ig,l)= epaisseur(ig,l)/vstokes(ig,l)
+          end do
+        end do
+
+
+c     Calcul de la masse d'atmosphere correspondant a q transferee
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c     (e.g. on recherche le niveau  en dessous de laquelle le traceur
+c      va traverser le niveau intercouche l : "dztop" est sa hauteur
+c      au dessus de l (m), "ptop" est sa pression (Pa))
+
+      do  l=1,nlay
+        do ig=1, ngrid
+             
+             dztop = vstokes(ig,l)*  ptimestep 
+             Ep=0
+             k=0
+
+c **************************************************************
+c            Simple Method
+             w(ig,l) =
+     &       (1- exp(-dztop*g/(r*pt(ig,l))))*pplev(ig,l) / g
+cc           write(*,*) 'OK simple method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK simple method dztop =', dztop
+c **************************************************************
+cccc         Complex method :
+            if (dztop.gt.epaisseur(ig,l)) then
+cccc            Cas ou on "epuise" la couche l : On calcule le flux
+cccc            Venant de dessus en tenant compte de la variation de Vstokes
+
+               Ep= epaisseur(ig,l)
+               Stra= traversee(ig,l)
+               do while(dztop.gt.Ep.and.l+k+1.le.nlay)
+                 k=k+1
+                 dztop= Ep + vstokes(ig,l+k)*(ptimestep -Stra)
+                 Ep = Ep + epaisseur(ig,l+k)
+                 Stra = Stra + traversee(ig,l+k)
+               enddo 
+               Ep = Ep - epaisseur(ig,l+k)
+             end if
+             ptop=pplev(ig,l+k)*exp(-(dztop-Ep)*g/(r*pt(ig,l+k)))
+             w(ig,l) = (pplev(ig,l) -Ptop)/g
+c
+cc           write(*,*) 'OK new    method l,w =', l, w(ig,l)
+cc           write(*,*) 'OK new    method dztop =', dztop
+cc       if(l.eq.7)write(*,*)'l=7,k,pplev,Ptop',pplev(ig,l),Ptop
+cc       if(l.eq.7)write(*,*)'l=7,dztop,Ep',dztop,Ep
+cc            if(l.eq.6)write(*,*)'l=6,k, w',k, w(1,l)
+cc            if(l.eq.7)write(*,*)'l=7,k, w',k, w(1,l)
+cc            if(l.eq.8)write(*,*)'l=8,k, w',k, w(1,l)
+c **************************************************************
+        end do
+      end do
+
+      call vlz_fi(ngrid,pqi,2.,masse,w,wq)
+c         write(*,*) ' newsed: wq(6), wq(7), q(6)',
+c    &                wq(1,6),wq(1,7),pqi(1,6)
+
+
+      RETURN
+      END
+
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc.F	(revision 308)
@@ -0,0 +1,1 @@
+link vdifc_boosted_area.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc_boosted_area.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc_boosted_area.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc_boosted_area.F	(revision 308)
@@ -0,0 +1,652 @@
+      SUBROUTINE vdifc(ngrid,nlay,nq,co2ice,ppopsk,
+     $                ptimestep,pcapcal,lecrit,
+     $                pplay,pplev,pzlay,pzlev,pz0,
+     $                pu,pv,ph,pq,ptsrf,pemis,pqsurf,
+     $                pdufi,pdvfi,pdhfi,pdqfi,pfluxsrf,
+     $                pdudif,pdvdif,pdhdif,pdtsrf,pq2,
+     $                pdqdif,pdqsdif)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c   Turbulent diffusion (mixing) for potential T, U, V and tracer
+c
+c   Shema implicite
+c   On commence par rajouter au variables x la tendance physique
+c   et on resoult en fait:
+c      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
+c
+c   author:
+c   ------
+c      Hourdin/Forget/Fournier
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+
+#include "watercap.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
+      REAL ptsrf(ngrid),pemis(ngrid)
+      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
+      REAL pfluxsrf(ngrid)
+      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
+      REAL pdtsrf(ngrid),pcapcal(ngrid)
+      REAL pq2(ngrid,nlay+1)
+
+c    Argument added for condensation:
+      REAL co2ice (ngrid), ppopsk(ngrid,nlay)
+      logical lecrit
+      REAL pz0
+
+c    Traceurs :
+      integer nq 
+      REAL pqsurf(ngrid,nq)
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
+      real pdqdif(ngrid,nlay,nq) 
+      real pdqsdif(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ilev,ig,ilay,nlev
+
+      REAL z4st,zdplanck(ngridmx)
+      REAL zkv(ngridmx,nlayermx+1),zkh(ngridmx,nlayermx+1)
+      REAL zcdv(ngridmx),zcdh(ngridmx)
+      REAL zcdv_true(ngridmx),zcdh_true(ngridmx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL ztsrf2(ngridmx)
+      REAL z1(ngridmx),z2(ngridmx)
+      REAL za(ngridmx,nlayermx),zb(ngridmx,nlayermx)
+      REAL zb0(ngridmx,nlayermx)
+      REAL zc(ngridmx,nlayermx),zd(ngridmx,nlayermx)
+      REAL zcst1
+      REAL zu2
+
+      EXTERNAL SSUM,SCOPY
+      REAL SSUM
+      LOGICAL firstcall
+      SAVE firstcall
+
+c     variable added for CO2 condensation:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+      REAL hh , zhcond(ngridmx,nlayermx)
+      REAL latcond,tcond1mb
+      REAL acond,bcond
+      SAVE acond,bcond
+      DATA latcond,tcond1mb/5.9e5,136.27/
+
+c    Tracers :
+c    ~~~~~~~ 
+      INTEGER iq
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL zq1temp(ngridmx)
+      REAL rho(ngridmx) ! near surface air density
+      REAL qsat(ngridmx)
+      DATA firstcall/.true./
+
+      REAL kmixmin
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans vdifc'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+c        To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal)
+         bcond=1./tcond1mb
+         acond=r/latcond
+         PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+         PRINT*,'          acond,bcond',acond,bcond
+
+        firstcall=.false.
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+      nlev=nlay+1
+
+c    ** calcul de rho*dz et dt*rho/dz=dt*rho**2 g/dp
+c       avec rho=p/RT=p/ (R Theta) (p/ps)**kappa
+c       ----------------------------------------
+
+      DO ilay=1,nlay
+         DO ig=1,ngrid
+            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
+         ENDDO
+      ENDDO
+
+      zcst1=4.*g*ptimestep/(r*r)
+      DO ilev=2,nlev-1
+         DO ig=1,ngrid
+            zb0(ig,ilev)=pplev(ig,ilev)*
+     s      (pplev(ig,1)/pplev(ig,ilev))**rcp /
+     s      (ph(ig,ilev-1)+ph(ig,ilev))
+            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
+     s      (pplay(ig,ilev-1)-pplay(ig,ilev))
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+	 zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig))
+      ENDDO
+
+c    ** diagnostique pour linitialisation
+c       ----------------------------------
+
+      IF(lecrit) THEN
+         ig=ngrid/2+1
+         PRINT*,'Pression (mbar) ,altitude (km),u,v,theta, rho dz'
+         DO ilay=1,nlay
+            WRITE(*,'(6f11.5)')
+     s      .01*pplay(ig,ilay),.001*pzlay(ig,ilay),
+     s      pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
+         ENDDO
+         PRINT*,'Pression (mbar) ,altitude (km),zb'
+         DO ilev=1,nlay
+            WRITE(*,'(3f15.7)')
+     s      .01*pplev(ig,ilev),.001*pzlev(ig,ilev),
+     s      zb0(ig,ilev)
+         ENDDO
+      ENDIF
+
+c     Potential Condensation temperature:
+c     -----------------------------------
+
+c     if (callcond) then 
+c       DO ilev=1,nlay
+c         DO ig=1,ngrid
+c           zhcond(ig,ilev) =
+c    &  (1./(bcond-acond*log(.0095*pplay(ig,ilev))))/ppopsk(ig,ilev)
+c         END DO
+c       END DO
+c     else
+        call zerophys(ngrid*nlay,zhcond)
+c     end if
+
+
+c-----------------------------------------------------------------------
+c   2. ajout des tendances physiques
+c      -----------------------------
+
+      DO ilev=1,nlay
+         DO ig=1,ngrid
+            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
+            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=max(zh(ig,ilev),zhcond(ig,ilev))
+         ENDDO
+      ENDDO
+      if(tracer) then
+        DO iq =1, nq
+         DO ilev=1,nlay
+           DO ig=1,ngrid
+              zq(ig,ilev,iq)=pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+c-----------------------------------------------------------------------
+c   3. schema de turbulence
+c      --------------------
+
+c    ** source denergie cinetique turbulente a la surface
+c       (condition aux limites du schema de diffusion turbulente
+c       dans la couche limite
+c       ---------------------
+
+      CALL vdif_cd( ngrid,nlay,pz0,g,pzlay,pu,pv,ptsrf,ph
+     &             ,zcdv_true,zcdh_true)
+      DO ig=1,ngrid
+        zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
+        zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+        zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+      ENDDO
+
+c    ** schema de diffusion turbulente dans la couche limite
+c       ---------------------------------------------------- 
+
+        CALL vdif_kc(ptimestep,g,pzlev,pzlay
+     &              ,pu,pv,ph,zcdv_true
+     &              ,pq2,zkv,zkh)
+
+      if ((doubleq).and.(ngrid.eq.1)) then
+        kmixmin = 80. !80.! minimum eddy mix coeff in 1D
+        do ilev=1,nlay
+          do ig=1,ngrid
+           zkh(ig,ilev) = max(kmixmin,zkh(ig,ilev))
+           zkv(ig,ilev) = max(kmixmin,zkv(ig,ilev))
+          end do
+        end do
+      end if
+
+c    ** diagnostique pour le schema de turbulence
+c       -----------------------------------------
+
+      IF(lecrit) THEN
+         PRINT*
+         PRINT*,'Diagnostic for the vertical turbulent mixing'
+         PRINT*,'Cd for momentum and potential temperature'
+
+         PRINT*,zcdv(ngrid/2+1),zcdh(ngrid/2+1)
+         PRINT*,'Mixing coefficient for momentum and pot.temp.'
+         DO ilev=1,nlay
+            PRINT*,zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
+         ENDDO
+      ENDIF
+
+
+
+
+c-----------------------------------------------------------------------
+c   4. inversion pour limplicite sur u
+c      --------------------------------
+
+c    ** lequation est 
+c       u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
+c       avec
+c       /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Ku
+ 
+      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdv,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zu(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   5. inversion pour limplicite sur v
+c      --------------------------------
+
+c    ** lequation est 
+c       v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
+c       avec
+c       /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Kv
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zv(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   6. inversion pour limplicite sur h sans oublier le couplage
+c      avec le sol (conduction)
+c      ------------------------
+
+c    ** lequation est 
+c       h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
+c       avec
+c       /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
+c       donc les entrees sont /zcdh/ pour la condition de raccord au sol
+c       et /zkh/ = Kh
+c       -------------
+
+      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdh,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+c    ** calcul de (d Planck / dT) a la temperature dinterface
+c       ------------------------------------------------------
+
+      z4st=4.*5.67e-8*ptimestep
+      DO ig=1,ngrid
+         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
+      ENDDO
+
+c    ** calcul de la temperature_dinterface et de sa tendance.
+c       on ecrit que la somme des flux est nulle a linterface
+c       a t + \delta t,
+c       cest a dire le flux radiatif a {t + \delta t}
+c       + le flux turbulent a {t + \delta t} 
+c            qui secrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1
+c            (notation K dt = /cpp*b/)        
+c       + le flux dans le sol a t
+c       + levolution du flux dans le sol lorsque la temperature dinterface
+c       passe de sa valeur a t a sa valeur a {t + \delta t}.
+c       ----------------------------------------------------
+
+      DO ig=1,ngrid
+         z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1)
+     s     +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
+         z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
+         ztsrf2(ig)=z1(ig)/z2(ig)
+         pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep
+
+c        Modif speciale CO2 condensation:
+c        tconds = 1./(bcond-acond*log(.0095*pplev(ig,1)))
+c        if ((callcond).and.
+c    &      ((co2ice(ig).ne.0).or.(ztsrf2(ig).lt.tconds)))then
+c           zh(ig,1)=zc(ig,1)+zd(ig,1)*tconds
+c        else
+            zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig)
+c        end if
+      ENDDO
+
+c    ** et a partir de la temperature au sol on remonte 
+c       -----------------------------------------------
+
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            hh = max( zh(ig,ilay-1) , zhcond(ig,ilay-1) ) ! modif co2cond
+            zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
+         ENDDO
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   TRACERS
+c   -------
+
+      if(tracer) then
+           PRINT*, 'alphavdifc', alpha_lift(igcm_dust_mass)
+c     Using the wind modified by friction for lifting and  sublimation
+c     ----------------------------------------------------------------
+        DO ig=1,ngrid
+          zu2=zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
+          zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+          zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+        ENDDO
+
+c       Calcul du flux vertical au bas de la premiere couche (dust) :
+c       -----------------------------------------------------------
+        do ig=1,ngridmx  
+          rho(ig) = zb0(ig,1) /ptimestep
+c          zb(ig,1) = 0.
+        end do
+c       Dust lifting:
+        if (lifting) then
+           if (doubleq.AND.submicron) then
+             do ig=1,ngrid
+c              if(co2ice(ig).lt.1) then
+                 pdqsdif(ig,igcm_dust_mass) =
+     &             -alpha_lift(igcm_dust_mass)  
+                 pdqsdif(ig,igcm_dust_number) = 
+     &             -alpha_lift(igcm_dust_number)  
+                 pdqsdif(ig,igcm_dust_submicron) =
+     &             -alpha_lift(igcm_dust_submicron)
+c              end if
+             end do
+           else if (doubleq) then
+            call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+     &                    pdqsdif)
+!!             do ig=1,ngrid
+           !!! soulevement constant
+!!                 pdqsdif(ig,igcm_dust_mass) =
+!!     &             -alpha_lift(igcm_dust_mass)  
+!!                 pdqsdif(ig,igcm_dust_number) = 
+!!     &             -alpha_lift(igcm_dust_number)  
+!!             end do
+           else if (submicron) then
+             do ig=1,ngrid
+                 pdqsdif(ig,igcm_dust_submicron) =
+     &             -alpha_lift(igcm_dust_submicron)
+             end do
+           else
+            call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+     &                    pdqsdif)
+           endif !doubleq.AND.submicron
+        else
+           pdqsdif(1:ngrid,1:nq) = 0.
+        end if
+
+c       OU calcul de la valeur de q a la surface (water)  :
+c       ----------------------------------------
+        if (water) then 
+            call watersat(ngridmx,ptsrf,pplev(1,1),qsat)
+        end if
+
+c      Inversion pour limplicite sur q 
+c       --------------------------------
+        do iq=1,nq
+          CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+
+          if ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c            This line is required to account for turbulent transport 
+c            from surface (e.g. ice) to mid-layer of atmosphere:
+             CALL multipl(ngrid,zcdv,zb0,zb(1,1))
+             CALL multipl(ngrid,dryness,zb(1,1),zb(1,1)) 
+          else ! (re)-initialize zb(:,1)
+             zb(1:ngrid,1)=0
+          end if
+
+          DO ig=1,ngrid
+               z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+               zc(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+               zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+          ENDDO
+  
+          DO ilay=nlay-1,2,-1
+               DO ig=1,ngrid
+                z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+                zc(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
+     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+                zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+               ENDDO
+          ENDDO
+
+          if (water.and.(iq.eq.igcm_h2o_ice)) then
+            ! special case for water ice tracer: do not include
+            ! h2o ice tracer from surface (which is set when handling
+            ! h2o vapour case (see further down).
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2)) *z1(ig)
+            ENDDO
+          else ! general case
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2) +
+     $        (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)  !tracer flux from surface
+            ENDDO
+          endif ! of if (water.and.(iq.eq.igcm_h2o_ice))
+  
+          IF ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c           Calculation for turbulent exchange with the surface (for ice)
+            DO ig=1,ngrid
+              zd(ig,1)=zb(ig,1)*z1(ig)
+              zq1temp(ig)=zc(ig,1)+ zd(ig,1)*qsat(ig)
+
+              pdqsdif(ig,igcm_h2o_ice)=rho(ig)*dryness(ig)*zcdv(ig)
+     &                       *(zq1temp(ig)-qsat(ig))
+c             write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+            END DO
+
+            DO ig=1,ngrid
+              if(.not.watercaptag(ig)) then
+                if ((-pdqsdif(ig,igcm_h2o_ice)*ptimestep)
+     &             .gt.pqsurf(ig,igcm_h2o_ice)) then
+c                 write(*,*)'on sublime plus que qsurf!'
+                  pdqsdif(ig,igcm_h2o_ice)=
+     &                         -pqsurf(ig,igcm_h2o_ice)/ptimestep
+c                 write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+                  z1(ig)=1./(za(ig,1)+ zb(ig,2)*(1.-zd(ig,2)))
+                  zc(ig,1)=(za(ig,1)*zq(ig,1,igcm_h2o_vap)+
+     $            zb(ig,2)*zc(ig,2) +
+     $            (-pdqsdif(ig,igcm_h2o_ice)) *ptimestep) *z1(ig)
+                  zq1temp(ig)=zc(ig,1)
+                endif   
+              endif ! if (.not.watercaptag(ig))
+c             Starting upward calculations for water :
+               zq(ig,1,igcm_h2o_vap)=zq1temp(ig)
+            ENDDO ! of DO ig=1,ngrid
+          ELSE
+c           Starting upward calculations for simple mixing of tracer (dust)
+            DO ig=1,ngrid
+               zq(ig,1,iq)=zc(ig,1)
+            ENDDO
+          END IF ! of IF ((water).and.(iq.eq.igcm_h2o_vap))
+
+          DO ilay=2,nlay
+             DO ig=1,ngrid
+                zq(ig,ilay,iq)=zc(ig,ilay)+zd(ig,ilay)*zq(ig,ilay-1,iq)
+             ENDDO
+          ENDDO
+        enddo ! of do iq=1,nq
+      end if ! of if(tracer)
+
+c-----------------------------------------------------------------------
+c   8. calcul final des tendances de la diffusion verticale
+c      ----------------------------------------------------
+
+      DO ilev = 1, nlay
+         DO ig=1,ngrid
+            pdudif(ig,ilev)=(    zu(ig,ilev)-
+     $      (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep)    )/ptimestep
+            pdvdif(ig,ilev)=(    zv(ig,ilev)-
+     $      (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep)    )/ptimestep
+            hh = max(ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep ,
+     $           zhcond(ig,ilev))        ! modif co2cond
+            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
+         ENDDO
+      ENDDO
+
+    
+      if (tracer) then 
+        DO iq = 1, nq
+          DO ilev = 1, nlay
+            DO ig=1,ngrid
+              pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-
+     $      (pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+        ENDDO
+      end if
+
+c    ** diagnostique final 
+c       ------------------
+
+      IF(lecrit) THEN
+         PRINT*,'In vdif'
+         PRINT*,'Ts (t) and Ts (t+st)'
+         WRITE(*,'(a10,3a15)')
+     s   'theta(t)','theta(t+dt)','u(t)','u(t+dt)'
+         PRINT*,ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
+         DO ilev=1,nlay
+            WRITE(*,'(4f15.7)')
+     s      ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev),
+     s      pu(ngrid/2+1,ilev),zu(ngrid/2+1,ilev)
+
+         ENDDO
+      ENDIF
+
+      if (calltherm .and. outptherm) then
+      if (ngrid .eq. 1) then
+        call WRITEDIAGFI(ngrid,'zh','zh inside vdifc',
+     &                       'SI',1,ph(:,:)+pdhfi(:,:)*ptimestep)
+        call WRITEDIAGFI(ngrid,'zkh','zkh',
+     &                       'SI',1,zkh)
+      endif
+      endif 
+
+      RETURN
+      END
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc_mmr_dependent.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc_mmr_dependent.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/STORM_JULIEN_LAST/vdifc_mmr_dependent.F	(revision 308)
@@ -0,0 +1,652 @@
+      SUBROUTINE vdifc(ngrid,nlay,nq,co2ice,ppopsk,
+     $                ptimestep,pcapcal,lecrit,
+     $                pplay,pplev,pzlay,pzlev,pz0,
+     $                pu,pv,ph,pq,ptsrf,pemis,pqsurf,
+     $                pdufi,pdvfi,pdhfi,pdqfi,pfluxsrf,
+     $                pdudif,pdvdif,pdhdif,pdtsrf,pq2,
+     $                pdqdif,pdqsdif)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   subject:
+c   --------
+c   Turbulent diffusion (mixing) for potential T, U, V and tracer
+c
+c   Shema implicite
+c   On commence par rajouter au variables x la tendance physique
+c   et on resoult en fait:
+c      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
+c
+c   author:
+c   ------
+c      Hourdin/Forget/Fournier
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+#include "comgeomfi.h"
+#include "tracer.h"
+
+#include "watercap.h"
+c
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay
+      REAL ptimestep
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
+      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
+      REAL ptsrf(ngrid),pemis(ngrid)
+      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
+      REAL pfluxsrf(ngrid)
+      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
+      REAL pdtsrf(ngrid),pcapcal(ngrid)
+      REAL pq2(ngrid,nlay+1)
+
+c    Argument added for condensation:
+      REAL co2ice (ngrid), ppopsk(ngrid,nlay)
+      logical lecrit
+      REAL pz0
+
+c    Traceurs :
+      integer nq 
+      REAL pqsurf(ngrid,nq)
+      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq) 
+      real pdqdif(ngrid,nlay,nq) 
+      real pdqsdif(ngrid,nq) 
+      
+c   local:
+c   ------
+
+      INTEGER ilev,ig,ilay,nlev
+
+      REAL z4st,zdplanck(ngridmx)
+      REAL zkv(ngridmx,nlayermx+1),zkh(ngridmx,nlayermx+1)
+      REAL zcdv(ngridmx),zcdh(ngridmx)
+      REAL zcdv_true(ngridmx),zcdh_true(ngridmx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zh(ngridmx,nlayermx)
+      REAL ztsrf2(ngridmx)
+      REAL z1(ngridmx),z2(ngridmx)
+      REAL za(ngridmx,nlayermx),zb(ngridmx,nlayermx)
+      REAL zb0(ngridmx,nlayermx)
+      REAL zc(ngridmx,nlayermx),zd(ngridmx,nlayermx)
+      REAL zcst1
+      REAL zu2
+
+      EXTERNAL SSUM,SCOPY
+      REAL SSUM
+      LOGICAL firstcall
+      SAVE firstcall
+
+c     variable added for CO2 condensation:
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+      REAL hh , zhcond(ngridmx,nlayermx)
+      REAL latcond,tcond1mb
+      REAL acond,bcond
+      SAVE acond,bcond
+      DATA latcond,tcond1mb/5.9e5,136.27/
+
+c    Tracers :
+c    ~~~~~~~ 
+      INTEGER iq
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL zq1temp(ngridmx)
+      REAL rho(ngridmx) ! near surface air density
+      REAL qsat(ngridmx)
+      DATA firstcall/.true./
+
+      REAL kmixmin
+
+c    ** un petit test de coherence
+c       --------------------------
+
+      IF (firstcall) THEN
+         IF(ngrid.NE.ngridmx) THEN
+            PRINT*,'STOP dans vdifc'
+            PRINT*,'probleme de dimensions :'
+            PRINT*,'ngrid  =',ngrid
+            PRINT*,'ngridmx  =',ngridmx
+            STOP
+         ENDIF
+c        To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal)
+         bcond=1./tcond1mb
+         acond=r/latcond
+         PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+         PRINT*,'          acond,bcond',acond,bcond
+
+        firstcall=.false.
+      ENDIF
+
+
+
+
+
+c-----------------------------------------------------------------------
+c    1. initialisation
+c    -----------------
+
+      nlev=nlay+1
+
+c    ** calcul de rho*dz et dt*rho/dz=dt*rho**2 g/dp
+c       avec rho=p/RT=p/ (R Theta) (p/ps)**kappa
+c       ----------------------------------------
+
+      DO ilay=1,nlay
+         DO ig=1,ngrid
+            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
+         ENDDO
+      ENDDO
+
+      zcst1=4.*g*ptimestep/(r*r)
+      DO ilev=2,nlev-1
+         DO ig=1,ngrid
+            zb0(ig,ilev)=pplev(ig,ilev)*
+     s      (pplev(ig,1)/pplev(ig,ilev))**rcp /
+     s      (ph(ig,ilev-1)+ph(ig,ilev))
+            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/
+     s      (pplay(ig,ilev-1)-pplay(ig,ilev))
+         ENDDO
+      ENDDO
+      DO ig=1,ngrid
+	 zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig))
+      ENDDO
+
+c    ** diagnostique pour linitialisation
+c       ----------------------------------
+
+      IF(lecrit) THEN
+         ig=ngrid/2+1
+         PRINT*,'Pression (mbar) ,altitude (km),u,v,theta, rho dz'
+         DO ilay=1,nlay
+            WRITE(*,'(6f11.5)')
+     s      .01*pplay(ig,ilay),.001*pzlay(ig,ilay),
+     s      pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
+         ENDDO
+         PRINT*,'Pression (mbar) ,altitude (km),zb'
+         DO ilev=1,nlay
+            WRITE(*,'(3f15.7)')
+     s      .01*pplev(ig,ilev),.001*pzlev(ig,ilev),
+     s      zb0(ig,ilev)
+         ENDDO
+      ENDIF
+
+c     Potential Condensation temperature:
+c     -----------------------------------
+
+c     if (callcond) then 
+c       DO ilev=1,nlay
+c         DO ig=1,ngrid
+c           zhcond(ig,ilev) =
+c    &  (1./(bcond-acond*log(.0095*pplay(ig,ilev))))/ppopsk(ig,ilev)
+c         END DO
+c       END DO
+c     else
+        call zerophys(ngrid*nlay,zhcond)
+c     end if
+
+
+c-----------------------------------------------------------------------
+c   2. ajout des tendances physiques
+c      -----------------------------
+
+      DO ilev=1,nlay
+         DO ig=1,ngrid
+            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
+            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
+            zh(ig,ilev)=max(zh(ig,ilev),zhcond(ig,ilev))
+         ENDDO
+      ENDDO
+      if(tracer) then
+        DO iq =1, nq
+         DO ilev=1,nlay
+           DO ig=1,ngrid
+              zq(ig,ilev,iq)=pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep
+           ENDDO
+         ENDDO
+        ENDDO
+      end if
+
+c-----------------------------------------------------------------------
+c   3. schema de turbulence
+c      --------------------
+
+c    ** source denergie cinetique turbulente a la surface
+c       (condition aux limites du schema de diffusion turbulente
+c       dans la couche limite
+c       ---------------------
+
+      CALL vdif_cd( ngrid,nlay,pz0,g,pzlay,pu,pv,ptsrf,ph
+     &             ,zcdv_true,zcdh_true)
+      DO ig=1,ngrid
+        zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
+        zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+        zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+      ENDDO
+
+c    ** schema de diffusion turbulente dans la couche limite
+c       ---------------------------------------------------- 
+
+        CALL vdif_kc(ptimestep,g,pzlev,pzlay
+     &              ,pu,pv,ph,zcdv_true
+     &              ,pq2,zkv,zkh)
+
+      if ((doubleq).and.(ngrid.eq.1)) then
+        kmixmin = 80. !80.! minimum eddy mix coeff in 1D
+        do ilev=1,nlay
+          do ig=1,ngrid
+           zkh(ig,ilev) = max(kmixmin,zkh(ig,ilev))
+           zkv(ig,ilev) = max(kmixmin,zkv(ig,ilev))
+          end do
+        end do
+      end if
+
+c    ** diagnostique pour le schema de turbulence
+c       -----------------------------------------
+
+      IF(lecrit) THEN
+         PRINT*
+         PRINT*,'Diagnostic for the vertical turbulent mixing'
+         PRINT*,'Cd for momentum and potential temperature'
+
+         PRINT*,zcdv(ngrid/2+1),zcdh(ngrid/2+1)
+         PRINT*,'Mixing coefficient for momentum and pot.temp.'
+         DO ilev=1,nlay
+            PRINT*,zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
+         ENDDO
+      ENDIF
+
+
+
+
+c-----------------------------------------------------------------------
+c   4. inversion pour limplicite sur u
+c      --------------------------------
+
+c    ** lequation est 
+c       u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
+c       avec
+c       /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Ku
+ 
+      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdv,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zu(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   5. inversion pour limplicite sur v
+c      --------------------------------
+
+c    ** lequation est 
+c       v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
+c       avec
+c       /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
+c       donc les entrees sont /zcdv/ pour la condition a la limite sol
+c       et /zkv/ = Kv
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+      DO ig=1,ngrid
+         zv(ig,1)=zc(ig,1)
+      ENDDO
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
+         ENDDO
+      ENDDO
+
+
+
+
+
+c-----------------------------------------------------------------------
+c   6. inversion pour limplicite sur h sans oublier le couplage
+c      avec le sol (conduction)
+c      ------------------------
+
+c    ** lequation est 
+c       h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
+c       avec
+c       /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
+c       et
+c       dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
+c       donc les entrees sont /zcdh/ pour la condition de raccord au sol
+c       et /zkh/ = Kh
+c       -------------
+
+      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+      CALL multipl(ngrid,zcdh,zb0,zb)
+
+      DO ig=1,ngrid
+         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
+         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+      ENDDO
+
+      DO ilay=nlay-1,1,-1
+         DO ig=1,ngrid
+            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $         zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+
+     $         zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+         ENDDO
+      ENDDO
+
+c    ** calcul de (d Planck / dT) a la temperature dinterface
+c       ------------------------------------------------------
+
+      z4st=4.*5.67e-8*ptimestep
+      DO ig=1,ngrid
+         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
+      ENDDO
+
+c    ** calcul de la temperature_dinterface et de sa tendance.
+c       on ecrit que la somme des flux est nulle a linterface
+c       a t + \delta t,
+c       cest a dire le flux radiatif a {t + \delta t}
+c       + le flux turbulent a {t + \delta t} 
+c            qui secrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1
+c            (notation K dt = /cpp*b/)        
+c       + le flux dans le sol a t
+c       + levolution du flux dans le sol lorsque la temperature dinterface
+c       passe de sa valeur a t a sa valeur a {t + \delta t}.
+c       ----------------------------------------------------
+
+      DO ig=1,ngrid
+         z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1)
+     s     +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
+         z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
+         ztsrf2(ig)=z1(ig)/z2(ig)
+         pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep
+
+c        Modif speciale CO2 condensation:
+c        tconds = 1./(bcond-acond*log(.0095*pplev(ig,1)))
+c        if ((callcond).and.
+c    &      ((co2ice(ig).ne.0).or.(ztsrf2(ig).lt.tconds)))then
+c           zh(ig,1)=zc(ig,1)+zd(ig,1)*tconds
+c        else
+            zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig)
+c        end if
+      ENDDO
+
+c    ** et a partir de la temperature au sol on remonte 
+c       -----------------------------------------------
+
+      DO ilay=2,nlay
+         DO ig=1,ngrid
+            hh = max( zh(ig,ilay-1) , zhcond(ig,ilay-1) ) ! modif co2cond
+            zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
+         ENDDO
+      ENDDO
+
+
+c-----------------------------------------------------------------------
+c   TRACERS
+c   -------
+
+      if(tracer) then
+           PRINT*, 'alphavdifc', alpha_lift(igcm_dust_mass)
+c     Using the wind modified by friction for lifting and  sublimation
+c     ----------------------------------------------------------------
+        DO ig=1,ngrid
+          zu2=zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
+          zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
+          zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
+        ENDDO
+
+c       Calcul du flux vertical au bas de la premiere couche (dust) :
+c       -----------------------------------------------------------
+        do ig=1,ngridmx  
+          rho(ig) = zb0(ig,1) /ptimestep
+c          zb(ig,1) = 0.
+        end do
+c       Dust lifting:
+        if (lifting) then
+           if (doubleq.AND.submicron) then
+             do ig=1,ngrid
+c              if(co2ice(ig).lt.1) then
+                 pdqsdif(ig,igcm_dust_mass) =
+     &             -alpha_lift(igcm_dust_mass)  
+                 pdqsdif(ig,igcm_dust_number) = 
+     &             -alpha_lift(igcm_dust_number)  
+                 pdqsdif(ig,igcm_dust_submicron) =
+     &             -alpha_lift(igcm_dust_submicron)
+c              end if
+             end do
+           else if (doubleq) then
+            call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+     &                    pdqsdif,pq)
+!!             do ig=1,ngrid
+           !!! soulevement constant
+!!                 pdqsdif(ig,igcm_dust_mass) =
+!!     &             -alpha_lift(igcm_dust_mass)  
+!!                 pdqsdif(ig,igcm_dust_number) = 
+!!     &             -alpha_lift(igcm_dust_number)  
+!!             end do
+           else if (submicron) then
+             do ig=1,ngrid
+                 pdqsdif(ig,igcm_dust_submicron) =
+     &             -alpha_lift(igcm_dust_submicron)
+             end do
+           else
+            call dustlift(ngrid,nlay,nq,rho,zcdh_true,zcdh,co2ice,
+     &                    pdqsdif)
+           endif !doubleq.AND.submicron
+        else
+           pdqsdif(1:ngrid,1:nq) = 0.
+        end if
+
+c       OU calcul de la valeur de q a la surface (water)  :
+c       ----------------------------------------
+        if (water) then 
+            call watersat(ngridmx,ptsrf,pplev(1,1),qsat)
+        end if
+
+c      Inversion pour limplicite sur q 
+c       --------------------------------
+        do iq=1,nq
+          CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
+
+          if ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c            This line is required to account for turbulent transport 
+c            from surface (e.g. ice) to mid-layer of atmosphere:
+             CALL multipl(ngrid,zcdv,zb0,zb(1,1))
+             CALL multipl(ngrid,dryness,zb(1,1),zb(1,1)) 
+          else ! (re)-initialize zb(:,1)
+             zb(1:ngrid,1)=0
+          end if
+
+          DO ig=1,ngrid
+               z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
+               zc(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
+               zd(ig,nlay)=zb(ig,nlay)*z1(ig)
+          ENDDO
+  
+          DO ilay=nlay-1,2,-1
+               DO ig=1,ngrid
+                z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+
+     $           zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
+                zc(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+
+     $           zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
+                zd(ig,ilay)=zb(ig,ilay)*z1(ig)
+               ENDDO
+          ENDDO
+
+          if (water.and.(iq.eq.igcm_h2o_ice)) then
+            ! special case for water ice tracer: do not include
+            ! h2o ice tracer from surface (which is set when handling
+            ! h2o vapour case (see further down).
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2)) *z1(ig)
+            ENDDO
+          else ! general case
+            DO ig=1,ngrid
+                z1(ig)=1./(za(ig,1)+zb(ig,1)+
+     $           zb(ig,2)*(1.-zd(ig,2)))
+                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+
+     $         zb(ig,2)*zc(ig,2) +
+     $        (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)  !tracer flux from surface
+            ENDDO
+          endif ! of if (water.and.(iq.eq.igcm_h2o_ice))
+  
+          IF ((water).and.(iq.eq.igcm_h2o_vap)) then 
+c           Calculation for turbulent exchange with the surface (for ice)
+            DO ig=1,ngrid
+              zd(ig,1)=zb(ig,1)*z1(ig)
+              zq1temp(ig)=zc(ig,1)+ zd(ig,1)*qsat(ig)
+
+              pdqsdif(ig,igcm_h2o_ice)=rho(ig)*dryness(ig)*zcdv(ig)
+     &                       *(zq1temp(ig)-qsat(ig))
+c             write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+            END DO
+
+            DO ig=1,ngrid
+              if(.not.watercaptag(ig)) then
+                if ((-pdqsdif(ig,igcm_h2o_ice)*ptimestep)
+     &             .gt.pqsurf(ig,igcm_h2o_ice)) then
+c                 write(*,*)'on sublime plus que qsurf!'
+                  pdqsdif(ig,igcm_h2o_ice)=
+     &                         -pqsurf(ig,igcm_h2o_ice)/ptimestep
+c                 write(*,*)'flux vers le sol=',pdqsdif(ig,nq)
+                  z1(ig)=1./(za(ig,1)+ zb(ig,2)*(1.-zd(ig,2)))
+                  zc(ig,1)=(za(ig,1)*zq(ig,1,igcm_h2o_vap)+
+     $            zb(ig,2)*zc(ig,2) +
+     $            (-pdqsdif(ig,igcm_h2o_ice)) *ptimestep) *z1(ig)
+                  zq1temp(ig)=zc(ig,1)
+                endif   
+              endif ! if (.not.watercaptag(ig))
+c             Starting upward calculations for water :
+               zq(ig,1,igcm_h2o_vap)=zq1temp(ig)
+            ENDDO ! of DO ig=1,ngrid
+          ELSE
+c           Starting upward calculations for simple mixing of tracer (dust)
+            DO ig=1,ngrid
+               zq(ig,1,iq)=zc(ig,1)
+            ENDDO
+          END IF ! of IF ((water).and.(iq.eq.igcm_h2o_vap))
+
+          DO ilay=2,nlay
+             DO ig=1,ngrid
+                zq(ig,ilay,iq)=zc(ig,ilay)+zd(ig,ilay)*zq(ig,ilay-1,iq)
+             ENDDO
+          ENDDO
+        enddo ! of do iq=1,nq
+      end if ! of if(tracer)
+
+c-----------------------------------------------------------------------
+c   8. calcul final des tendances de la diffusion verticale
+c      ----------------------------------------------------
+
+      DO ilev = 1, nlay
+         DO ig=1,ngrid
+            pdudif(ig,ilev)=(    zu(ig,ilev)-
+     $      (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep)    )/ptimestep
+            pdvdif(ig,ilev)=(    zv(ig,ilev)-
+     $      (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep)    )/ptimestep
+            hh = max(ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep ,
+     $           zhcond(ig,ilev))        ! modif co2cond
+            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
+         ENDDO
+      ENDDO
+
+    
+      if (tracer) then 
+        DO iq = 1, nq
+          DO ilev = 1, nlay
+            DO ig=1,ngrid
+              pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-
+     $      (pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
+            ENDDO
+          ENDDO
+        ENDDO
+      end if
+
+c    ** diagnostique final 
+c       ------------------
+
+      IF(lecrit) THEN
+         PRINT*,'In vdif'
+         PRINT*,'Ts (t) and Ts (t+st)'
+         WRITE(*,'(a10,3a15)')
+     s   'theta(t)','theta(t+dt)','u(t)','u(t+dt)'
+         PRINT*,ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
+         DO ilev=1,nlay
+            WRITE(*,'(4f15.7)')
+     s      ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev),
+     s      pu(ngrid/2+1,ilev),zu(ngrid/2+1,ilev)
+
+         ENDDO
+      ENDIF
+
+      if (calltherm .and. outptherm) then
+      if (ngrid .eq. 1) then
+        call WRITEDIAGFI(ngrid,'zh','zh inside vdifc',
+     &                       'SI',1,ph(:,:)+pdhfi(:,:)*ptimestep)
+        call WRITEDIAGFI(ngrid,'zkh','zkh',
+     &                       'SI',1,zkh)
+      endif
+      endif 
+
+      RETURN
+      END
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aerave.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aerave.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aerave.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/aerave.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aerkind.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aerkind.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aerkind.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/aerkind.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aeropacity.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aeropacity.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aeropacity.F	(revision 308)
@@ -0,0 +1,1 @@
+link STORM_JULIEN_LAST/aeropacity.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aeroptproperties.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aeroptproperties.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/aeroptproperties.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/aeroptproperties.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/albedocaps.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/albedocaps.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/albedocaps.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/albedocaps.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/blackl.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/blackl.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/blackl.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/blackl.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/blendrad.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/blendrad.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/blendrad.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/blendrad.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calldrag_noro.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calldrag_noro.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calldrag_noro.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/calldrag_noro.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callkeys.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callkeys.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callkeys.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/callkeys.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callradite.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callradite.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callradite.F	(revision 308)
@@ -0,0 +1,1 @@
+link STORM_JULIEN_LAST/callradite.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callsedim.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callsedim.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/callsedim.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/callsedim.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calltherm_interface.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calltherm_interface.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calltherm_interface.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/calltherm_interface.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calltherm_mars.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calltherm_mars.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/calltherm_mars.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/calltherm_mars.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/co2snow.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/co2snow.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/co2snow.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/co2snow.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comcstfi.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comcstfi.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comcstfi.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/comcstfi.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comdiurn.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comdiurn.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comdiurn.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/comdiurn.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comg1d.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comg1d.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comg1d.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/comg1d.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comgeomfi.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comgeomfi.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comgeomfi.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/comgeomfi.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comorbit.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comorbit.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comorbit.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/comorbit.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comsaison.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comsaison.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comsaison.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/comsaison.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comsoil.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comsoil.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/comsoil.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/comsoil.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/convadj.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/convadj.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/convadj.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/convadj.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/cvmgp.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/cvmgp.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/cvmgp.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/cvmgp.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/cvmgt.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/cvmgt.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/cvmgt.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/cvmgt.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/datafile.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/datafile.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/datafile.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/datafile.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/datareadnc.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/datareadnc.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/datareadnc.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/datareadnc.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/def_var.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/def_var.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/def_var.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/def_var.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dimphys.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dimphys.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dimphys.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/dimphys.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dimradmars.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dimradmars.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dimradmars.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/dimradmars.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/drag_noro.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/drag_noro.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/drag_noro.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/drag_noro.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dustdevil.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dustdevil.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dustdevil.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/dustdevil.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dustlift.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dustlift.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/dustlift.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/dustlift.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/eofdump.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/eofdump.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/eofdump.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/eofdump.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/eofdump.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/eofdump.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/eofdump.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/eofdump.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/flusv.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/flusv.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/flusv.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/flusv.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/growthrate.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/growthrate.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/growthrate.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/growthrate.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/gwprofil.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/gwprofil.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/gwprofil.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/gwprofil.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/gwstress.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/gwstress.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/gwstress.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/gwstress.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ineofdump.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ineofdump.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ineofdump.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/ineofdump.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/inifis.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/inifis.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/inifis.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/inifis.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniorbit.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniorbit.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniorbit.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/iniorbit.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/inistats.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/inistats.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/inistats.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/inistats.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/initracer.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/initracer.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/initracer.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/initracer.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniwrite.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniwrite.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniwrite.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/iniwrite.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniwritesoil.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniwritesoil.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/iniwritesoil.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/iniwritesoil.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/interp_line.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/interp_line.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/interp_line.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/interp_line.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ismax.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ismax.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ismax.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/ismax.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ismin.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ismin.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/ismin.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/ismin.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwb.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwb.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwb.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwb.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwdiff.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwdiff.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwdiff.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwdiff.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwflux.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwflux.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwflux.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwflux.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwi.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwi.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwi.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwi.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwmain.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwmain.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwmain.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwmain.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwtt.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwtt.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwtt.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwtt.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwu.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwu.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwu.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwu.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxb.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxb.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxb.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwxb.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxd.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxd.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxd.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwxd.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxn.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxn.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/lwxn.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/lwxn.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/meso_inc
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/meso_inc	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/meso_inc	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/meso_inc
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mkstat.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mkstat.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mkstat.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/mkstat.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mucorr.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mucorr.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mucorr.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/mucorr.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mufract.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mufract.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/mufract.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/mufract.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/multipl.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/multipl.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/multipl.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/multipl.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/newcondens.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/newcondens.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/newcondens.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/newcondens.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/newsedim.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/newsedim.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/newsedim.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/newsedim.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nirco2abs.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nirco2abs.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nirco2abs.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/nirco2abs.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nltecool.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nltecool.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nltecool.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/nltecool.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nltedata.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nltedata.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nltedata.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/nltedata.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nlteparams.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nlteparams.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nlteparams.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/nlteparams.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nlthermeq.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nlthermeq.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/nlthermeq.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/nlthermeq.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orbite.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orbite.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orbite.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/orbite.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orodrag.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orodrag.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orodrag.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/orodrag.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orosetup.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orosetup.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/orosetup.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/orosetup.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/param_slope.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/param_slope.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/param_slope.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/param_slope.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/phyetat0.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/phyetat0.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/phyetat0.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/phyetat0.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physdem1.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physdem1.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physdem1.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/physdem1.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physiq.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physiq.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physiq.F	(revision 308)
@@ -0,0 +1,1884 @@
+      SUBROUTINE physiq(
+     $            ngrid,nlayer,nq
+     $            ,firstcall,lastcall
+     $            ,pday,ptime,ptimestep
+     $            ,pplev,pplay,pphi
+     $            ,pu,pv,pt,pq
+     $            ,pw
+     $            ,pdu,pdv,pdt,pdq,pdpsrf,tracerdyn
+#ifdef MESOSCALE
+#include "meso_inc/meso_inc_invar.F"
+#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           
+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    pw(ngrid,?)           vertical velocity
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx,nqmx)   /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+#include "slope.h"
+
+#ifdef MESOSCALE
+#include "wrf_output_2d.h"
+#include "wrf_output_3d.h"
+#include "advtrac.h"   !!! this is necessary for tracers (in dyn3d)
+#include "meso_inc/meso_inc_var.F"
+#endif
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx) ! surface pressure tendency
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind)
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad_sky(ngridmx)      ! rad. flux from sky absorbed by surface (W.m-2)
+      REAL fluxrad(ngridmx)          ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy
+      
+      REAL watercapflag(ngridmx)     ! water cap flag
+
+c     Variables used by the water ice microphysical scheme:
+      REAL rice(ngridmx,nlayermx)    ! Water ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+                                     !   of the size distribution
+
+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
+
+      SAVE day_ini, icount
+      SAVE aerosol, tsurf,tsoil
+      SAVE co2ice,albedo,emis, q2
+      SAVE capcal,fluxgrd,dtrad,fluxrad,fluxrad_sky,qsurf
+
+      REAL stephan   
+      DATA stephan/5.67e-08/  ! Stephan Boltzman constant
+      SAVE stephan
+
+c Local variables :
+c -----------------
+
+      REAL CBRT
+      EXTERNAL CBRT
+
+      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq,i, tapphys
+
+      REAL fluxsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngridmx)           ! Reference column optical depth at 700 Pa
+                                     ! (used if active=F) 
+      REAL tau(ngridmx,naerkind)     ! Column dust optical depth at each point
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngridmx,nlayermx)   ! altitude at the middle of the layers
+      REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries
+      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngridmx,nqmx)
+      REAL zdtlw(ngridmx,nlayermx)     ! (K/s)
+      REAL zdtsw(ngridmx,nlayermx)     ! (K/s)
+      REAL cldtlw(ngridmx,nlayermx)     ! (K/s) LW heating rate for clear area
+      REAL cldtsw(ngridmx,nlayermx)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngridmx,nlayermx) ! (K/s)
+      REAL zdtnlte(ngridmx,nlayermx)   ! (K/s)
+      REAL zdtsurf(ngridmx)            ! (K/s)
+      REAL zdtcloud(ngridmx,nlayermx)
+      REAL zdvdif(ngridmx,nlayermx),zdudif(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhdif(ngridmx,nlayermx), zdtsdif(ngridmx)         ! (K/s)
+      REAL zdvadj(ngridmx,nlayermx),zduadj(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhadj(ngridmx,nlayermx)                           ! (K/s)
+      REAL zdtgw(ngridmx,nlayermx)                            ! (K/s)
+      REAL zdugw(ngridmx,nlayermx),zdvgw(ngridmx,nlayermx)    ! (m.s-2)
+      REAL zdtc(ngridmx,nlayermx),zdtsurfc(ngridmx)
+      REAL zdvc(ngridmx,nlayermx),zduc(ngridmx,nlayermx)
+
+      REAL zdqdif(ngridmx,nlayermx,nqmx), zdqsdif(ngridmx,nqmx)
+      REAL zdqsed(ngridmx,nlayermx,nqmx), zdqssed(ngridmx,nqmx)
+      REAL zdqdev(ngridmx,nlayermx,nqmx), zdqsdev(ngridmx,nqmx)
+      REAL zdqadj(ngridmx,nlayermx,nqmx)
+      REAL zdqc(ngridmx,nlayermx,nqmx)
+      REAL zdqcloud(ngridmx,nlayermx,nqmx)
+      REAL zdqscloud(ngridmx,nqmx)
+      REAL zdqchim(ngridmx,nlayermx,nqmx)
+      REAL zdqschim(ngridmx,nqmx)
+
+      REAL zdteuv(ngridmx,nlayermx)    ! (K/s)
+      REAL zdtconduc(ngridmx,nlayermx) ! (K/s)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngridmx)
+      REAL zplanck(ngridmx),zpopsk(ngridmx,nlayermx)
+      REAL zdum1(ngridmx,nlayermx)
+      REAL zdum2(ngridmx,nlayermx)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngridmx,nlayermx)
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngridmx), zt(ngridmx,nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL fluxtop_sw_tot(ngridmx), fluxsurf_sw_tot(ngridmx)
+      character*2 str2
+      character*5 str5
+      real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      SAVE ccn  !! in case iradia != 1
+      real rdust(ngridmx,nlayermx) ! dust geometric mean radius (m)
+      real qtot1,qtot2 ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+      real co2col(ngridmx)        ! CO2 column
+      REAL zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      REAL zstress(ngrid), cd
+      real hco2(nqmx),tmean, zlocal(nlayermx)
+      real rho(ngridmx,nlayermx)  ! density
+      real vmr(ngridmx,nlayermx)  ! volume mixing ratio
+      REAL mtot(ngridmx)          ! Total mass of water vapor (kg/m2)
+      REAL icetot(ngridmx)        ! Total mass of water ice (kg/m2)
+      REAL rave(ngridmx)          ! Mean water ice effective radius (m)
+      REAL opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+      REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! Water ice absorption coefficient
+
+
+      REAL time_phys
+
+c Variables for PBL
+
+      REAL lmax_th_out(ngridmx),zmax_th(ngridmx)
+      REAL, SAVE :: wmax_th(ngridmx)
+      REAL hfmax_th(ngridmx)
+      REAL pdu_th(ngridmx,nlayermx),pdv_th(ngridmx,nlayermx)
+      REAL pdt_th(ngridmx,nlayermx),pdq_th(ngridmx,nlayermx,nqmx)
+      INTEGER lmax_th(ngridmx)
+      REAL dtke_th(ngridmx,nlayermx+1)
+      REAL zcdv(ngridmx), zcdh(ngridmx)
+      REAL Teta_out(ngridmx),u_out(ngridmx)  ! Interpolated teta and u at z_out
+      REAL z_out                          ! height of interpolation between z0 and z1
+      REAL ustar(ngridmx),tstar(ngridmx)  ! friction velocity and friction potential temp
+      REAL zu2(ngridmx)
+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
+         fluxrad(:)=0
+
+         wmax_th(:)=0.
+
+c        read startfi 
+c        ~~~~~~~~~~~~
+#ifndef MESOSCALE
+! Read netcdf initial physical parameters.
+         CALL phyetat0 ("startfi.nc",0,0,
+     &         nsoilmx,nq,
+     &         day_ini,time_phys,
+     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+#else
+#include "meso_inc/meso_inc_ini.F"
+#endif
+
+         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
+
+c        initialize tracers
+c        ~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         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
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         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) call param_read
+#endif
+c        Initialize R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+
+        IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+          write(*,*)"physiq: water_param Surface water ice albedo:", 
+     .                  albedo_h2o_ice
+        ENDIF
+                   
+      ENDIF        !  (end of "if firstcall")
+
+c ---------------------------------------------------
+c 1.2   Initializations done at every physical timestep:
+c ---------------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+c     Initialize various variables
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      pdv(:,:)=0
+      pdu(:,:)=0
+      pdt(:,:)=0
+      pdq(:,:,:)=0
+      pdpsrf(:)=0
+      zflubid(:)=0
+      zdtsurf(:)=0
+      dqsurf(:,:)=0
+      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     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=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Compute potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      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)
+         ENDDO
+      ENDDO
+
+#ifndef MESOSCALE
+c-----------------------------------------------------------------------
+c    1.2.5 Compute mean mass, cp, and R
+c    --------------------------------
+
+      if(photochem.or.callthermos) then
+         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+      endif
+#endif
+c-----------------------------------------------------------------------
+c    2. Compute radiative tendencies :
+c------------------------------------
+
+
+      IF (callrad) THEN
+         !!!! JF+AS
+         zdqnorm(:,:,:) = 0.
+         !!!! JF+AS
+         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, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+     &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+
+c          Note: Dustopacity.F has been transferred to callradite.F
+         
+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,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice,zdqnorm,dsodust)
+!     &     tauref,tau,aerosol,ccn,rdust,rice,nuice)
+!!!! JF+AS
+
+c          Outputs for basic check (middle of domain)
+c          ------------------------------------------
+           print*, 'Ls =',zls*180./pi,
+     &             'check lat lon', lati(igout)*180/pi,
+     &                              long(igout)*180/pi
+           print*, 'tauref(700 Pa) =',tauref(igout),
+     &             ' tau(700 Pa) =',tau(igout,1)*700./pplev(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.*long(ig)/pi/15.
+                 sl_ra  = pi*(1.0-sl_lct/12.)
+                 sl_lat = 180.*lati(ig)/pi
+                 sl_tau = tau(ig,1)
+                 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,pplay,dist_sol,
+     .                       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, pplay,
+     &             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,
+     &                 pplay,pplev,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
+
+
+#ifdef MESOSCALE
+      IF (.not.flag_LES) THEN
+#endif
+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 ) THEN
+          DO ig=1, ngridmx
+             IF (zh(ig,1) .lt. tsurf(ig)) THEN
+               wmax_th(ig)=1.
+             ENDIF        
+          ENDDO
+        ENDIF
+c ----------------------
+#ifdef MESOSCALE
+      ENDIF
+#endif
+
+
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif,wmax_th,zcdv,zcdh)
+
+#ifdef MESOSCALE
+#include "meso_inc/meso_inc_les.F"
+#endif
+         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
+
+          DO ig=1,ngrid
+             zdtsurf(ig)=zdtsurf(ig)+zdtsdif(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)+ 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    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+#ifdef MESOSCALE
+         IF (flag_LES) THEN
+            write(*,*) 'LES mode !' 
+            write(*,*) 'Please set calldifv to T in callphys.def'
+            STOP
+         ENDIF
+#endif
+      ENDIF ! of IF (calldifv)
+
+c-----------------------------------------------------------------------
+c   TEST. Thermals :
+c HIGHLY EXPERIMENTAL, BEWARE !!
+c   -----------------------------
+ 
+      if(calltherm) then
+ 
+        call calltherm_interface(firstcall,
+     $ long,lati,zzlev,zzlay,
+     $ ptimestep,pu,pv,pt,pq,pdu,pdv,pdt,pdq,q2,
+     $ pplay,pplev,pphi,zpopsk,
+     $ pdu_th,pdv_th,pdt_th,pdq_th,lmax_th,zmax_th,
+     $ dtke_th,hfmax_th,wmax_th)
+ 
+         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
+        wmax_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,
+     $                pplay,pplev,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. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      IF (callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,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)
+
+      ENDIF  ! of IF (callcond)
+
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if (tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+           call watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,
+     &                ccn,rdust,rice,nuice)
+           if (activice) then
+c Temperature variation due to latent heat release
+           DO l=1,nlayer
+             DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+             ENDDO
+           ENDDO
+           endif
+
+! increment water vapour and ice atmospheric tracers tendencies
+           IF (water) THEN
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o_vap)=pdq(ig,l,igcm_h2o_vap)+
+     &                                   zdqcloud(ig,l,igcm_h2o_vap)
+                 pdq(ig,l,igcm_h2o_ice)=pdq(ig,l,igcm_h2o_ice)+
+     &                                   zdqcloud(ig,l,igcm_h2o_ice)
+               ENDDO
+             ENDDO
+           ENDIF ! of IF (water) THEN
+! Increment water ice surface tracer tendency
+         DO ig=1,ngrid
+           dqsurf(ig,igcm_h2o_ice)=dqsurf(ig,igcm_h2o_ice)+
+     &                               zdqscloud(ig,igcm_h2o_ice)
+         ENDDO
+         
+         END IF  ! of IF (water)
+
+c   7b. Chemical species
+c     ------------------
+
+#ifndef MESOSCALE
+c        --------------
+c        photochemistry :
+c        --------------
+         IF (photochem .or. thermochem) then
+          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+     &      zzlay,zday,pq,pdq,rice,
+     &      zdqchim,zdqschim,zdqcloud,zdqscloud)
+!NB: Photochemistry includes condensation of H2O2
+
+           ! 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   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,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 
+           !call zerophys(ngrid*nlayer*nq, zdqsed)
+           zdqsed(1:ngrid,1:nlayer,1:nq)=0
+           !call zerophys(ngrid*nq, zdqssed)
+           zdqssed(1:ngrid,1:nq)=0
+
+           call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt, rdust, rice,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+
+           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   7d. 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   8. THERMOSPHERE CALCULATION
+c-----------------------------------------------------------------------
+
+      if (callthermos) then
+        call thermosphere(pplev,pplay,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   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.(ngridmx.NE.1)) THEN
+#ifndef MESOSCALE
+         if (caps.and.(obliquit.lt.27.)) then
+           ! NB: Updated surface pressure, at grid point 'ngrid', is
+           !     ps(ngrid)=pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
+           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
+     &                     (pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
+         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     &        ,lati(ig)*180./pi, long(ig)*180./pi
+           endif
+         enddo  ! of do ig=1,ngrid
+      ENDIF  ! of IF (tracer.AND.water.AND.(ngridmx.NE.1))
+
+c
+c   9.2 Compute soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     &          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+      ENDIF
+
+     !!!! JF+AS
+c-----------------------------------------------------------
+c   10. Ajout tache de poussiere ou 'dust bomb propagative perturbation'
+c-----------------------------------------------------------
+            DO l=1,nlayer
+              DO ig=1,ngrid
+
+                     pdq(ig,l,igcm_dust_mass)=pdq(ig,l,igcm_dust_mass)+
+     &                                         zdqnorm(ig,l,1)
+                     pdq(ig,l,igcm_dust_number)=
+     &                                       pdq(ig,l,igcm_dust_number) 
+     &                                        +zdqnorm(ig,l,2)
+              ENDDO
+            ENDDO
+     !!!! JF+AS
+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
+
+      ! surface pressure
+      DO ig=1,ngrid
+          ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+      ENDDO
+
+      ! pressure
+      DO l=1,nlayer
+        DO ig=1,ngrid
+             zplev(ig,l)=pplev(ig,l)/pplev(ig,1)*ps(ig)
+             zplay(ig,l)=pplay(ig,l)/pplev(ig,1)*ps(ig)
+        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,ngridmx
+          DO l=1,nlayermx
+              zh(ig,l) = zt(ig,l)*(zplay(ig,l)/zplev(ig,1))**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   pplev(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)
+
+      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(lastcall) THEN
+            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+            write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+     .              ptimestep,pday,
+     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+     .              zgam,zthe)
+         ENDIF
+#endif
+
+c        -------------------------------------------------------------------
+c        Calculation of diagnostic variables written in both stats and
+c          diagfi files
+c        -------------------------------------------------------------------
+
+         if (tracer) then
+           if (water) then
+
+             mtot(:)=0
+             icetot(:)=0
+             rave(:)=0
+             tauTES(:)=0
+             do ig=1,ngrid 
+               do l=1,nlayermx
+                 mtot(ig) = mtot(ig) + 
+     &                      zq(ig,l,igcm_h2o_vap) * 
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g
+                 icetot(ig) = icetot(ig) + 
+     &                        zq(ig,l,igcm_h2o_ice) * 
+     &                        (pplev(ig,l) - pplev(ig,l+1)) / g
+                 rave(ig) = rave(ig) + 
+     &                      zq(ig,l,igcm_h2o_ice) *
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g * 
+     &                      rice(ig,l) * (1.+nuice_ref)
+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) *
+     &             (pplev(ig,l) - pplev(ig,l+1)) / g
+     &             / (rho_ice * rice(ig,l) * (1.+nuice_ref))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+               rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
+             enddo
+
+           endif ! of if (water)
+         endif ! of if (tracer)
+
+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,"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","none",3,rho)
+           call wstats(ngrid,"pressure","Pressure","Pa",3,pplay)
+c          call wstats(ngrid,"q2",
+c    &                "Boundary layer eddy kinetic energy",
+c    &                "m2.s-2",3,q2)
+c          call wstats(ngrid,"emis","Surface emissivity","w.m-1",2,
+c    &                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 (tracer) then
+             if (water) then
+               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_vap)
+     &                  *mugaz/mmol(igcm_h2o_vap)
+               call wstats(ngrid,"vmr_h2ovapor",
+     &                    "H2O vapor volume mixing ratio","mol/mol",
+     &                    3,vmr)
+               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+     &                  *mugaz/mmol(igcm_h2o_ice)
+               call wstats(ngrid,"vmr_h2oice",
+     &                    "H2O ice 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,"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)
+c              call wstats(ngrid,"rice",
+c    &                    "Ice particle size","m",
+c    &                    3,rice)
+c              If activice is true, tauTES is computed in aeropacity.F;
+               if (.not.activice) then
+                 call wstats(ngrid,"tauTESap",
+     &                      "tau abs 825 cm-1","",
+     &                      2,tauTES)
+               endif
+
+             endif ! of if (water)
+
+             if (thermochem.or.photochem) then
+                do iq=1,nq
+                   if ((noms(iq).eq."o").or.(noms(iq).eq."co2").or.
+     .                (noms(iq).eq."co").or.(noms(iq).eq."n2").or.
+     .                (noms(iq).eq."h2").or.
+     .                (noms(iq).eq."o3")) then
+                        do l=1,nlayer
+                          do ig=1,ngrid
+                            vmr(ig,l)=zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
+                          end do
+                        end do
+                        call wstats(ngrid,"vmr_"//trim(noms(iq)),
+     .                     "Volume mixing ratio","mol/mol",3,vmr)
+                   endif
+                enddo
+             endif ! of if (thermochem.or.photochem)
+
+           endif ! 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
+
+
+#ifdef MESOSCALE
+      !!!
+      !!! OUTPUT FIELDS
+      !!!
+      wtsurf(1:ngrid) = tsurf(1:ngrid)    !! surface temperature
+      wco2ice(1:ngrid) = co2ice(1:ngrid)  !! co2 ice
+      mtot(1:ngrid) = mtot(1:ngrid) * 1.e6 / rho_ice
+      !! JF 
+      TAU_lay(:)=tau(:,1)!!true opacity (not a reference like tauref)
+      IF (igcm_dust_mass .ne. 0) THEN
+        qsurfice_dust(1:ngrid) = qsurf(1:ngrid,igcm_dust_mass)
+      ENDIF
+      IF (igcm_h2o_ice .ne. 0) THEN      
+        qsurfice(1:ngrid) = qsurf(1:ngrid,igcm_h2o_ice)
+        vmr=1.e6 * zq(1:ngrid,1:nlayer,igcm_h2o_ice)
+     .           * mugaz / mmol(igcm_h2o_ice)
+      ENDIF
+      !! Dust quantity integration along the vertical axe
+      dustot(:)=0
+      do ig=1,ngrid
+       do l=1,nlayermx
+        dustot(ig) = dustot(ig) +
+     &               zq(ig,l,igcm_dust_mass)
+     &               *  (pplev(ig,l) - pplev(ig,l+1)) / g
+       enddo
+      enddo
+c AUTOMATICALLY GENERATED FROM REGISTRY
+#include "fill_save.inc"
+#else
+
+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)
+!         call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay)
+!         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)
+
+c         call WRITEDIAGFI(ngrid,"temp7","temperature in layer 7",
+c     &                  "K",2,zt(1,7))
+c         call WRITEDIAGFI(ngrid,"fluxsurf_lw","fluxsurf_lw","W.m-2",2,
+c     &                  fluxsurf_lw)
+c         call WRITEDIAGFI(ngrid,"fluxsurf_sw","fluxsurf_sw","W.m-2",2,
+c     &                  fluxsurf_sw_tot)
+c         call WRITEDIAGFI(ngrid,"fluxtop_lw","fluxtop_lw","W.m-2",2,
+c     &                  fluxtop_lw)
+c         call WRITEDIAGFI(ngrid,"fluxtop_sw","fluxtop_sw","W.m-2",2,
+c     &                  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)
+!        call WRITEDIAGFI(ngrid,'Teta','T potentielle','K',3,zh)
+c        call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,pplay)
+c        call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2,
+c    &                  zstress)
+c        call WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate',
+c    &                   'w.m-2',3,zdtsw)
+c        call WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate',
+c    &                   'w.m-2',3,zdtlw)
+c        CALL WRITEDIAGFI(ngridmx,'tauTESap',
+c     &                         'tau abs 825 cm-1',
+c     &                         '',2,tauTES)
+
+#ifdef MESOINI
+        call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
+     &                  emis)
+        call WRITEDIAGFI(ngrid,"rho","density","none",3,rho)
+        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,nlayermx
+           do ig=1,ngrid
+             co2col(ig)=co2col(ig)+
+     &                  zq(ig,l,igcm_co2)*(pplev(ig,l)-pplev(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(ngridmx,'q01',noms(igcm_h2o_ice),
+     &                      'kg/kg',3,
+     &                       zq(1:ngridmx,1:nlayermx,igcm_h2o_ice))
+            !!!! watervapor = q02, voir readmeteo.F90
+            call WRITEDIAGFI(ngridmx,'q02',noms(igcm_h2o_vap),
+     &                      'kg/kg',3,
+     &                       zq(1:ngridmx,1:nlayermx,igcm_h2o_vap))
+            !!!! surface waterice qsurf02 (voir readmeteo)
+            call WRITEDIAGFI(ngridmx,'qsurf02','surface tracer',
+     &                      'kg.m-2',2,
+     &                       qsurf(1:ngridmx,igcm_h2o_ice))
+#endif
+
+             CALL WRITEDIAGFI(ngridmx,'mtot',
+     &                       'total mass of water vapor',
+     &                       'kg/m2',2,mtot)
+             CALL WRITEDIAGFI(ngridmx,'icetot',
+     &                       'total mass of water ice',
+     &                       'kg/m2',2,icetot)
+c            vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+c    &                *mugaz/mmol(igcm_h2o_ice)
+c            call WRITEDIAGFI(ngridmx,'vmr_h2oice','h2o ice vmr',
+c    &                       'mol/mol',3,vmr)
+             CALL WRITEDIAGFI(ngridmx,'reffice',
+     &                       'Mean reff',
+     &                       'm',2,rave)
+c            call WRITEDIAGFI(ngridmx,'rice','Ice particle size',
+c    &                       'm',3,rice)
+c            If activice is true, tauTES is computed in aeropacity.F;
+             if (.not.activice) then
+               CALL WRITEDIAGFI(ngridmx,'tauTESap',
+     &                         'tau abs 825 cm-1',
+     &                         '',2,tauTES)
+             endif
+             call WRITEDIAGFI(ngridmx,'h2o_ice_s',
+     &                       'surface h2o_ice',
+     &                       'kg.m-2',2,qsurf(1,igcm_h2o_ice))
+
+            if (caps) then
+             do ig=1,ngridmx
+                if (watercaptag(ig)) watercapflag(ig) = 1
+             enddo
+             CALL WRITEDIAGFI(ngridmx,'watercaptag',
+     &                         'Ice water caps',
+     &                         '',2,watercapflag)
+            endif
+            CALL WRITEDIAGFI(ngridmx,'albedo',
+     &                         'albedo',
+     &                         '',2,albedo(1:ngridmx,1))
+           endif !(water)
+
+
+           if (water.and..not.photochem) then
+             iq=nq
+c            write(str2(1:2),'(i2.2)') iq
+c            call WRITEDIAGFI(ngridmx,'dqs'//str2,'dqscloud',
+c    &                       'kg.m-2',2,zdqscloud(1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqch'//str2,'var chim',
+c    &                       'kg/kg',3,zdqchim(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqd'//str2,'var dif',
+c    &                       'kg/kg',3,zdqdif(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqa'//str2,'var adj',
+c    &                       'kg/kg',3,zdqadj(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'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        ----------------------------------------------------------
+
+c        call WRITEDIAGFI(ngridmx,'tauref',
+c    &                    'Dust ref opt depth','NU',2,tauref)
+
+         if (tracer.and.(dustbin.ne.0)) then
+c          call WRITEDIAGFI(ngridmx,'tau','taudust','SI',2,tau(1,1))
+           if (doubleq) then
+c            call WRITEDIAGFI(ngridmx,'qsurf','qsurf',
+c    &                       'kg.m-2',2,qsurf(1,1))
+c            call WRITEDIAGFI(ngridmx,'Nsurf','N particles',
+c    &                       'N.m-2',2,qsurf(1,2))
+c            call WRITEDIAGFI(ngridmx,'dqsdev','ddevil lift',
+c    &                       'kg.m-2.s-1',2,zdqsdev(1,1))
+c            call WRITEDIAGFI(ngridmx,'dqssed','sedimentation',
+c    &                       'kg.m-2.s-1',2,zdqssed(1,1))
+             call WRITEDIAGFI(ngridmx,'reffdust','reffdust',
+     &                        'm',3,rdust*ref_r0)
+             call WRITEDIAGFI(ngridmx,'dustq','Dust mass mr',
+     &                        'kg/kg',3,pq(1,1,igcm_dust_mass))
+c            call WRITEDIAGFI(ngridmx,'dustN','Dust number',
+c    &                        'part/kg',3,pq(1,1,igcm_dust_number))
+#ifdef MESOINI
+             call WRITEDIAGFI(ngridmx,'dustN','Dust number',
+     &                        'part/kg',3,pq(1,1,igcm_dust_number))
+#endif
+           else
+             do iq=1,dustbin
+               write(str2(1:2),'(i2.2)') iq
+               call WRITEDIAGFI(ngridmx,'q'//str2,'mix. ratio',
+     &                         'kg/kg',3,zq(1,1,iq))
+               call WRITEDIAGFI(ngridmx,'qsurf'//str2,'qsurf',
+     &                         'kg.m-2',2,qsurf(1,iq))
+             end do
+           endif ! (doubleq)
+c          if (submicron) then
+c            call WRITEDIAGFI(ngridmx,'dustsubm','subm mass mr',
+c    &                        'kg/kg',3,pq(1,1,igcm_dust_submicron))
+c          endif ! (submicron)
+         end if  ! (tracer.and.(dustbin.ne.0))
+
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+c        PBL OUTPUS
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+
+
+c        ----------------------------------------------------------
+c        Outputs of surface layer
+c        ----------------------------------------------------------
+
+
+         z_out=0.
+         if (calltherm .and. (z_out .gt. 0.)) then
+         call surflayer_interpol(ngrid,nlayer,z0,g,zzlay,zu,zv,wmax_th
+     &              ,tsurf,zh,z_out,Teta_out,u_out,ustar,tstar)
+
+         zu2(:)=sqrt(zu(:,1)*zu(:,1)+zv(:,1)*zv(:,1))
+         call WRITEDIAGFI(ngridmx,'sqrt(zu2)',
+     &              'horizontal velocity norm','m/s',
+     &                         2,zu2)
+
+         call WRITEDIAGFI(ngridmx,'Teta_out',
+     &              'potential temperature at z_out','K',
+     &                         2,Teta_out)
+         call WRITEDIAGFI(ngridmx,'u_out',
+     &              'horizontal velocity norm at z_out','m/s',
+     &                         2,u_out)
+         call WRITEDIAGFI(ngridmx,'u*',
+     &              'friction velocity','m/s',
+     &                         2,ustar)
+         call WRITEDIAGFI(ngridmx,'teta*',
+     &              'friction potential temperature','K',
+     &                         2,tstar)
+         else
+           if((.not. calltherm).and.(z_out .gt. 0.)) then
+            print*, 'WARNING : no interpolation in surface-layer :'
+            print*, 'Outputing surface-layer quantities without thermals
+     & does not make sense'
+           endif
+         endif
+
+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(ngridmx,'lmax_th',
+     &              'hauteur du thermique','K',
+     &                         2,lmax_th_out)
+        call WRITEDIAGFI(ngridmx,'hfmax_th',
+     &              'maximum TH heat flux','K.m/s',
+     &                         2,hfmax_th)
+        call WRITEDIAGFI(ngridmx,'wmax_th',
+     &              'maximum TH vertical velocity','m/s',
+     &                         2,wmax_th)
+
+         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
+
+      ELSE     ! if(ngrid.eq.1)
+
+         print*,'Ls =',zls*180./pi,
+     &  '  tauref(700 Pa) =',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
+
+         z_out=0.
+         if (calltherm .and. (z_out .gt. 0.)) then
+         call surflayer_interpol(ngrid,nlayer,z0,g,zzlay,zu,zv,wmax_th
+     &              ,tsurf,zh,z_out,Teta_out,u_out,ustar,tstar)
+
+         zu2(:)=sqrt(zu(:,1)*zu(:,1)+zv(:,1)*zv(:,1))
+         call WRITEDIAGFI(ngridmx,'sqrt(zu2)',
+     &              'horizontal velocity norm','m/s',
+     &                         0,zu2)
+
+         call WRITEDIAGFI(ngridmx,'Teta_out',
+     &              'potential temperature at z_out','K',
+     &                         0,Teta_out)
+         call WRITEDIAGFI(ngridmx,'u_out',
+     &              'horizontal velocity norm at z_out','m/s',
+     &                         0,u_out)
+         call WRITEDIAGFI(ngridmx,'u*',
+     &              'friction velocity','m/s',
+     &                         0,ustar)
+         call WRITEDIAGFI(ngridmx,'teta*',
+     &              'friction potential temperature','K',
+     &                         0,tstar)
+         else
+           if((.not. calltherm).and.(z_out .gt. 0.)) then
+            print*, 'WARNING : no interpolation in surface-layer :'
+            print*, 'Outputing surface-layer quantities without thermals
+     & does not make sense'
+           endif
+         endif
+
+         if(calltherm) then
+
+        call WRITEDIAGFI(ngridmx,'lmax_th',
+     &              'hauteur du thermique','point',
+     &                         0,lmax_th_out)
+        call WRITEDIAGFI(ngridmx,'hfmax_th',
+     &              'maximum TH heat flux','K.m/s',
+     &                         0,hfmax_th)
+        call WRITEDIAGFI(ngridmx,'wmax_th',
+     &              'maximum TH vertical velocity','m/s',
+     &                         0,wmax_th)
+
+         co2col(:)=0.
+         if (tracer) then
+         do l=1,nlayermx
+           do ig=1,ngrid
+             co2col(ig)=co2col(ig)+
+     &                  zq(ig,l,1)*(pplev(ig,l)-pplev(ig,l+1))/g
+         enddo
+         enddo
+
+         end if
+         call WRITEDIAGFI(ngrid,'co2col','integrated co2 mass'          &
+     &                                      ,'kg/m-2',0,co2col)
+         endif
+         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)
+! or output in diagfi.nc (for testphys1d)
+         call WRITEDIAGFI(ngridmx,'ps','Surface pressure','Pa',0,ps)
+         call WRITEDIAGFI(ngridmx,'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(ngridmx,trim(noms(iq)),
+     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
+            end do
+         end if
+
+         zlocal(1)=-log(pplay(1,1)/pplev(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(pplay(1,l)/pplay(1,l-1))*rnew(1,l)*tmean/g
+         enddo
+         zlocal(nlayer)= zlocal(nlayer-1)-
+     &                   log(pplay(1,nlayer)/pplay(1,nlayer-1))*
+     &                   rnew(1,nlayer)*tmean/g
+
+      END IF       ! if(ngrid.ne.1)
+
+      icount=icount+1
+      RETURN
+      END
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physiq.F.ini
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physiq.F.ini	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/physiq.F.ini	(revision 308)
@@ -0,0 +1,1864 @@
+      SUBROUTINE physiq(
+     $            ngrid,nlayer,nq
+     $            ,firstcall,lastcall
+     $            ,pday,ptime,ptimestep
+     $            ,pplev,pplay,pphi
+     $            ,pu,pv,pt,pq
+     $            ,pw
+     $            ,pdu,pdv,pdt,pdq,pdpsrf,tracerdyn
+#ifdef MESOSCALE
+#include "meso_inc/meso_inc_invar.F"
+#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           
+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    pw(ngrid,?)           vertical velocity
+c
+c   output:
+c   -------
+c
+c    pdu(ngrid,nlayermx)        \
+c    pdv(ngrid,nlayermx)         \  Temporal derivative of the corresponding
+c    pdt(ngrid,nlayermx)         /  variables due to physical processes.
+c    pdq(ngrid,nlayermx,nqmx)   /
+c    pdpsrf(ngrid)             /
+c    tracerdyn                 call tracer in dynamical part of GCM ?
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "surfdat.h"
+#include "comsoil.h"
+#include "comdiurn.h"
+#include "callkeys.h"
+#include "comcstfi.h"
+#include "planete.h"
+#include "comsaison.h"
+#include "control.h"
+#include "dimradmars.h"
+#include "comg1d.h"
+#include "tracer.h"
+#include "nlteparams.h"
+
+#include "chimiedata.h"
+#include "param.h"
+#include "param_v3.h"
+#include "conc.h"
+
+#include "netcdf.inc"
+
+#include "slope.h"
+
+#ifdef MESOSCALE
+#include "wrf_output_2d.h"
+#include "wrf_output_3d.h"
+#include "advtrac.h"   !!! this is necessary for tracers (in dyn3d)
+#include "meso_inc/meso_inc_var.F"
+#endif
+
+c Arguments :
+c -----------
+
+c   inputs:
+c   -------
+      INTEGER ngrid,nlayer,nq
+      REAL ptimestep
+      REAL pplev(ngridmx,nlayer+1),pplay(ngridmx,nlayer)
+      REAL pphi(ngridmx,nlayer)
+      REAL pu(ngridmx,nlayer),pv(ngridmx,nlayer)
+      REAL pt(ngridmx,nlayer),pq(ngridmx,nlayer,nq)
+      REAL pw(ngridmx,nlayer) !Mars pvervel transmit par dyn3d
+      REAL zh(ngridmx,nlayermx)      ! potential temperature (K)
+      LOGICAL firstcall,lastcall
+
+      REAL pday
+      REAL ptime 
+      logical tracerdyn
+
+c   outputs:
+c   --------
+c     physical tendencies
+      REAL pdu(ngridmx,nlayer),pdv(ngridmx,nlayer)
+      REAL pdt(ngridmx,nlayer),pdq(ngridmx,nlayer,nq)
+      REAL pdpsrf(ngridmx) ! surface pressure tendency
+
+
+c Local saved variables:
+c ----------------------
+c     aerosol (dust or ice) extinction optical depth  at reference wavelength 
+c     "longrefvis" set in dimradmars.h , for one of the "naerkind"  kind of
+c      aerosol optical properties  :
+      REAL aerosol(ngridmx,nlayermx,naerkind)
+
+      INTEGER day_ini  ! Initial date of the run (sol since Ls=0) 
+      INTEGER icount     ! counter of calls to physiq during the run.
+      REAL tsurf(ngridmx)            ! Surface temperature (K)
+      REAL tsoil(ngridmx,nsoilmx)    ! sub-surface temperatures (K)
+      REAL co2ice(ngridmx)           ! co2 ice surface layer (kg.m-2)  
+      REAL albedo(ngridmx,2)         ! Surface albedo in each solar band
+      REAL emis(ngridmx)             ! Thermal IR surface emissivity
+      REAL dtrad(ngridmx,nlayermx)   ! Net atm. radiative heating rate (K.s-1)
+      REAL fluxrad_sky(ngridmx)      ! rad. flux from sky absorbed by surface (W.m-2)
+      REAL fluxrad(ngridmx)          ! Net radiative surface flux (W.m-2)
+      REAL capcal(ngridmx)           ! surface heat capacity (J m-2 K-1)
+      REAL fluxgrd(ngridmx)          ! surface conduction flux (W.m-2)
+      REAL qsurf(ngridmx,nqmx)       ! tracer on surface (e.g. kg.m-2)
+      REAL q2(ngridmx,nlayermx+1)    ! Turbulent Kinetic Energy
+      
+      REAL watercapflag(ngridmx)     ! water cap flag
+
+c     Variables used by the water ice microphysical scheme:
+      REAL rice(ngridmx,nlayermx)    ! Water ice geometric mean radius (m)
+      REAL nuice(ngridmx,nlayermx)   ! Estimated effective variance
+                                     !   of the size distribution
+
+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
+
+      SAVE day_ini, icount
+      SAVE aerosol, tsurf,tsoil
+      SAVE co2ice,albedo,emis, q2
+      SAVE capcal,fluxgrd,dtrad,fluxrad,fluxrad_sky,qsurf
+
+      REAL stephan   
+      DATA stephan/5.67e-08/  ! Stephan Boltzman constant
+      SAVE stephan
+
+c Local variables :
+c -----------------
+
+      REAL CBRT
+      EXTERNAL CBRT
+
+      CHARACTER*80 fichier 
+      INTEGER l,ig,ierr,igout,iq,i, tapphys
+
+      REAL fluxsurf_lw(ngridmx)      !incident LW (IR) surface flux (W.m-2)
+      REAL fluxsurf_sw(ngridmx,2)    !incident SW (solar) surface flux (W.m-2)
+      REAL fluxtop_lw(ngridmx)       !Outgoing LW (IR) flux to space (W.m-2)
+      REAL fluxtop_sw(ngridmx,2)     !Outgoing SW (solar) flux to space (W.m-2)
+      REAL tauref(ngridmx)           ! Reference column optical depth at 700 Pa
+                                     ! (used if active=F) 
+      REAL tau(ngridmx,naerkind)     ! Column dust optical depth at each point
+      REAL zls                       !  solar longitude (rad)
+      REAL zday                      ! date (time since Ls=0, in martian days)
+      REAL zzlay(ngridmx,nlayermx)   ! altitude at the middle of the layers
+      REAL zzlev(ngridmx,nlayermx+1) ! altitude at layer boundaries
+      REAL latvl1,lonvl1             ! Viking Lander 1 point (for diagnostic)
+
+c     Tendancies due to various processes:
+      REAL dqsurf(ngridmx,nqmx)
+      REAL zdtlw(ngridmx,nlayermx)     ! (K/s)
+      REAL zdtsw(ngridmx,nlayermx)     ! (K/s)
+      REAL cldtlw(ngridmx,nlayermx)     ! (K/s) LW heating rate for clear area
+      REAL cldtsw(ngridmx,nlayermx)     ! (K/s) SW heating rate for clear area
+      REAL zdtnirco2(ngridmx,nlayermx) ! (K/s)
+      REAL zdtnlte(ngridmx,nlayermx)   ! (K/s)
+      REAL zdtsurf(ngridmx)            ! (K/s)
+      REAL zdtcloud(ngridmx,nlayermx)
+      REAL zdvdif(ngridmx,nlayermx),zdudif(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhdif(ngridmx,nlayermx), zdtsdif(ngridmx)         ! (K/s)
+      REAL zdvadj(ngridmx,nlayermx),zduadj(ngridmx,nlayermx)  ! (m.s-2)
+      REAL zdhadj(ngridmx,nlayermx)                           ! (K/s)
+      REAL zdtgw(ngridmx,nlayermx)                            ! (K/s)
+      REAL zdugw(ngridmx,nlayermx),zdvgw(ngridmx,nlayermx)    ! (m.s-2)
+      REAL zdtc(ngridmx,nlayermx),zdtsurfc(ngridmx)
+      REAL zdvc(ngridmx,nlayermx),zduc(ngridmx,nlayermx)
+
+      REAL zdqdif(ngridmx,nlayermx,nqmx), zdqsdif(ngridmx,nqmx)
+      REAL zdqsed(ngridmx,nlayermx,nqmx), zdqssed(ngridmx,nqmx)
+      REAL zdqdev(ngridmx,nlayermx,nqmx), zdqsdev(ngridmx,nqmx)
+      REAL zdqadj(ngridmx,nlayermx,nqmx)
+      REAL zdqc(ngridmx,nlayermx,nqmx)
+      REAL zdqcloud(ngridmx,nlayermx,nqmx)
+      REAL zdqscloud(ngridmx,nqmx)
+      REAL zdqchim(ngridmx,nlayermx,nqmx)
+      REAL zdqschim(ngridmx,nqmx)
+
+      REAL zdteuv(ngridmx,nlayermx)    ! (K/s)
+      REAL zdtconduc(ngridmx,nlayermx) ! (K/s)
+      REAL zdumolvis(ngridmx,nlayermx)
+      REAL zdvmolvis(ngridmx,nlayermx)
+      real zdqmoldiff(ngridmx,nlayermx,nqmx)
+
+c     Local variable for local intermediate calcul:
+      REAL zflubid(ngridmx)
+      REAL zplanck(ngridmx),zpopsk(ngridmx,nlayermx)
+      REAL zdum1(ngridmx,nlayermx)
+      REAL zdum2(ngridmx,nlayermx)
+      REAL ztim1,ztim2,ztim3, z1,z2
+      REAL ztime_fin
+      REAL zdh(ngridmx,nlayermx)
+      INTEGER length
+      PARAMETER (length=100)
+
+c local variables only used for diagnostic (output in file "diagfi" or "stats")
+c -----------------------------------------------------------------------------
+      REAL ps(ngridmx), zt(ngridmx,nlayermx)
+      REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx)
+      REAL zq(ngridmx,nlayermx,nqmx)
+      REAL fluxtop_sw_tot(ngridmx), fluxsurf_sw_tot(ngridmx)
+      character*2 str2
+      character*5 str5
+      real zdtdif(ngridmx,nlayermx), zdtadj(ngridmx,nlayermx)
+      REAL ccn(ngridmx,nlayermx)   ! Cloud condensation nuclei
+                                   !   (particules kg-1)
+      SAVE ccn  !! in case iradia != 1
+      real rdust(ngridmx,nlayermx) ! dust geometric mean radius (m)
+      real qtot1,qtot2 ! total aerosol mass
+      integer igmin, lmin
+      logical tdiag
+
+      real co2col(ngridmx)        ! CO2 column
+      REAL zplev(ngrid,nlayermx+1),zplay(ngrid,nlayermx)
+      REAL zstress(ngrid), cd
+      real hco2(nqmx),tmean, zlocal(nlayermx)
+      real rho(ngridmx,nlayermx)  ! density
+      real vmr(ngridmx,nlayermx)  ! volume mixing ratio
+      REAL mtot(ngridmx)          ! Total mass of water vapor (kg/m2)
+      REAL icetot(ngridmx)        ! Total mass of water ice (kg/m2)
+      REAL rave(ngridmx)          ! Mean water ice effective radius (m)
+      REAL opTES(ngridmx,nlayermx)! abs optical depth at 825 cm-1
+      REAL tauTES(ngridmx)        ! column optical depth at 825 cm-1
+      REAL Qabsice                ! Water ice absorption coefficient
+
+
+      REAL time_phys
+
+c Variables for PBL
+
+      REAL lmax_th_out(ngridmx),zmax_th(ngridmx)
+      REAL, SAVE :: wmax_th(ngridmx)
+      REAL hfmax_th(ngridmx)
+      REAL pdu_th(ngridmx,nlayermx),pdv_th(ngridmx,nlayermx)
+      REAL pdt_th(ngridmx,nlayermx),pdq_th(ngridmx,nlayermx,nqmx)
+      INTEGER lmax_th(ngridmx)
+      REAL dtke_th(ngridmx,nlayermx+1)
+      REAL zcdv(ngridmx), zcdh(ngridmx)
+      REAL Teta_out(ngridmx),u_out(ngridmx)  ! Interpolated teta and u at z_out
+      REAL z_out                          ! height of interpolation between z0 and z1
+      REAL ustar(ngridmx),tstar(ngridmx)  ! friction velocity and friction potential temp
+      REAL zu2(ngridmx)
+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
+         fluxrad(:)=0
+
+         wmax_th(:)=0.
+
+c        read startfi 
+c        ~~~~~~~~~~~~
+#ifndef MESOSCALE
+! Read netcdf initial physical parameters.
+         CALL phyetat0 ("startfi.nc",0,0,
+     &         nsoilmx,nq,
+     &         day_ini,time_phys,
+     &         tsurf,tsoil,emis,q2,qsurf,co2ice)
+#else
+#include "meso_inc/meso_inc_ini.F"
+#endif
+
+         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
+
+c        initialize tracers
+c        ~~~~~~~~~~~~~~~~~~
+         tracerdyn=tracer
+         IF (tracer) THEN
+            CALL initracer(qsurf,co2ice)
+         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
+            CALL soil(ngrid,nsoilmx,firstcall,inertiedat,
+     s          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+         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) call param_read
+#endif
+c        Initialize R and Cp as constant
+
+         if (.not.callthermos .and. .not.photochem) then
+                 do l=1,nlayermx
+                  do ig=1,ngridmx
+                   rnew(ig,l)=r
+                   cpnew(ig,l)=cpp
+                   mmean(ig,l)=mugaz
+                   enddo
+                  enddo  
+         endif         
+
+        IF (tracer.AND.water.AND.(ngridmx.NE.1)) THEN
+          write(*,*)"physiq: water_param Surface water ice albedo:", 
+     .                  albedo_h2o_ice
+        ENDIF
+                   
+      ENDIF        !  (end of "if firstcall")
+
+c ---------------------------------------------------
+c 1.2   Initializations done at every physical timestep:
+c ---------------------------------------------------
+c
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in PHYSIQ'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+c     Initialize various variables
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      pdv(:,:)=0
+      pdu(:,:)=0
+      pdt(:,:)=0
+      pdq(:,:,:)=0
+      pdpsrf(:)=0
+      zflubid(:)=0
+      zdtsurf(:)=0
+      dqsurf(:,:)=0
+      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     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=(pplay(ig,l-1)+pplev(ig,l))/(pplay(ig,l-1)-pplev(ig,l))
+            z2=(pplev(ig,l)+pplay(ig,l))/(pplev(ig,l)-pplay(ig,l))
+            zzlev(ig,l)=(z1*zzlay(ig,l-1)+z2*zzlay(ig,l))/(z1+z2)
+         ENDDO
+      ENDDO
+
+
+!     Potential temperature calculation not the same in physiq and dynamic
+
+c     Compute potential temperature
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      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)
+         ENDDO
+      ENDDO
+
+#ifndef MESOSCALE
+c-----------------------------------------------------------------------
+c    1.2.5 Compute mean mass, cp, and R
+c    --------------------------------
+
+      if(photochem.or.callthermos) then
+         call concentrations(pplay,pt,pdt,pq,pdq,ptimestep)
+      endif
+#endif
+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, lati, mu0, fract,10000.,rad)
+           ENDIF
+
+c          NLTE cooling from CO2 emission
+c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+           IF(callnlte) CALL nltecool(ngrid,nlayer,pplay,pt,zdtnlte)
+
+c          Find number of layers for LTE radiation calculations
+           IF(MOD(iphysiq*(icount-1),day_step).EQ.0)
+     &          CALL nlthermeq(ngrid,nlayer,pplev,pplay)
+
+c          Note: Dustopacity.F has been transferred to callradite.F
+         
+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,pplev,pplay,pt,tsurf,fract,dist_sol,igout,
+     $     zdtlw,zdtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,fluxtop_sw,
+     &     tauref,tau,aerosol,ccn,rdust,rice,nuice)
+
+c          Outputs for basic check (middle of domain)
+c          ------------------------------------------
+           print*, 'Ls =',zls*180./pi,
+     &             'check lat lon', lati(igout)*180/pi,
+     &                              long(igout)*180/pi
+           print*, 'tauref(700 Pa) =',tauref(igout),
+     &             ' tau(700 Pa) =',tau(igout,1)*700./pplev(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.*long(ig)/pi/15.
+                 sl_ra  = pi*(1.0-sl_lct/12.)
+                 sl_lat = 180.*lati(ig)/pi
+                 sl_tau = tau(ig,1)
+                 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,pplay,dist_sol,
+     .                       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, pplay,
+     &             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,
+     &                 pplay,pplev,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
+
+
+#ifdef MESOSCALE
+      IF (.not.flag_LES) THEN
+#endif
+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 ) THEN
+          DO ig=1, ngridmx
+             IF (zh(ig,1) .lt. tsurf(ig)) THEN
+               wmax_th(ig)=1.
+             ENDIF        
+          ENDDO
+        ENDIF
+c ----------------------
+#ifdef MESOSCALE
+      ENDIF
+#endif
+
+
+c        Calling vdif (Martian version WITH CO2 condensation)
+         CALL vdifc(ngrid,nlayer,nq,co2ice,zpopsk,
+     $        ptimestep,capcal,lwrite,
+     $        pplay,pplev,zzlay,zzlev,z0,
+     $        pu,pv,zh,pq,tsurf,emis,qsurf,
+     $        zdum1,zdum2,zdh,pdq,zflubid,
+     $        zdudif,zdvdif,zdhdif,zdtsdif,q2,
+     &        zdqdif,zdqsdif,wmax_th,zcdv,zcdh)
+
+#ifdef MESOSCALE
+#include "meso_inc/meso_inc_les.F"
+#endif
+         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
+
+          DO ig=1,ngrid
+             zdtsurf(ig)=zdtsurf(ig)+zdtsdif(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)+ 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    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s      (fluxrad(ig)+fluxgrd(ig))/capcal(ig)
+         ENDDO
+#ifdef MESOSCALE
+         IF (flag_LES) THEN
+            write(*,*) 'LES mode !' 
+            write(*,*) 'Please set calldifv to T in callphys.def'
+            STOP
+         ENDIF
+#endif
+      ENDIF ! of IF (calldifv)
+
+c-----------------------------------------------------------------------
+c   TEST. Thermals :
+c HIGHLY EXPERIMENTAL, BEWARE !!
+c   -----------------------------
+ 
+      if(calltherm) then
+ 
+        call calltherm_interface(firstcall,
+     $ long,lati,zzlev,zzlay,
+     $ ptimestep,pu,pv,pt,pq,pdu,pdv,pdt,pdq,q2,
+     $ pplay,pplev,pphi,zpopsk,
+     $ pdu_th,pdv_th,pdt_th,pdq_th,lmax_th,zmax_th,
+     $ dtke_th,hfmax_th,wmax_th)
+ 
+         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
+        wmax_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,
+     $                pplay,pplev,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. Carbon dioxide condensation-sublimation:
+c   -------------------------------------------
+
+      IF (callcond) THEN
+         CALL newcondens(ngrid,nlayer,nq,ptimestep,
+     $              capcal,pplay,pplev,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)
+
+      ENDIF  ! of IF (callcond)
+
+c-----------------------------------------------------------------------
+c   7. Specific parameterizations for tracers 
+c:   -----------------------------------------
+
+      if (tracer) then 
+
+c   7a. Water and ice
+c     ---------------
+
+c        ---------------------------------------
+c        Water ice condensation in the atmosphere
+c        ----------------------------------------
+         IF (water) THEN
+
+           call watercloud(ngrid,nlayer,ptimestep,
+     &                pplev,pplay,pdpsrf,zzlev,zzlay, pt,pdt,
+     &                pq,pdq,zdqcloud,zdqscloud,zdtcloud,
+     &                nq,naerkind,tau,
+     &                ccn,rdust,rice,nuice)
+           if (activice) then
+c Temperature variation due to latent heat release
+           DO l=1,nlayer
+             DO ig=1,ngrid
+               pdt(ig,l)=pdt(ig,l)+zdtcloud(ig,l)
+             ENDDO
+           ENDDO
+           endif
+
+! increment water vapour and ice atmospheric tracers tendencies
+           IF (water) THEN
+             DO l=1,nlayer
+               DO ig=1,ngrid
+                 pdq(ig,l,igcm_h2o_vap)=pdq(ig,l,igcm_h2o_vap)+
+     &                                   zdqcloud(ig,l,igcm_h2o_vap)
+                 pdq(ig,l,igcm_h2o_ice)=pdq(ig,l,igcm_h2o_ice)+
+     &                                   zdqcloud(ig,l,igcm_h2o_ice)
+               ENDDO
+             ENDDO
+           ENDIF ! of IF (water) THEN
+! Increment water ice surface tracer tendency
+         DO ig=1,ngrid
+           dqsurf(ig,igcm_h2o_ice)=dqsurf(ig,igcm_h2o_ice)+
+     &                               zdqscloud(ig,igcm_h2o_ice)
+         ENDDO
+         
+         END IF  ! of IF (water)
+
+c   7b. Chemical species
+c     ------------------
+
+#ifndef MESOSCALE
+c        --------------
+c        photochemistry :
+c        --------------
+         IF (photochem .or. thermochem) then
+          call calchim(ptimestep,pplay,pplev,pt,pdt,dist_sol,mu0,
+     &      zzlay,zday,pq,pdq,rice,
+     &      zdqchim,zdqschim,zdqcloud,zdqscloud)
+!NB: Photochemistry includes condensation of H2O2
+
+           ! 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   7c. Aerosol particles
+c     -------------------
+
+c        ----------
+c        Dust devil :
+c        ----------
+         IF(callddevil) then 
+           call dustdevil(ngrid,nlayer,nq, pplev,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 
+           !call zerophys(ngrid*nlayer*nq, zdqsed)
+           zdqsed(1:ngrid,1:nlayer,1:nq)=0
+           !call zerophys(ngrid*nq, zdqssed)
+           zdqssed(1:ngrid,1:nq)=0
+
+           call callsedim(ngrid,nlayer, ptimestep,
+     &                pplev,zzlev, pt, rdust, rice,
+     &                pq, pdq, zdqsed, zdqssed,nq)
+
+           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   7d. 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   8. THERMOSPHERE CALCULATION
+c-----------------------------------------------------------------------
+
+      if (callthermos) then
+        call thermosphere(pplev,pplay,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   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.(ngridmx.NE.1)) THEN
+#ifndef MESOSCALE
+         if (caps.and.(obliquit.lt.27.)) then
+           ! NB: Updated surface pressure, at grid point 'ngrid', is
+           !     ps(ngrid)=pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep
+           tsurf(ngrid)=1./(1./136.27-r/5.9e+5*alog(0.0095*
+     &                     (pplev(ngrid,1)+pdpsrf(ngrid)*ptimestep)))
+         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     &        ,lati(ig)*180./pi, long(ig)*180./pi
+           endif
+         enddo  ! of do ig=1,ngrid
+      ENDIF  ! of IF (tracer.AND.water.AND.(ngridmx.NE.1))
+
+c
+c   9.2 Compute soil temperatures and subsurface heat flux:
+c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      IF (callsoil) THEN
+         CALL soil(ngrid,nsoilmx,.false.,inertiedat,
+     &          ptimestep,tsurf,tsoil,capcal,fluxgrd)
+      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
+
+      ! surface pressure
+      DO ig=1,ngrid
+          ps(ig)=pplev(ig,1) + pdpsrf(ig)*ptimestep
+      ENDDO
+
+      ! pressure
+      DO l=1,nlayer
+        DO ig=1,ngrid
+             zplev(ig,l)=pplev(ig,l)/pplev(ig,1)*ps(ig)
+             zplay(ig,l)=pplay(ig,l)/pplev(ig,1)*ps(ig)
+        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,ngridmx
+          DO l=1,nlayermx
+              zh(ig,l) = zt(ig,l)*(zplay(ig,l)/zplev(ig,1))**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   pplev(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)
+
+      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(lastcall) THEN
+            ztime_fin = ptime + ptimestep/(float(iphysiq)*daysec) 
+            write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin
+            call physdem1("restartfi.nc",long,lati,nsoilmx,nq,
+     .              ptimestep,pday,
+     .              ztime_fin,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,
+     .              zgam,zthe)
+         ENDIF
+#endif
+
+c        -------------------------------------------------------------------
+c        Calculation of diagnostic variables written in both stats and
+c          diagfi files
+c        -------------------------------------------------------------------
+
+         if (tracer) then
+           if (water) then
+
+             mtot(:)=0
+             icetot(:)=0
+             rave(:)=0
+             tauTES(:)=0
+             do ig=1,ngrid 
+               do l=1,nlayermx
+                 mtot(ig) = mtot(ig) + 
+     &                      zq(ig,l,igcm_h2o_vap) * 
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g
+                 icetot(ig) = icetot(ig) + 
+     &                        zq(ig,l,igcm_h2o_ice) * 
+     &                        (pplev(ig,l) - pplev(ig,l+1)) / g
+                 rave(ig) = rave(ig) + 
+     &                      zq(ig,l,igcm_h2o_ice) *
+     &                      (pplev(ig,l) - pplev(ig,l+1)) / g * 
+     &                      rice(ig,l) * (1.+nuice_ref)
+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) *
+     &             (pplev(ig,l) - pplev(ig,l+1)) / g
+     &             / (rho_ice * rice(ig,l) * (1.+nuice_ref))
+                 tauTES(ig)=tauTES(ig)+ opTES(ig,l) 
+               enddo
+               rave(ig)=rave(ig)/max(icetot(ig),1.e-30)
+               if (icetot(ig)*1e3.lt.0.01) rave(ig)=0.
+             enddo
+
+           endif ! of if (water)
+         endif ! of if (tracer)
+
+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,"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","none",3,rho)
+           call wstats(ngrid,"pressure","Pressure","Pa",3,pplay)
+c          call wstats(ngrid,"q2",
+c    &                "Boundary layer eddy kinetic energy",
+c    &                "m2.s-2",3,q2)
+c          call wstats(ngrid,"emis","Surface emissivity","w.m-1",2,
+c    &                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 (tracer) then
+             if (water) then
+               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_vap)
+     &                  *mugaz/mmol(igcm_h2o_vap)
+               call wstats(ngrid,"vmr_h2ovapor",
+     &                    "H2O vapor volume mixing ratio","mol/mol",
+     &                    3,vmr)
+               vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+     &                  *mugaz/mmol(igcm_h2o_ice)
+               call wstats(ngrid,"vmr_h2oice",
+     &                    "H2O ice 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,"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)
+c              call wstats(ngrid,"rice",
+c    &                    "Ice particle size","m",
+c    &                    3,rice)
+c              If activice is true, tauTES is computed in aeropacity.F;
+               if (.not.activice) then
+                 call wstats(ngrid,"tauTESap",
+     &                      "tau abs 825 cm-1","",
+     &                      2,tauTES)
+               endif
+
+             endif ! of if (water)
+
+             if (thermochem.or.photochem) then
+                do iq=1,nq
+                   if ((noms(iq).eq."o").or.(noms(iq).eq."co2").or.
+     .                (noms(iq).eq."co").or.(noms(iq).eq."n2").or.
+     .                (noms(iq).eq."h2").or.
+     .                (noms(iq).eq."o3")) then
+                        do l=1,nlayer
+                          do ig=1,ngrid
+                            vmr(ig,l)=zq(ig,l,iq)*mmean(ig,l)/mmol(iq)
+                          end do
+                        end do
+                        call wstats(ngrid,"vmr_"//trim(noms(iq)),
+     .                     "Volume mixing ratio","mol/mol",3,vmr)
+                   endif
+                enddo
+             endif ! of if (thermochem.or.photochem)
+
+           endif ! 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
+
+
+#ifdef MESOSCALE
+      !!!
+      !!! OUTPUT FIELDS
+      !!!
+      wtsurf(1:ngrid) = tsurf(1:ngrid)    !! surface temperature
+      wco2ice(1:ngrid) = co2ice(1:ngrid)  !! co2 ice
+      mtot(1:ngrid) = mtot(1:ngrid) * 1.e6 / rho_ice
+      !! JF 
+      TAU_lay(:)=tau(:,1)!!true opacity (not a reference like tauref)
+      IF (igcm_dust_mass .ne. 0) THEN
+        qsurfice_dust(1:ngrid) = qsurf(1:ngrid,igcm_dust_mass)
+      ENDIF
+      IF (igcm_h2o_ice .ne. 0) THEN      
+        qsurfice(1:ngrid) = qsurf(1:ngrid,igcm_h2o_ice)
+        vmr=1.e6 * zq(1:ngrid,1:nlayer,igcm_h2o_ice)
+     .           * mugaz / mmol(igcm_h2o_ice)
+      ENDIF
+      !! Dust quantity integration along the vertical axe
+      dustot(:)=0
+      do ig=1,ngrid
+       do l=1,nlayermx
+        dustot(ig) = dustot(ig) +
+     &               zq(ig,l,igcm_dust_mass)
+     &               *  (pplev(ig,l) - pplev(ig,l+1)) / g
+       enddo
+      enddo
+c AUTOMATICALLY GENERATED FROM REGISTRY
+#include "fill_save.inc"
+#else
+
+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)
+!         call WRITEDIAGFI(ngrid,"pplay","Pressure","Pa",3,zplay)
+!         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)
+
+c         call WRITEDIAGFI(ngrid,"temp7","temperature in layer 7",
+c     &                  "K",2,zt(1,7))
+c         call WRITEDIAGFI(ngrid,"fluxsurf_lw","fluxsurf_lw","W.m-2",2,
+c     &                  fluxsurf_lw)
+c         call WRITEDIAGFI(ngrid,"fluxsurf_sw","fluxsurf_sw","W.m-2",2,
+c     &                  fluxsurf_sw_tot)
+c         call WRITEDIAGFI(ngrid,"fluxtop_lw","fluxtop_lw","W.m-2",2,
+c     &                  fluxtop_lw)
+c         call WRITEDIAGFI(ngrid,"fluxtop_sw","fluxtop_sw","W.m-2",2,
+c     &                  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)
+!        call WRITEDIAGFI(ngrid,'Teta','T potentielle','K',3,zh)
+c        call WRITEDIAGFI(ngrid,"pressure","Pressure","Pa",3,pplay)
+c        call WRITEDIAGFI(ngrid,"ssurf","Surface stress","N.m-2",2,
+c    &                  zstress)
+c        call WRITEDIAGFI(ngridmx,'sw_htrt','sw heat. rate',
+c    &                   'w.m-2',3,zdtsw)
+c        call WRITEDIAGFI(ngridmx,'lw_htrt','lw heat. rate',
+c    &                   'w.m-2',3,zdtlw)
+c        CALL WRITEDIAGFI(ngridmx,'tauTESap',
+c     &                         'tau abs 825 cm-1',
+c     &                         '',2,tauTES)
+
+#ifdef MESOINI
+        call WRITEDIAGFI(ngrid,"emis","Surface emissivity","w.m-1",2,
+     &                  emis)
+        call WRITEDIAGFI(ngrid,"rho","density","none",3,rho)
+        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,nlayermx
+           do ig=1,ngrid
+             co2col(ig)=co2col(ig)+
+     &                  zq(ig,l,igcm_co2)*(pplev(ig,l)-pplev(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(ngridmx,'q01',noms(igcm_h2o_ice),
+     &                      'kg/kg',3,
+     &                       zq(1:ngridmx,1:nlayermx,igcm_h2o_ice))
+            !!!! watervapor = q02, voir readmeteo.F90
+            call WRITEDIAGFI(ngridmx,'q02',noms(igcm_h2o_vap),
+     &                      'kg/kg',3,
+     &                       zq(1:ngridmx,1:nlayermx,igcm_h2o_vap))
+            !!!! surface waterice qsurf02 (voir readmeteo)
+            call WRITEDIAGFI(ngridmx,'qsurf02','surface tracer',
+     &                      'kg.m-2',2,
+     &                       qsurf(1:ngridmx,igcm_h2o_ice))
+#endif
+
+             CALL WRITEDIAGFI(ngridmx,'mtot',
+     &                       'total mass of water vapor',
+     &                       'kg/m2',2,mtot)
+             CALL WRITEDIAGFI(ngridmx,'icetot',
+     &                       'total mass of water ice',
+     &                       'kg/m2',2,icetot)
+c            vmr=zq(1:ngridmx,1:nlayermx,igcm_h2o_ice)
+c    &                *mugaz/mmol(igcm_h2o_ice)
+c            call WRITEDIAGFI(ngridmx,'vmr_h2oice','h2o ice vmr',
+c    &                       'mol/mol',3,vmr)
+             CALL WRITEDIAGFI(ngridmx,'reffice',
+     &                       'Mean reff',
+     &                       'm',2,rave)
+c            call WRITEDIAGFI(ngridmx,'rice','Ice particle size',
+c    &                       'm',3,rice)
+c            If activice is true, tauTES is computed in aeropacity.F;
+             if (.not.activice) then
+               CALL WRITEDIAGFI(ngridmx,'tauTESap',
+     &                         'tau abs 825 cm-1',
+     &                         '',2,tauTES)
+             endif
+             call WRITEDIAGFI(ngridmx,'h2o_ice_s',
+     &                       'surface h2o_ice',
+     &                       'kg.m-2',2,qsurf(1,igcm_h2o_ice))
+
+            if (caps) then
+             do ig=1,ngridmx
+                if (watercaptag(ig)) watercapflag(ig) = 1
+             enddo
+             CALL WRITEDIAGFI(ngridmx,'watercaptag',
+     &                         'Ice water caps',
+     &                         '',2,watercapflag)
+            endif
+            CALL WRITEDIAGFI(ngridmx,'albedo',
+     &                         'albedo',
+     &                         '',2,albedo(1:ngridmx,1))
+           endif !(water)
+
+
+           if (water.and..not.photochem) then
+             iq=nq
+c            write(str2(1:2),'(i2.2)') iq
+c            call WRITEDIAGFI(ngridmx,'dqs'//str2,'dqscloud',
+c    &                       'kg.m-2',2,zdqscloud(1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqch'//str2,'var chim',
+c    &                       'kg/kg',3,zdqchim(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqd'//str2,'var dif',
+c    &                       'kg/kg',3,zdqdif(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'dqa'//str2,'var adj',
+c    &                       'kg/kg',3,zdqadj(1,1,iq))
+c            call WRITEDIAGFI(ngridmx,'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        ----------------------------------------------------------
+
+c        call WRITEDIAGFI(ngridmx,'tauref',
+c    &                    'Dust ref opt depth','NU',2,tauref)
+
+         if (tracer.and.(dustbin.ne.0)) then
+c          call WRITEDIAGFI(ngridmx,'tau','taudust','SI',2,tau(1,1))
+           if (doubleq) then
+c            call WRITEDIAGFI(ngridmx,'qsurf','qsurf',
+c    &                       'kg.m-2',2,qsurf(1,1))
+c            call WRITEDIAGFI(ngridmx,'Nsurf','N particles',
+c    &                       'N.m-2',2,qsurf(1,2))
+c            call WRITEDIAGFI(ngridmx,'dqsdev','ddevil lift',
+c    &                       'kg.m-2.s-1',2,zdqsdev(1,1))
+c            call WRITEDIAGFI(ngridmx,'dqssed','sedimentation',
+c    &                       'kg.m-2.s-1',2,zdqssed(1,1))
+             call WRITEDIAGFI(ngridmx,'reffdust','reffdust',
+     &                        'm',3,rdust*ref_r0)
+             call WRITEDIAGFI(ngridmx,'dustq','Dust mass mr',
+     &                        'kg/kg',3,pq(1,1,igcm_dust_mass))
+c            call WRITEDIAGFI(ngridmx,'dustN','Dust number',
+c    &                        'part/kg',3,pq(1,1,igcm_dust_number))
+#ifdef MESOINI
+             call WRITEDIAGFI(ngridmx,'dustN','Dust number',
+     &                        'part/kg',3,pq(1,1,igcm_dust_number))
+#endif
+           else
+             do iq=1,dustbin
+               write(str2(1:2),'(i2.2)') iq
+               call WRITEDIAGFI(ngridmx,'q'//str2,'mix. ratio',
+     &                         'kg/kg',3,zq(1,1,iq))
+               call WRITEDIAGFI(ngridmx,'qsurf'//str2,'qsurf',
+     &                         'kg.m-2',2,qsurf(1,iq))
+             end do
+           endif ! (doubleq)
+c          if (submicron) then
+c            call WRITEDIAGFI(ngridmx,'dustsubm','subm mass mr',
+c    &                        'kg/kg',3,pq(1,1,igcm_dust_submicron))
+c          endif ! (submicron)
+         end if  ! (tracer.and.(dustbin.ne.0))
+
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+c        PBL OUTPUS
+c        ----------------------------------------------------------
+c        ----------------------------------------------------------
+
+
+c        ----------------------------------------------------------
+c        Outputs of surface layer
+c        ----------------------------------------------------------
+
+
+         z_out=0.
+         if (calltherm .and. (z_out .gt. 0.)) then
+         call surflayer_interpol(ngrid,nlayer,z0,g,zzlay,zu,zv,wmax_th
+     &              ,tsurf,zh,z_out,Teta_out,u_out,ustar,tstar)
+
+         zu2(:)=sqrt(zu(:,1)*zu(:,1)+zv(:,1)*zv(:,1))
+         call WRITEDIAGFI(ngridmx,'sqrt(zu2)',
+     &              'horizontal velocity norm','m/s',
+     &                         2,zu2)
+
+         call WRITEDIAGFI(ngridmx,'Teta_out',
+     &              'potential temperature at z_out','K',
+     &                         2,Teta_out)
+         call WRITEDIAGFI(ngridmx,'u_out',
+     &              'horizontal velocity norm at z_out','m/s',
+     &                         2,u_out)
+         call WRITEDIAGFI(ngridmx,'u*',
+     &              'friction velocity','m/s',
+     &                         2,ustar)
+         call WRITEDIAGFI(ngridmx,'teta*',
+     &              'friction potential temperature','K',
+     &                         2,tstar)
+         else
+           if((.not. calltherm).and.(z_out .gt. 0.)) then
+            print*, 'WARNING : no interpolation in surface-layer :'
+            print*, 'Outputing surface-layer quantities without thermals
+     & does not make sense'
+           endif
+         endif
+
+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(ngridmx,'lmax_th',
+     &              'hauteur du thermique','K',
+     &                         2,lmax_th_out)
+        call WRITEDIAGFI(ngridmx,'hfmax_th',
+     &              'maximum TH heat flux','K.m/s',
+     &                         2,hfmax_th)
+        call WRITEDIAGFI(ngridmx,'wmax_th',
+     &              'maximum TH vertical velocity','m/s',
+     &                         2,wmax_th)
+
+         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
+
+      ELSE     ! if(ngrid.eq.1)
+
+         print*,'Ls =',zls*180./pi,
+     &  '  tauref(700 Pa) =',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
+
+         z_out=0.
+         if (calltherm .and. (z_out .gt. 0.)) then
+         call surflayer_interpol(ngrid,nlayer,z0,g,zzlay,zu,zv,wmax_th
+     &              ,tsurf,zh,z_out,Teta_out,u_out,ustar,tstar)
+
+         zu2(:)=sqrt(zu(:,1)*zu(:,1)+zv(:,1)*zv(:,1))
+         call WRITEDIAGFI(ngridmx,'sqrt(zu2)',
+     &              'horizontal velocity norm','m/s',
+     &                         0,zu2)
+
+         call WRITEDIAGFI(ngridmx,'Teta_out',
+     &              'potential temperature at z_out','K',
+     &                         0,Teta_out)
+         call WRITEDIAGFI(ngridmx,'u_out',
+     &              'horizontal velocity norm at z_out','m/s',
+     &                         0,u_out)
+         call WRITEDIAGFI(ngridmx,'u*',
+     &              'friction velocity','m/s',
+     &                         0,ustar)
+         call WRITEDIAGFI(ngridmx,'teta*',
+     &              'friction potential temperature','K',
+     &                         0,tstar)
+         else
+           if((.not. calltherm).and.(z_out .gt. 0.)) then
+            print*, 'WARNING : no interpolation in surface-layer :'
+            print*, 'Outputing surface-layer quantities without thermals
+     & does not make sense'
+           endif
+         endif
+
+         if(calltherm) then
+
+        call WRITEDIAGFI(ngridmx,'lmax_th',
+     &              'hauteur du thermique','point',
+     &                         0,lmax_th_out)
+        call WRITEDIAGFI(ngridmx,'hfmax_th',
+     &              'maximum TH heat flux','K.m/s',
+     &                         0,hfmax_th)
+        call WRITEDIAGFI(ngridmx,'wmax_th',
+     &              'maximum TH vertical velocity','m/s',
+     &                         0,wmax_th)
+
+         co2col(:)=0.
+         if (tracer) then
+         do l=1,nlayermx
+           do ig=1,ngrid
+             co2col(ig)=co2col(ig)+
+     &                  zq(ig,l,1)*(pplev(ig,l)-pplev(ig,l+1))/g
+         enddo
+         enddo
+
+         end if
+         call WRITEDIAGFI(ngrid,'co2col','integrated co2 mass'          &
+     &                                      ,'kg/m-2',0,co2col)
+         endif
+         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)
+! or output in diagfi.nc (for testphys1d)
+         call WRITEDIAGFI(ngridmx,'ps','Surface pressure','Pa',0,ps)
+         call WRITEDIAGFI(ngridmx,'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(ngridmx,trim(noms(iq)),
+     &              trim(noms(iq)),'kg/kg',1,zq(1,1,iq))
+            end do
+         end if
+
+         zlocal(1)=-log(pplay(1,1)/pplev(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(pplay(1,l)/pplay(1,l-1))*rnew(1,l)*tmean/g
+         enddo
+         zlocal(nlayer)= zlocal(nlayer-1)-
+     &                   log(pplay(1,nlayer)/pplay(1,nlayer-1))*
+     &                   rnew(1,nlayer)*tmean/g
+
+      END IF       ! if(ngrid.ne.1)
+
+      icount=icount+1
+      RETURN
+      END
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/planete.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/planete.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/planete.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/planete.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/profile.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/profile.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/profile.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/profile.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/readtesassim.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/readtesassim.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/readtesassim.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/readtesassim.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scatter.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scatter.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scatter.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/scatter.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scatterers
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scatterers	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scatterers	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/scatterers
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scopyi.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scopyi.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/scopyi.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/scopyi.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/slope.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/slope.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/slope.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/slope.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/soil.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/soil.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/soil.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/soil.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/soil_settings.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/soil_settings.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/soil_settings.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/soil_settings.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/solang.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/solang.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/solang.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/solang.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/solarlong.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/solarlong.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/solarlong.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/solarlong.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/statto.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/statto.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/statto.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/statto.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/suaer.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/suaer.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/suaer.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/suaer.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/sugwd.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/sugwd.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/sugwd.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/sugwd.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/sulw.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/sulw.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/sulw.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/sulw.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surfdat.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surfdat.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surfdat.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/surfdat.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surfini.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surfini.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surfini.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/surfini.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surflayer_interpol.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surflayer_interpol.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/surflayer_interpol.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/surflayer_interpol.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swmain.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swmain.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swmain.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/swmain.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swr_fouquart.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swr_fouquart.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swr_fouquart.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/swr_fouquart.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swr_toon.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swr_toon.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swr_toon.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/swr_toon.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swrayleigh.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swrayleigh.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/swrayleigh.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/swrayleigh.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/tabfi.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/tabfi.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/tabfi.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/tabfi.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/testphys1d.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/testphys1d.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/testphys1d.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/testphys1d.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/thermcell_dqupdown.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/thermcell_dqupdown.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/thermcell_dqupdown.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/thermcell_dqupdown.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/thermcell_main_mars.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/thermcell_main_mars.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/thermcell_main_mars.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/thermcell_main_mars.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/tracer.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/tracer.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/tracer.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/tracer.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/updatereffrad.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/updatereffrad.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/updatereffrad.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/updatereffrad.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdif_cd.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdif_cd.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdif_cd.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/vdif_cd.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdif_kc.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdif_kc.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdif_kc.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/vdif_kc.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdifc.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdifc.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vdifc.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/vdifc.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vlz_fi.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vlz_fi.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/vlz_fi.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/vlz_fi.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/watercloud.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/watercloud.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/watercloud.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/watercloud.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/watersat.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/watersat.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/watersat.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/watersat.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writediagfi.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writediagfi.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writediagfi.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/writediagfi.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writediagsoil.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writediagsoil.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writediagsoil.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/writediagsoil.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writeg1d.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writeg1d.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/writeg1d.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/writeg1d.F
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/wstats.F90
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/wstats.F90	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/wstats.F90	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/wstats.F90
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yoegwd.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yoegwd.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yoegwd.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/yoegwd.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yomaer.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yomaer.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yomaer.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/yomaer.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yomlw.h
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yomlw.h	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/yomlw.h	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/yomlw.h
Index: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/zerophys.F
===================================================================
--- trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/zerophys.F	(revision 308)
+++ trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/mars_lmd_new_storm/libf/phymars/zerophys.F	(revision 308)
@@ -0,0 +1,1 @@
+link ../../../mars_lmd_new/libf/phymars/zerophys.F