Index: /trunk/mars/libf/phymars/meso_callkeys.h
===================================================================
--- /trunk/mars/libf/phymars/meso_callkeys.h	(revision 47)
+++ /trunk/mars/libf/phymars/meso_callkeys.h	(revision 47)
@@ -0,0 +1,57 @@
+!
+! For Fortran 77/Fortran 90 compliance always use line continuation
+! symbols '&' in columns 73 and 6
+!
+! NB: to keep commons aligned, it is better to split them in groups
+!     of given types (logical, integer, real, ...)
+
+      COMMON/callkeys_l/callrad,calldifv,calladj,callcond,callsoil      &
+     &   ,season,diurnal,lwrite,calllott,callstats,calleofdump          &
+     &   ,callnirco2,callnlte,callthermos,callconduct,calleuv           &
+     &   ,callmolvis,callmoldiff,thermochem,thermoswater,callemis       &
+     &   ,callg2d,linear,rayleigh,tracer,active,doubleq,submicron       &
+     &   ,lifting,callddevil,scavenging,sedimentation,activice,water    &
+     &   ,caps,photochem
+     
+      COMMON/callkeys_i/iradia,iaervar,iddist,ilwd,ilwb,ilwn,ncouche    &
+     &   ,dustbin,nqchem_min
+     
+      COMMON/callkeys_r/topdustref,solarcondate,semi,alphan
+     
+      LOGICAL callrad,calldifv,calladj,callcond,callsoil,               &
+     &   season,diurnal,lwrite,calllott                                 &
+     &   ,callstats,calleofdump                                         &
+     &   ,callnirco2,callnlte,callthermos,callconduct,                  &
+     &    calleuv,callmolvis,callmoldiff,thermochem,thermoswater
+
+
+      logical callemis
+      logical callg2d
+      logical linear
+
+      real topdustref
+      real semi
+      real alphan
+      real solarcondate
+
+      integer ecri_phys
+      integer iddist
+      integer iaervar
+      integer iradia
+      integer ilwd
+      integer ilwb
+      integer ilwn
+      integer ncouche
+
+      logical rayleigh
+      logical tracer
+      integer dustbin
+      logical active,doubleq,submicron,lifting,callddevil,scavenging
+      logical sedimentation,activice,water,caps
+      logical photochem
+      integer nqchem_min
+
+      integer swrtype ! type of short wave (solar wavelength) radiative
+      ! transfer to use 1: Fouquart 2: Toon.
+      parameter (swrtype=2)
+!      parameter (swrtype=2)
Index: /trunk/mars/libf/phymars/meso_dimphys.h_ref
===================================================================
--- /trunk/mars/libf/phymars/meso_dimphys.h_ref	(revision 47)
+++ /trunk/mars/libf/phymars/meso_dimphys.h_ref	(revision 47)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+!   INCLUDE 'dimphys.h'
+
+
+         INTEGER, parameter :: wiim=--xsize--
+         INTEGER, parameter :: wjjm=--ysize--
+         INTEGER, PARAMETER :: ngridmx=--physize--
+         INTEGER, parameter :: nlayermx=--zsize--
+         INTEGER, PARAMETER :: nsoilmx=--soilsize--
+	
+!-----------------------------------------------------------------------
+
+	 
Index: /trunk/mars/libf/phymars/meso_inifis.F
===================================================================
--- /trunk/mars/libf/phymars/meso_inifis.F	(revision 47)
+++ /trunk/mars/libf/phymars/meso_inifis.F	(revision 47)
@@ -0,0 +1,809 @@
+      SUBROUTINE meso_inifis(ngrid,nlayer,nq,
+     $           wdt,
+     $           wday_ini,wdaysec,
+     $           wappel_phys,wecri_phys,
+     $           plat,plon,parea,
+     $           prad,pg,pr,pcpp,
+     $           womeg,wmugaz,
+     $           wyear_day,wperiheli,waphelie,wperi_day,wobliquit, 
+     $           wz0,wemin_turb,wlmixmin,
+     $           wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS, 
+     $           wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,
+     $           walbedodat,wphisfi,wvolcapa, 
+     $           wzmea,wzstd,wzsig,wzgam,wzthe,
+     $           wtheta,wpsi)
+
+c=======================================================================    
+c                                                                           
+c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!                  
+c                                                                           
+c       ... CHECK THE ****WRF lines                                         
+c                                                                           
+c=======================================================================  
+!
+!=======================================================================
+!
+!   purpose:
+!   -------
+!
+!   Initialisation for the physical parametrisations of the LMD 
+!   martian atmospheric general circulation modele.
+!
+!   author: Frederic Hourdin 15 / 10 /93
+!   -------
+!   modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
+!             Ehouarn Millour (oct. 2008) tracers are now identified
+!              by their names and may not be contiguously
+!              stored in the q(:,:,:,:) array
+!             E.M. (june 2009) use getin routine to load parameters
+!             adapted to the WRF use - Aymeric Spiga - Jan 2009 - Jan 2007
+!
+!
+!   arguments:
+!   ----------
+!
+!   input:
+!   ------
+!
+!    ngrid                 Size of the horizontal grid.
+!                          All internal loops are performed on that grid.
+!    nlayer                Number of vertical layers.
+!    pdayref               Day of reference for the simulation
+!    pday                  Number of days counted from the North. Spring
+!                          equinoxe.
+!
+!=======================================================================
+!
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+! to use  'getin'
+!! **WRF a new stuff to be checked
+      USE ioipsl_getincom 
+      IMPLICIT NONE
+#include "dimensions.h"
+#include "dimphys.h"
+#include "planete.h"
+#include "comcstfi.h"
+#include "comsaison.h"
+#include "comdiurn.h"
+#include "comgeomfi.h"
+#include "callkeys.h"
+#include "surfdat.h"
+#include "dimradmars.h"  !!new
+#include "yomaer.h"      !!new -- prob. pour remplir les proprietes
+#include "datafile.h"
+#include "meso_slope.h"
+#include "comsoil.h"     !!**WRF -- needed to fill volcapa
+
+      REAL prad,pg,pr,pcpp,pdaysec
+ 
+      INTEGER ngrid,nlayer,nq
+
+      REAL womeg,wmugaz,wdaysec
+      REAL wyear_day,wperiheli,waphelie,wperi_day,wobliquit
+      REAL wz0,wemin_turb,wlmixmin
+      REAL wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS
+
+      REAL wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS
+      REAL walbedodat(ngrid),wphisfi(ngrid)
+      REAL wzmea(ngrid),wzstd(ngrid),wzsig(ngrid)
+      REAL wzgam(ngrid),wzthe(ngrid)
+      REAL wtheta(ngrid),wpsi(ngrid)
+      REAL wvolcapa
+      REAL wdt
+
+      REAL plat(ngrid),plon(ngrid),parea(ngridmx)
+      integer wday_ini
+      INTEGER ig,ierr
+
+      INTEGER wecri_phys, wappel_phys
+ 
+!      EXTERNAL iniorbit,orbite
+      EXTERNAL SSUM
+      REAL SSUM
+ 
+      CHARACTER ch1*12
+      CHARACTER ch80*80
+
+!      logical chem, h2o
+
+!      chem = .false.
+!      h2o = .false.
+
+c ****WRF
+c
+c------------------------------------------------------
+c  Fill some parameters in the 'include' files
+c  >> Do part of the job previously done by phyetat0.F
+c  >> Complete list of parameters is found in tabfi.F
+c------------------------------------------------------
+c
+c Values are defined in the module_model_constants.F WRF routine
+c      
+      ! in 'comcstfi.h'
+      rad=prad                  
+      cpp=pcpp
+      g=pg
+      r=pr
+      rcp=r/cpp
+      daysec=wdaysec  
+      omeg=womeg                
+      mugaz=wmugaz  
+      print*,"check: rad,cpp,g,r,rcp,daysec,omeg,mugaz"
+      print*,rad,cpp,g,r,rcp,daysec,omeg,mugaz
+    
+      ! in 'planet.h' 
+      year_day=wyear_day
+      periheli=wperiheli
+      aphelie=waphelie
+      peri_day=wperi_day
+      obliquit=wobliquit
+      z0=wz0
+      emin_turb=wemin_turb
+      lmixmin=wlmixmin
+      print*,"check: year_day,periheli,aphelie,peri_day,obliquit"
+      print*,year_day,periheli,aphelie,peri_day,obliquit
+      print*,"check: z0,emin_turb,lmixmin"
+      print*,z0,emin_turb,lmixmin
+
+      ! in 'surfdat.h'
+      emissiv=wemissiv
+      emisice(1)=wemissiceN
+      emisice(2)=wemissiceS
+      albedice(1)=walbediceN
+      albedice(2)=walbediceS
+      iceradius(1)=wiceradiusN
+      iceradius(2)=wiceradiusS
+      dtemisice(1)=wdtemisiceN
+      dtemisice(2)=wdtemisiceS
+      print*,"check: emissiv,emisice,albedice,iceradius,dtemisice"
+      print*,emissiv,emisice,albedice,iceradius,dtemisice
+
+c
+c Values are defined in the WPS processing
+c  
+        albedodat(:)=walbedodat(:)
+        !!!!! ***WRF inertiedat was moved, new physics !!
+        !inertiedat(:)=winertiedat(:)
+        phisfi(:)=wphisfi(:)
+        print*,"check: albedodat(1),phisfi(1)"
+        print*,albedodat(1),phisfi(1)
+        print*,"check: albedodat(end),phisfi(end)"
+        print*,albedodat(ngrid),phisfi(ngrid)
+
+        ! NB: usually, gravity wave scheme is useless in mesoscale modeling
+        ! NB: we however keep the option for coarse grid case ... 	
+        zmea(:)=wzmea(:)
+        zstd(:)=wzstd(:)
+        zsig(:)=wzsig(:)
+        zgam(:)=wzgam(:)
+        zthe(:)=wzthe(:)
+        print*,"check: gw param"
+        print*,zmea(1),zmea(ngrid)
+        print*,zstd(1),zstd(ngrid)
+        print*,zsig(1),zsig(ngrid)
+        print*,zgam(1),zgam(ngrid)
+        print*,zthe(1),zthe(ngrid)
+
+        !
+        ! in meso_slope.h
+        !
+        theta_sl(:)=wtheta(:)
+        psi_sl(:)=wpsi(:)
+        print*,"check: theta_sl(1),psi_sl(1)"
+        print*,theta_sl(1),psi_sl(1)
+        print*,"check: theta_sl(end),psi_sl(end)"
+        print*,theta_sl(ngrid),psi_sl(ngrid)
+
+        !
+        ! in comsoil.h
+        !
+        volcapa=wvolcapa
+        print*,"check: volcapa"
+        print*,volcapa 
+
+
+c ****WRF
+     
+
+!      rad=prad
+!      daysec=pdaysec
+!      dtphys=ptimestep
+!      cpp=pcpp
+!      g=pg
+!      r=pr
+!      rcp=r/cpp
+
+! --------------------------------------------------------
+!     The usual Tests
+!     --------------
+      IF (nlayer.NE.nlayermx) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'nlayer     = ',nlayer
+         PRINT*,'nlayermx   = ',nlayermx
+         STOP
+      ENDIF
+
+      IF (ngrid.NE.ngridmx) THEN
+         PRINT*,'STOP in inifis'
+         PRINT*,'Probleme de dimensions :'
+         PRINT*,'ngrid     = ',ngrid
+         PRINT*,'ngridmx   = ',ngridmx
+         STOP
+      ENDIF
+
+! --------------------------------------------------------------
+!  Reading the "callphys.def" file controlling some key options
+! --------------------------------------------------------------
+     
+      ! check that 'callphys.def' file is around
+      OPEN(99,file='callphys.def',status='old',form='formatted'
+     &     ,iostat=ierr)
+      CLOSE(99)
+      
+      IF(ierr.EQ.0) THEN
+         PRINT*
+         PRINT*
+         PRINT*,'--------------------------------------------'
+         PRINT*,' inifis: Parameters for the physics (callphys.def)'
+         PRINT*,'--------------------------------------------'
+
+         write(*,*) "Directory where external input files are:"
+         ! NB: default 'datafile' is set in datafile.h
+         call getin("datadir",datafile)
+         write(*,*) " datafile = ",trim(datafile)
+
+         write(*,*) "Run with or without tracer transport ?"
+         tracer=.false. ! default value
+         call getin("tracer",tracer)
+         write(*,*) " tracer = ",tracer
+
+         write(*,*) "Diurnal cycle ?"
+         write(*,*) "(if diurnal=False, diurnal averaged solar heating)"
+         diurnal=.true. ! default value
+         call getin("diurnal",diurnal)
+         write(*,*) " diurnal = ",diurnal
+
+         write(*,*) "Seasonal cycle ?"
+         write(*,*) "(if season=False, Ls stays constant, to value ",
+     &   "set in 'start'"
+         season=.true. ! default value
+         call getin("season",season)
+         write(*,*) " season = ",season
+
+         write(*,*) "Write some extra output to the screen ?"
+         lwrite=.false. ! default value
+         call getin("lwrite",lwrite)
+         write(*,*) " lwrite = ",lwrite
+
+         write(*,*) "Save statistics in file stats.nc ?"
+         !callstats=.true. ! default value
+         callstats=.false. ! default value
+         call getin("callstats",callstats)
+         write(*,*) " callstats = ",callstats
+
+         write(*,*) "Save EOF profiles in file 'profiles' for ",
+     &              "Climate Database?"
+         calleofdump=.false. ! default value
+         call getin("calleofdump",calleofdump)
+         write(*,*) " calleofdump = ",calleofdump
+
+         write(*,*) "Dust scenario: 1=constant dust (read from startfi",
+     &   " or set as tauvis); 2=Viking scenario; =3 MGS scenario,",
+     &   "=4 Mars Year 24 from TES assimilation, ",
+     &   "=24,25 or 26 :Mars Year 24,25 or 26 from TES assimilation"
+         iaervar=3 ! default value
+         call getin("iaervar",iaervar)
+         write(*,*) " iaervar = ",iaervar
+
+         write(*,*) "Reference (visible) dust opacity at 700 Pa ",
+     &   "(matters only if iaervar=1)"
+         ! NB: default value of tauvis is set/read in startfi.nc file
+         call getin("tauvis",tauvis)
+         write(*,*) " tauvis = ",tauvis
+
+         write(*,*) "Dust vertical distribution:"
+         write(*,*) "(=1 top set by topdustref parameter;",
+     & " =2 Viking scenario; =3 MGS scenario)"
+         iddist=3 ! default value
+         call getin("iddist",iddist)
+         write(*,*) " iddist = ",iddist
+
+         write(*,*) "Dust top altitude (km). (Matters only if iddist=1)"
+         topdustref= 90.0 ! default value
+         call getin("topdustref",topdustref)
+         write(*,*) " topdustref = ",topdustref
+
+         write(*,*) "call radiative transfer ?"
+         callrad=.true. ! default value
+         call getin("callrad",callrad)
+         write(*,*) " callrad = ",callrad
+
+         write(*,*) "call NLTE radiative schemes ?",
+     &              "(matters only if callrad=T)"
+         callnlte=.false. ! default value
+         call getin("callnlte",callnlte)
+         write(*,*) " callnlte = ",callnlte
+         
+         write(*,*) "call CO2 NIR absorption ?",
+     &              "(matters only if callrad=T)"
+         callnirco2=.false. ! default value
+         call getin("callnirco2",callnirco2)
+         write(*,*) " callnirco2 = ",callnirco2
+         
+         write(*,*) "call turbulent vertical diffusion ?"
+         calldifv=.true. ! default value
+         call getin("calldifv",calldifv)
+         write(*,*) " calldifv = ",calldifv
+
+         write(*,*) "call convective adjustment ?"
+         calladj=.true. ! default value
+         call getin("calladj",calladj)
+         write(*,*) " calladj = ",calladj
+         
+
+         write(*,*) "call CO2 condensation ?"
+         callcond=.true. ! default value
+         call getin("callcond",callcond)
+         write(*,*) " callcond = ",callcond
+
+         write(*,*)"call thermal conduction in the soil ?"
+         callsoil=.true. ! default value
+         call getin("callsoil",callsoil)
+         write(*,*) " callsoil = ",callsoil
+         
+
+         write(*,*)"call Lott's gravity wave/subgrid topography ",
+     &             "scheme ?"
+         calllott=.true. ! default value
+         call getin("calllott",calllott)
+         write(*,*)" calllott = ",calllott
+
+
+         write(*,*)"rad.transfer is computed every iradia",
+     &             " physical timestep"
+         iradia=1 ! default value
+         call getin("iradia",iradia)
+         write(*,*)" iradia = ",iradia
+         
+
+         write(*,*)"Output of the exchange coefficient mattrix ?",
+     &             "(for diagnostics only)"
+         callg2d=.false. ! default value
+         call getin("callg2d",callg2d)
+         write(*,*)" callg2d = ",callg2d
+
+         write(*,*)"Rayleigh scattering : (should be .false. for now)"
+         rayleigh=.false.
+         call getin("rayleigh",rayleigh)
+         write(*,*)" rayleigh = ",rayleigh
+
+
+! TRACERS:
+
+         write(*,*)"Transported dust ? (if >0, use 'dustbin' dust bins)"
+         dustbin=0 ! default value
+         call getin("dustbin",dustbin)
+         write(*,*)" dustbin = ",dustbin
+
+         write(*,*)"Radiatively active dust ? (matters if dustbin>0)"
+         active=.false. ! default value
+         call getin("active",active)
+         write(*,*)" active = ",active
+
+! Test of incompatibility:
+! if active is used, then dustbin should be > 0
+
+         if (active.and.(dustbin.lt.1)) then
+           print*,'if active is used, then dustbin should > 0'
+           stop
+         endif
+
+         write(*,*)"use mass and number mixing ratios to predict",
+     &             " dust size ?"
+         doubleq=.false. ! default value
+         call getin("doubleq",doubleq)
+         write(*,*)" doubleq = ",doubleq
+
+         submicron=.false. ! default value
+         call getin("submicron",submicron)
+         write(*,*)" submicron = ",submicron
+
+! Test of incompatibility:
+! if doubleq is used, then dustbin should be 2
+
+         if (doubleq.and.(dustbin.ne.2)) then
+           print*,'if doubleq is used, then dustbin should be 2'
+           stop
+         endif
+         if (doubleq.and.submicron.and.(nqmx.LT.3)) then
+           print*,'If doubleq is used with a submicron tracer,'
+           print*,' then the number of tracers has to be'
+           print*,' larger than 3.'
+           stop
+         endif
+
+         write(*,*)"dust lifted by GCM surface winds ?"
+         lifting=.false. ! default value
+         call getin("lifting",lifting)
+         write(*,*)" lifting = ",lifting
+
+! Test of incompatibility:
+! if lifting is used, then dustbin should be > 0
+
+         if (lifting.and.(dustbin.lt.1)) then
+           print*,'if lifting is used, then dustbin should > 0'
+           stop
+         endif
+
+         write(*,*)" dust lifted by dust devils ?"
+         callddevil=.false. !default value
+         call getin("callddevil",callddevil)
+         write(*,*)" callddevil = ",callddevil
+         
+
+! Test of incompatibility:
+! if dustdevil is used, then dustbin should be > 0
+
+         if (callddevil.and.(dustbin.lt.1)) then
+           print*,'if dustdevil is used, then dustbin should > 0'
+           stop
+         endif
+
+         write(*,*)"Dust scavenging by CO2 snowfall ?"
+         scavenging=.false. ! default value
+         call getin("scavenging",scavenging)
+         write(*,*)" scavenging = ",scavenging
+         
+
+! Test of incompatibility:
+! if scavenging is used, then dustbin should be > 0
+
+         if (scavenging.and.(dustbin.lt.1)) then
+           print*,'if scavenging is used, then dustbin should > 0'
+           stop
+         endif
+
+         write(*,*) "Gravitationnal sedimentation ?"
+         sedimentation=.true. ! default value
+         call getin("sedimentation",sedimentation)
+         write(*,*) " sedimentation = ",sedimentation
+
+         write(*,*) "Radiatively active transported atmospheric ",
+     &              "water ice ?"
+         activice=.false. ! default value
+         call getin("activice",activice)
+         write(*,*) " activice = ",activice
+
+         write(*,*) "Compute water cycle ?"
+         water=.false. ! default value
+         call getin("water",water)
+         write(*,*) " water = ",water
+
+! Test of incompatibility:
+
+         if (activice.and..not.water) then
+           print*,'if activice is used, water should be used too'
+           stop
+         endif
+
+         if (water.and..not.tracer) then
+           print*,'if water is used, tracer should be used too'
+           stop
+         endif
+
+! Test of incompatibility:
+
+         write(*,*) "Permanent water caps at poles ?",
+     &               " .true. is RECOMMENDED"
+         write(*,*) "(with .true., North cap is a source of water ",
+     &   "and South pole is a cold trap)"
+         caps=.true. ! default value
+         call getin("caps",caps)
+         write(*,*) " caps = ",caps
+
+         write(*,*) "photochemistry: include chemical species"
+         photochem=.false. ! default value
+         call getin("photochem",photochem)
+         write(*,*) " photochem = ",photochem
+
+
+! THERMOSPHERE
+
+         write(*,*) "call thermosphere ?"
+         callthermos=.false. ! default value
+         call getin("callthermos",callthermos)
+         write(*,*) " callthermos = ",callthermos
+         
+
+         write(*,*) " water included without cycle ",
+     &              "(only if water=.false.)"
+         thermoswater=.false. ! default value
+         call getin("thermoswater",thermoswater)
+         write(*,*) " thermoswater = ",thermoswater
+
+         write(*,*) "call thermal conduction ?",
+     &    " (only if callthermos=.true.)"
+         callconduct=.false. ! default value
+         call getin("callconduct",callconduct)
+         write(*,*) " callconduct = ",callconduct
+
+         write(*,*) "call EUV heating ?",
+     &   " (only if callthermos=.true.)"
+         calleuv=.false.  ! default value
+         call getin("calleuv",calleuv)
+         write(*,*) " calleuv = ",calleuv
+
+         write(*,*) "call molecular viscosity ?",
+     &   " (only if callthermos=.true.)"
+         callmolvis=.false. ! default value
+         call getin("callmolvis",callmolvis)
+         write(*,*) " callmolvis = ",callmolvis
+
+         write(*,*) "call molecular diffusion ?",
+     &   " (only if callthermos=.true.)"
+         callmoldiff=.false. ! default value
+         call getin("callmoldiff",callmoldiff)
+         write(*,*) " callmoldiff = ",callmoldiff
+         
+
+         write(*,*) "call thermospheric photochemistry ?",
+     &   " (only if callthermos=.true.)"
+         thermochem=.false. ! default value
+         call getin("thermochem",thermochem)
+         write(*,*) " thermochem = ",thermochem
+
+         write(*,*) "date for solar flux calculation:",
+     &   " (1985 < date < 2002)"
+         write(*,*) "(Solar min=1996.4 ave=1993.4 max=1990.6)"
+         solarcondate=1993.4 ! default value
+         call getin("solarcondate",solarcondate)
+         write(*,*) " solarcondate = ",solarcondate
+         
+
+         if (.not.callthermos) then
+           if (thermoswater) then
+             print*,'if thermoswater is set, callthermos must be true'
+             stop
+           endif          
+           if (callconduct) then
+             print*,'if callconduct is set, callthermos must be true'
+             stop
+           endif        
+           if (calleuv) then
+             print*,'if calleuv is set, callthermos must be true'
+             stop
+           endif         
+           if (callmolvis) then
+             print*,'if callmolvis is set, callthermos must be true'
+             stop
+           endif        
+           if (callmoldiff) then
+             print*,'if callmoldiff is set, callthermos must be true'
+             stop
+           endif          
+           if (thermochem) then
+             print*,'if thermochem is set, callthermos must be true'
+             stop
+           endif          
+        endif
+
+! Test of incompatibility:
+! if photochem is used, then water should be used too
+
+         if (photochem.and..not.water) then
+           print*,'if photochem is used, water should be used too'
+           stop
+         endif
+
+! if callthermos is used, then thermoswater should be used too 
+! (if water not used already)
+
+         if (callthermos .and. .not.water) then
+           if (callthermos .and. .not.thermoswater) then
+             print*,'if callthermos is used, water or thermoswater 
+     &               should be used too'
+             stop
+           endif
+         endif
+
+         PRINT*,'--------------------------------------------'
+         PRINT*
+         PRINT*
+      ELSE
+         write(*,*)
+         write(*,*) 'Cannot read file callphys.def. Is it here ?'
+         stop
+      ENDIF
+
+8000  FORMAT(t5,a12,l8)
+8001  FORMAT(t5,a12,i8)
+
+
+
+c ****WRF
+c*****************************************************
+c Since it comes from WRF settings, we have to
+c fill dtphys in the include file 
+c It must be set now, because it is used afterwards
+c
+c Opportunity is taken to fill ecri_phys as well
+c*****************************************************
+        dtphys=wdt*float(wappel_phys)
+        print*,'Physical timestep (s) ',dtphys
+        ecri_phys=wecri_phys
+        print*,'Physical frequency for writing ',ecri_phys
+c
+c ****WRF
+
+
+      PRINT*
+      PRINT*,'inifis: daysec',daysec
+      PRINT*
+      PRINT*,'inifis: The radiative transfer is computed:'
+      PRINT*,'           each ',iradia,' physical time-step'
+      PRINT*,'        or each ',iradia*dtphys,' seconds'
+      PRINT*
+! --------------------------------------------------------------
+!  Managing the Longwave radiative transfer
+! --------------------------------------------------------------
+
+!     In most cases, the run just use the following values :
+!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      callemis=.true.     
+!     ilwd=10*int(daysec/dtphys) ! bug before 22/10/01       
+      ilwd=1
+      ilwn=1 !2
+      ilwb=1 !2
+      linear=.true.        
+      ncouche=3
+      alphan=0.4
+      semi=0
+
+!     BUT people working hard on the LW may want to read them in 'radia.def' 
+!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      OPEN(99,file='radia.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+      IF(ierr.EQ.0) THEN
+         write(*,*) 'inifis: Reading radia.def !!!'
+         READ(99,fmt='(a)') ch1
+         READ(99,*) callemis
+         WRITE(*,8000) ch1,callemis
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) iradia
+         WRITE(*,8001) ch1,iradia
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ilwd
+         WRITE(*,8001) ch1,ilwd
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ilwn
+         WRITE(*,8001) ch1,ilwn
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) linear
+         WRITE(*,8000) ch1,linear
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ncouche
+         WRITE(*,8001) ch1,ncouche
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) alphan
+         WRITE(*,*) ch1,alphan
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) ilwb
+         WRITE(*,8001) ch1,ilwb
+
+
+         READ(99,fmt='(a)') ch1
+         READ(99,'(l1)') callg2d
+         WRITE(*,8000) ch1,callg2d
+
+         READ(99,fmt='(a)') ch1
+         READ(99,*) semi
+         WRITE(*,*) ch1,semi
+      end if
+      CLOSE(99)
+
+!-----------------------------------------------------------------------
+!     Some more initialization:
+!     ------------------------
+
+      ! in 'comgeomfi.h' 
+      CALL SCOPY(ngrid,plon,1,long,1)
+      CALL SCOPY(ngrid,plat,1,lati,1)
+      CALL SCOPY(ngrid,parea,1,area,1)
+      totarea=SSUM(ngridmx,area,1)
+
+      ! in 'comdiurn.h'
+      DO ig=1,ngrid
+         sinlat(ig)=sin(plat(ig))
+         coslat(ig)=cos(plat(ig))
+         sinlon(ig)=sin(plon(ig))
+         coslon(ig)=cos(plon(ig))
+      ENDDO
+
+      pi=2.*asin(1.) ! NB: pi is a common in comcstfi.h
+
+!     managing the tracers, and tests:
+!     -------------------------------
+!     Ehouarn: removed; as these tests are now done in initracer.F
+!      if(tracer) then
+!
+!!          when photochem is used, nqchem_min is the rank
+!!          of the first chemical species
+!
+!! Ehouarn: nqchem_min is now meaningless and no longer used
+!!       nqchem_min = 1
+!       if (photochem .or. callthermos) then
+!         chem = .true.
+!       end if
+!
+!       if (water .or. thermoswater) h2o = .true.
+!
+!!          TESTS
+!
+!       print*,'inifis: TRACERS:'
+!       write(*,*) "    chem=",chem,"    h2o=",h2o
+!!       write(*,*) "   doubleq=",doubleq
+!!       write(*,*) "   dustbin=",dustbin
+!
+!       if ((doubleq).and.(h2o).and.
+!     $     (chem)) then
+!         print*,' 2 dust tracers (doubleq)'
+!         print*,' 1 water vapour tracer'
+!         print*,' 1 water ice tracer'
+!         print*,nqmx-4,' chemistry tracers'
+!       endif
+!
+!       if ((doubleq).and.(h2o).and.
+!     $     .not.(chem)) then
+!         print*,' 2 dust tracers (doubleq)'
+!         print*,' 1 water vapour tracer'
+!         print*,' 1 water ice tracer'
+!         if (nqmx.LT.4) then
+!           print*,'nqmx should be at least equal to'
+!           print*,'4 with these options.'
+!           stop
+!         endif
+!       endif
+!
+!       if (.not.(doubleq).and.(h2o).and.
+!     $     (chem)) then
+!         if (dustbin.gt.0) then
+!           print*,dustbin,' dust bins'
+!         endif
+!         print*,nqmx-2-dustbin,' chemistry tracers'
+!         print*,' 1 water vapour tracer'
+!         print*,' 1 water ice tracer'
+!       endif
+!
+!       if (.not.(doubleq).and.(h2o).and.
+!     $     .not.(chem)) then
+!         if (dustbin.gt.0) then
+!           print*,dustbin,' dust bins'
+!         endif
+!         print*,' 1 water vapour tracer'
+!         print*,' 1 water ice tracer'
+!         if (nqmx.gt.(dustbin+2)) then
+!           print*,'nqmx should be ',(dustbin+2),
+!     $            ' with these options...'
+!		   print*,'(or check callphys.def)'
+!         endif
+!         if (nqmx.lt.(dustbin+2)) then
+!           write(*,*) "inifis: nqmx.lt.(dustbin+2)"
+!           stop
+!         endif
+!       endif
+!
+!      endif ! of if (tracer)
+!
+!      RETURN
+      END
Index: /trunk/mars/libf/phymars/meso_newcondens.F
===================================================================
--- /trunk/mars/libf/phymars/meso_newcondens.F	(revision 47)
+++ /trunk/mars/libf/phymars/meso_newcondens.F	(revision 47)
@@ -0,0 +1,877 @@
+      SUBROUTINE meso_newcondens(ngrid,nlayer,nq,ptimestep,
+     $                  pcapcal,pplay,pplev,ptsrf,pt,
+     $                  pphi,pdt,pdu,pdv,pdtsrf,pu,pv,pq,pdq,
+     $                  piceco2,psolaralb,pemisurf,
+     $                  pdtc,pdtsrfc,pdpsrf,pduc,pdvc,pdqc,
+     $                  fluxsurf_sw,zls)
+                                                   
+       IMPLICIT NONE
+c=======================================================================
+c   subject:
+c   --------
+c   Condensation/sublimation of CO2 ice on the ground and in the
+c   atmosphere 
+c   (Scheme described in Forget et al., Icarus, 1998)
+c
+c   author:   Francois Forget     1994-1996
+c   ------
+c
+c   input:
+c   ----- 
+c    ngrid                 nombre de points de verticales
+c                          (toutes les boucles de la physique sont au
+c                          moins vectorisees sur ngrid)
+c    nlayer                nombre de couches
+c    pplay(ngrid,nlayer)   Pressure levels 
+c    pplev(ngrid,nlayer+1) Pressure levels 
+c    pt(ngrid,nlayer)      temperature (en K)
+c    ptsrf(ngrid)          temperature de surface
+c 
+c                    \
+c    pdt(ngrid,nlayermx)   \  derivee temporelle physique avant condensation
+c                     /  ou sublimation pour  pt,ptsrf
+c    pdtsrf(ngrid)   /
+c
+c   output:
+c   -------
+c
+c    pdpsrf(ngrid)   \  derivee temporelle physique (contribution de
+c    pdtc(ngrid,nlayermx) /  la condensation ou sublimation) pour Ps,pt,ptsrf
+c    pdtsrfc(ngrid) /
+c
+c   Entree/sortie
+c   -------------
+c    
+c    piceco2(ngrid) :      quantite de glace co2 au sol (kg/m2)
+c    psolaralb(ngrid,2) :  albedo au sol
+c    pemisurf(ngrid)     :  emissivite du sol             
+
+c
+c=======================================================================
+c
+c    0.  Declarations :
+c    ------------------
+c
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "surfdat.h"
+#include "comgeomfi.h"
+#include "comvert.h"
+#include "paramet.h"
+#include "callkeys.h"
+#include "tracer.h"
+
+c-----------------------------------------------------------------------
+c    Arguments :
+c    ---------
+      INTEGER ngrid, nlayer, nq
+
+      REAL ptimestep 
+      REAL pplay(ngrid,nlayer),pplev(ngrid,nlayer+1)
+      REAL pcapcal(ngrid)
+      REAL pt(ngrid,nlayer)
+      REAL ptsrf(ngrid)
+      REAL pphi(ngrid,nlayer)
+      REAL pdt(ngrid,nlayer),pdtsrf(ngrid),pdtc(ngrid,nlayer)
+      REAL pdtsrfc(ngrid),pdpsrf(ngrid)
+      REAL piceco2(ngrid),psolaralb(ngrid,2),pemisurf(ngrid)
+
+      REAL pu(ngrid,nlayer) ,  pv(ngrid,nlayer)
+      REAL pdu(ngrid,nlayer) , pdv(ngrid,nlayer)
+      REAL pduc(ngrid,nlayer) , pdvc(ngrid,nlayer)
+      REAL pq(ngridmx,nlayer,nq),pdq(ngrid,nlayer,nq)
+      REAL pdqc(ngrid,nlayer,nq)
+      REAL fluxsurf_sw(ngrid,2) ! added to calculate flux dependent albedo 
+      real zls ! solar longitude (rad)
+c
+c    Local variables :
+c    -----------------
+
+c   variables used for albedo parametrization       
+c --------------------------------------------      
+      INTEGER i,j
+      REAL Fluxmean(jjp1)
+      INTEGER l,ig,iq,icap,nmix
+      LOGICAL transparency, fluxdependent
+c   flag transparency if you want to make the co2ice semi-transparent       
+      PARAMETER(transparency=.true.)
+c   flag fluxdependent if you want the co2ice albedo to be dependent on
+c   the incident solar flux      
+      PARAMETER(fluxdependent=.false.)
+      REAL slopy,alpha,constA,constB,constT,albediceF_new(ngridmx)
+      REAL zt(ngridmx,nlayermx)
+      REAL zcpi
+      REAL ztcond (ngridmx,nlayermx)
+      REAL ztcondsol(ngridmx) 
+      REAL zdiceco2(ngridmx)
+      REAL zcondicea(ngridmx,nlayermx)
+      REAL zcondices(ngridmx)
+      REAL zfallice(ngridmx,nlayermx+1) , zfallheat
+      REAL zmflux(nlayermx+1)
+      REAL zu(nlayermx),zv(nlayermx)
+      REAL zq(nlayermx,nqmx),zq1(nlayermx)
+      REAL ztsrf(ngridmx)
+      REAL ztc(nlayermx), ztm(nlayermx+1) 
+      REAL zum(nlayermx+1) , zvm(nlayermx+1)
+      REAL zqm(nlayermx+1,nqmx),zqm1(nlayermx+1)
+      REAL masse(nlayermx),w(nlayermx+1)
+      REAL Sm(nlayermx),Smq(nlayermx,nqmx),mixmas,qmix
+      LOGICAL condsub(ngridmx)
+
+c variable speciale diagnostique
+      real tconda1(ngridmx,nlayermx)
+      real tconda2(ngridmx,nlayermx)
+c     REAL zdiceco2a(ngridmx) ! for diagnostic only
+      real zdtsig (ngridmx,nlayermx)
+      real zdt (ngridmx,nlayermx)
+      real vmr_co2(ngridmx,nlayermx) ! co2 volume mixing ratio
+! improved_ztcond flag: If set to .true. (AND running with a 'co2' tracer)
+! then condensation temperature is computed using partial pressure of CO2
+      logical,parameter :: improved_ztcond=.true.
+! Bound co2 (tracer) values...
+      logical,parameter :: bound_qco2=.false.
+      real,parameter :: qco2max=1.1
+      real,parameter :: qco2mini=0.1
+      real :: zqco2
+
+c   local saved variables
+      integer ico2
+      real qco2min,qco2,mmean
+      save ico2,qco2min
+      REAL emisref(ngridmx)
+      REAL latcond,tcond1mb
+      REAL acond,bcond,ccond,cpice
+!      REAL albediceF(ngridmx)
+      SAVE emisref
+      SAVE latcond,acond,bcond,ccond,cpice
+!      SAVE albediceF
+      real m_co2, m_noco2, A , B
+      save A, B, m_co2, m_noco2
+
+      LOGICAL firstcall !,firstcall2
+      SAVE firstcall !,firstcall2
+!      REAL SSUM
+!      EXTERNAL SSUM
+
+      DATA latcond,tcond1mb/5.9e5,136.27/
+      DATA cpice /1000./
+      DATA firstcall/.true./
+!      DATA firstcall2/.true./
+
+      integer flag
+
+c----------------------------------------------------------------------
+
+c   Initialisation
+c   --------------
+c
+      IF (firstcall) THEN
+         bcond=1./tcond1mb
+         ccond=cpp/(g*latcond)
+         acond=r/latcond
+
+         firstcall=.false.
+         write(*,*) 'Newcondens: improved_ztcond=',improved_ztcond
+         write(*,*) 'Newcondens: bound_qco2=',bound_qco2
+         PRINT*,'In newcondens:Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
+         PRINT*,'acond,bcond,ccond',acond,bcond,ccond
+
+         ico2=0
+
+         if (tracer) then
+c          Prepare Special treatment if one of the tracer is CO2 gas
+           do iq=1,nqmx
+             if (noms(iq).eq."co2") then
+                ico2=iq
+                m_co2 = 44.01E-3  ! CO2 molecular mass (kg/mol)   
+                m_noco2 = 33.37E-3  ! Non condensible mol mass (kg/mol)   
+c               Compute A and B coefficient use to compute
+c               mean molecular mass Mair defined by
+c               1/Mair = q(ico2)/m_co2 + (1-q(ico2))/m_noco2
+c               1/Mair = A*q(ico2) + B
+                A =(1/m_co2 - 1/m_noco2)
+                B=1/m_noco2
+             endif
+           enddo
+c          minimum CO2 mix. ratio below which mixing occur with layer above: 
+           qco2min =0.75  
+         end if
+      ENDIF
+      zcpi=1./cpp
+c
+c======================================================================
+c    Calcul of CO2 condensation sublimation 
+c    ============================================================
+c  
+c    Used variable :
+c       piceco2(ngrid)   :  amount of co2 ice on the ground (kg/m2)
+c       zcondicea(ngrid,l):  condensation rate in layer  l  (kg/m2/s)
+c       zcondices(ngrid):  condensation rate on the ground (kg/m2/s)
+c       zfallice(ngrid,l):amount of ice falling from layer l (kg/m2/s)
+c                           
+c       pdtc(ngrid,nlayermx)  : dT/dt due to cond/sub
+c
+c
+c     Tendencies set to 0 (except pdtc)
+c     -------------------------------------
+      DO l=1,nlayer
+         DO ig=1,ngrid
+           zcondicea(ig,l) = 0.
+           zfallice(ig,l) = 0.
+           pduc(ig,l)  = 0
+           pdvc(ig,l)  = 0
+         END DO
+      END DO
+         
+      DO iq=1,nqmx         
+      DO l=1,nlayer
+         DO ig=1,ngrid
+           pdqc(ig,l,iq)  = 0
+         END DO
+      END DO
+      END DO
+
+      DO ig=1,ngrid
+         zfallice(ig,nlayer+1) = 0.
+         zcondices(ig) = 0.
+         pdtsrfc(ig) = 0.
+         pdpsrf(ig) = 0.
+         condsub(ig) = .false.
+         zdiceco2(ig) = 0.
+      ENDDO
+      zfallheat=0
+
+c     *************************
+c     ATMOSPHERIC CONDENSATION
+c     *************************
+
+c     Compute CO2 Volume mixing ratio
+c     -------------------------------
+      if (improved_ztcond.and.(ico2.ne.0)) then
+         DO l=1,nlayer
+            DO ig=1,ngrid
+              qco2=pq(ig,l,ico2)+pdq(ig,l,ico2)*ptimestep
+c             Mean air molecular mass = 1/(q(ico2)/m_co2 + (1-q(ico2))/m_noco2)
+              mmean=1/(A*qco2 +B)
+              vmr_co2(ig,l) = qco2*mmean/m_co2 
+            ENDDO
+         ENDDO
+      else
+         DO l=1,nlayer
+            DO ig=1,ngrid
+              vmr_co2(ig,l)=0.95
+            ENDDO
+         ENDDO
+      end if
+
+c     forecast of atmospheric temperature zt and frost temperature ztcond
+c     --------------------------------------------------------------------
+
+      DO l=1,nlayer
+         DO ig=1,ngrid
+            zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
+!            ztcond(ig,l)=1./(bcond-acond*log(.0095*pplay(ig,l)))
+            ztcond(ig,l)=
+     &         1./(bcond-acond*log(.01*vmr_co2(ig,l)*pplay(ig,l)))
+            if (pplay(ig,l).lt.1e-4) ztcond(ig,l)=0.0 !mars Monica
+         ENDDO
+      ENDDO
+ 
+c      Condensation/sublimation in the atmosphere
+c      ------------------------------------------
+c      (calcul of zcondicea , zfallice and pdtc)
+c
+      DO l=nlayer , 1, -1
+         DO ig=1,ngrid
+           pdtc(ig,l)=0.
+           IF((zt(ig,l).LT.ztcond(ig,l)).or.(zfallice(ig,l+1).gt.0))THEN
+               condsub(ig)=.true.
+               IF (zfallice(ig,l+1).gt.0) then  
+                 zfallheat=zfallice(ig,l+1)*
+     &           (pphi(ig,l+1)-pphi(ig,l) +
+     &          cpice*(ztcond(ig,l+1)-ztcond(ig,l)))/latcond
+               ELSE
+                   zfallheat=0.
+               ENDIF
+               pdtc(ig,l)=(ztcond(ig,l) - zt(ig,l))/ptimestep
+               zcondicea(ig,l)=(pplev(ig,l)-pplev(ig,l+1))
+     &                        *ccond*pdtc(ig,l)- zfallheat
+c              Case when the ice from above sublimes entirely
+c              """""""""""""""""""""""""""""""""""""""""""""""
+               IF (zfallice(ig,l+1).lt.- zcondicea(ig,l)) then
+                  pdtc(ig,l)=(-zfallice(ig,l+1)+zfallheat)/
+     &              (ccond*(pplev(ig,l)-pplev(ig,l+1)))
+                  zcondicea(ig,l)= -zfallice(ig,l+1)
+               END IF
+
+               zfallice(ig,l) = zcondicea(ig,l)+zfallice(ig,l+1)
+            END IF
+         ENDDO
+      ENDDO
+
+c     *************************
+c       SURFACE  CONDENSATION
+c     *************************
+
+c     forecast of ground temperature ztsrf and frost temperature ztcondsol
+c     --------------------------------------------------------------------
+      DO ig=1,ngrid
+         ztcondsol(ig)=
+     &          1./(bcond-acond*log(.01*vmr_co2(ig,1)*pplev(ig,1)))
+         ztsrf(ig) = ptsrf(ig) + pdtsrf(ig)*ptimestep
+      ENDDO
+
+c
+c      Condensation/sublimation on the ground 
+c      --------------------------------------
+c      (calcul of zcondices , pdtsrfc)
+c
+      DO ig=1,ngrid
+         IF(ig.GT.ngrid/2+1) THEN
+            icap=2
+         ELSE
+            icap=1
+         ENDIF
+       
+c
+c        Loop on where we have  condensation/ sublimation 
+         IF ((ztsrf(ig) .LT. ztcondsol(ig)) .OR.   ! ground cond 
+     $       (zfallice(ig,1).NE.0.) .OR.           ! falling snow
+     $      ((ztsrf(ig) .GT. ztcondsol(ig)) .AND.  ! ground sublim.
+     $      ((piceco2(ig)+zfallice(ig,1)*ptimestep) .NE. 0.))) THEN
+            condsub(ig) = .true. 
+
+            IF (zfallice(ig,1).gt.0) then  
+                 zfallheat=zfallice(ig,1)*
+     &           (pphi(ig,1)- phisfi(ig) +
+     &           cpice*(ztcond(ig,1)-ztcondsol(ig)))/(latcond*ptimestep)
+            ELSE
+                 zfallheat=0.
+            ENDIF
+
+c           condensation or partial sublimation of CO2 ice
+c           """""""""""""""""""""""""""""""""""""""""""""""
+            zcondices(ig)=pcapcal(ig)*(ztcondsol(ig)-ztsrf(ig)) 
+     &      /(latcond*ptimestep)         - zfallheat
+            pdtsrfc(ig) = (ztcondsol(ig) - ztsrf(ig))/ptimestep
+       
+c           If the entire CO_2 ice layer sublimes
+c           """"""""""""""""""""""""""""""""""""""""""""""""""""
+c           (including what has just condensed in the atmosphere)
+
+            IF((piceco2(ig)/ptimestep+zfallice(ig,1)).LE.
+     &          -zcondices(ig))THEN
+               zcondices(ig) = -piceco2(ig)/ptimestep - zfallice(ig,1) 
+               pdtsrfc(ig)=(latcond/pcapcal(ig))*
+     &         (zcondices(ig)+zfallheat)
+            END IF
+
+c           Changing CO2 ice amount and pressure :
+c           """"""""""""""""""""""""""""""""""""
+
+            zdiceco2(ig) = zcondices(ig) + zfallice(ig,1)
+            piceco2(ig) = piceco2(ig) + zdiceco2(ig)*ptimestep
+            pdpsrf(ig) = -zdiceco2(ig)*g
+
+            IF(ABS(pdpsrf(ig)*ptimestep).GT.pplev(ig,1)) THEN
+               PRINT*,'STOP in condens'
+               PRINT*,'condensing more than total mass'
+               PRINT*,'Grid point ',ig
+               PRINT*,'Ps = ',pplev(ig,1)
+               PRINT*,'d Ps = ',pdpsrf(ig)
+               STOP
+            ENDIF
+         END IF ! if there is condensation/sublimmation
+      ENDDO ! of DO ig=1,ngrid
+
+c  ********************************************************************
+c  Surface albedo and emissivity of the surface below the snow (emisref)
+c  ********************************************************************
+c     Prepare the case where albedo varies with insolation:
+c     ----------------------------------------------------
+!      if (fluxdependent) then
+!
+c       Calcul du flux moyen (zonal mean)
+!        do j=1,jjp1
+!           Fluxmean(j)=0      
+!           do i=1,iim
+!               ig=1+(j-2)*iim +i
+!               if(j.eq.1) ig=1
+!               if(j.eq.jjp1) ig=ngrid
+!               Fluxmean(j)=Fluxmean(j)+fluxsurf_sw(ig,1)
+!     $            +fluxsurf_sw(ig,2)
+!           enddo
+!           Fluxmean(j)=Fluxmean(j)/float(iim)
+!        enddo
+!
+c       const A and B used to calculate the albedo which depends on solar flux 
+c       albedice=constA+constB*Flux
+c       constT = time step to calculate the solar flux when flux decreases         
+!         constA=0.26
+c        constA=0.33
+c        constA=0.186
+!         constB=0.00187
+!         constT=10
+!      endif ! of if (fluxdependent)
+
+!     Check that amont of CO2 ice is not problematic
+      DO ig=1,ngrid
+           if(.not.piceco2(ig).ge.0.) THEN
+              if(piceco2(ig).le.-5.e-8) print*,
+     $         'WARNING newcondens piceco2(',ig,')=', piceco2(ig)
+               piceco2(ig)=0.
+           endif
+      ENDDO
+      
+!     Set albedo and emissivity of the surface
+!     ----------------------------------------
+      CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
+
+c     Calcul de l'albedo
+c     ------------------
+!         do ig =1,ngrid
+!           IF(ig.GT.ngrid/2+1) THEN
+!              icap=2
+!           ELSE
+!              icap=1
+!           ENDIF
+!           IF(firstcall2) THEN
+!           albediceF(ig)=albedice(icap)
+!           ENDIF
+c       if there is still co2ice        ccccccccccccccccccccccc
+!           if (piceco2(ig).gt.0) then
+!              emisref(ig) = emisice(icap)
+
+c     if flux dependent albedo is used 
+c     --------------------------------
+!             if (fluxdependent) then
+!                j=INT((ig-2)/iim)+2
+!                if(ig.eq.1) j=1
+!                if(ig.eq.ngrid) j=jjp1
+c                albediceF_new(ig)=MIN(constA+constB*Fluxmean(j),
+c     $          constA+constB*250)
+!                  albediceF_new(ig)=constA+constB*Fluxmean(j)
+!                if (albediceF(ig).gt.albediceF_new(ig)) then
+!                   albediceF(ig)=albediceF(ig)+ ptimestep/(daysec*
+!     $             constT)*(albediceF_new(ig)-albediceF(ig))
+!                else
+!                   albediceF(ig)=albediceF_new(ig)
+!                endif
+c               if part of the ice is transparent
+c               slopy = pente de la droite:  alpha = y*co2ice/1620
+c               pour une valeur superieur a une epaisseur de glace donnee
+c               ici, epaisseur limite = 10cm
+!                if (transparency) then
+!                slopy=1/(1620*0.10)
+!                alpha=MIN(slopy*piceco2(ig),1.)
+!                psolaralb(ig,1) = alpha*albediceF(ig)
+!     $                           +(1-alpha)*albedodat(ig) 
+!                psolaralb(ig,2) = psolaralb(ig,1) 
+!                else
+!                psolaralb(ig,1) = albediceF(ig) 
+!                psolaralb(ig,2) = psolaralb(ig,1) 
+!                endif
+!             else
+c           transparency set to true and fluxdependent set to false            
+!                if (transparency) then
+!                slopy=1/(1620*0.10)
+!                alpha=MIN(slopy*piceco2(ig),1.)
+!                psolaralb(ig,1) = alpha*albedice(icap)
+!     $                           +(1-alpha)*albedodat(ig) 
+!                psolaralb(ig,2) = psolaralb(ig,1) 
+!                else
+c           simplest case: transparency and flux dependent set to false
+!                psolaralb(ig,1) = albedice(icap)
+!                psolaralb(ig,2) = albedice(icap)
+!                endif
+!             endif    
+c         no more co2ice, albedo = ground albedo
+!           else
+!              psolaralb(ig,1) = albedodat(ig)
+!              psolaralb(ig,2) = albedodat(ig)
+!              emisref(ig) = emissiv
+!              pemisurf(ig) = emissiv
+!           endif
+!         end do ! end of the ig loop
+
+! set pemisurf() to emissiv when there is bare surface (needed for co2snow)
+      DO ig=1,ngrid
+        if (piceco2(ig).eq.0) then
+          pemisurf(ig)=emissiv
+        endif
+      ENDDO
+
+!         firstcall2=.false.
+c ***************************************************************
+c  Correction to account for redistribution between sigma or hybrid 
+c  layers when changing surface pressure (and warming/cooling
+c  of the CO2 currently changing phase).
+c *************************************************************
+
+      DO ig=1,ngrid
+        if (condsub(ig)) then
+           do l=1,nlayer
+             ztc(l)  =zt(ig,l)   +pdtc(ig,l)  *ptimestep
+             zu(l)   =pu(ig,l)   +pdu( ig,l)  *ptimestep
+             zv(l)   =pv(ig,l)   +pdv( ig,l)  *ptimestep
+            do iq=1,nqmx
+             zq(l,iq)=pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep
+            enddo
+           end do
+
+c  Mass fluxes through the sigma levels (kg.m-2.s-1)  (>0 when up)
+c  """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
+
+            zmflux(1) = -zcondices(ig)
+            DO l=1,nlayer
+             zmflux(l+1) = zmflux(l) -zcondicea(ig,l)
+     &        + (bp(l)-bp(l+1))*(zfallice(ig,1)-zmflux(1))
+c zmflux set to 0 if very low to avoid: top layer is disappearing in v1ld  
+          if (abs(zmflux(l+1)).lt.1E-13.OR.bp(l+1).eq.0.) zmflux(l+1)=0.
+            END DO
+
+c Mass of each layer
+c ------------------ 
+            DO l=1,nlayer
+              masse(l)=(pplev(ig,l) - pplev(ig,l+1))/g
+            END DO
+
+
+c  Corresponding fluxes for T,U,V,Q
+c  """"""""""""""""""""""""""""""""
+
+c           averaging operator for TRANSPORT  
+c           """"""""""""""""""""""""""""""""
+c           Value transfert at the surface interface when condensation
+c           sublimation:
+            ztm(1) = ztsrf(ig) + pdtsrfc(ig)*ptimestep
+            zum(1) = 0  
+            zvm(1) = 0  
+            do iq=1,nqmx
+              zqm(1,iq)=0. ! most tracer do not condense !
+            enddo
+c           Special case if one of the tracer is CO2 gas
+            if (ico2.ne.0) zqm(1,ico2)=1. ! flux is 100% CO2
+
+c           Van Leer scheme:
+            DO l=1,nlayer+1
+                w(l)=-zmflux(l)*ptimestep
+            END DO
+            call vl1d(ztc,2.,masse,w,ztm) 
+            call vl1d(zu ,2.,masse,w,zum) 
+            call vl1d(zv ,2.,masse,w,zvm) 
+            do iq=1,nqmx
+             do l=1,nlayer
+              zq1(l)=zq(l,iq)
+             enddo
+             zqm1(1)=zqm(1,iq)
+             call vl1d(zq1,2.,masse,w,zqm1)
+             do l=2,nlayer
+              zq( l,iq)=zq1(l)
+              zqm(l,iq)=zqm1(l)
+             enddo
+            enddo
+
+c           Surface condensation affects low winds
+            if (zmflux(1).lt.0) then 
+                zum(1)= zu(1) *  (w(1)/masse(1))
+                zvm(1)= zv(1) *  (w(1)/masse(1))
+                if (w(1).gt.masse(1)) then ! ensure numerical stability
+                  zum(1)= (zu(1)-zum(2))*masse(1)/w(1) + zum(2)
+                  zvm(1)= (zv(1)-zvm(2))*masse(1)/w(1) + zvm(2)
+                end if
+            end if
+                    
+            ztm(nlayer+1)= ztc(nlayer) ! should not be used, but... 
+            zum(nlayer+1)= zu(nlayer)  ! should not be used, but...
+            zvm(nlayer+1)= zv(nlayer)  ! should not be used, but...
+            do iq=1,nqmx
+             zqm(nlayer+1,iq)= zq(nlayer,iq)
+            enddo
+ 
+CCCC
+CCCC *** WRF comments
+CCCC
+cc           Tendencies on T, U, V, Q 
+cc           """"""""""""""""""""""""
+!            DO l=1,nlayer
+! 
+!c             Tendencies on T
+!                zdtsig(ig,l) = (1/masse(l)) *
+!     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
+!     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
+!     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
+!                pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
+!
+!c             Tendencies on U
+!                pduc(ig,l)   = (1/masse(l)) *
+!     &        ( zmflux(l)*(zum(l) - zu(l))
+!     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
+!
+!
+!c             Tendencies on V
+!                pdvc(ig,l)   = (1/masse(l)) *
+!     &        ( zmflux(l)*(zvm(l) - zv(l))
+!     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
+!
+!            END DO
+
+c           Tendencies on Q
+            do iq=1,nqmx
+!              if (noms(iq).eq.'co2') then 
+              if (iq.eq.ico2) then 
+c               SPECIAL Case when the tracer IS CO2 :
+                DO l=1,nlayer
+                  pdqc(ig,l,iq)= (1/masse(l)) *
+     &           ( zmflux(l)*(zqm(l,iq) - zq(l,iq))
+     &           - zmflux(l+1)*(zqm(l+1,iq) - zq(l,iq)) 
+     &           + zcondicea(ig,l)*(zq(l,iq)-1.) )
+                END DO
+              else
+                DO l=1,nlayer
+                  pdqc(ig,l,iq)= (1/masse(l)) *
+     &           ( zmflux(l)*(zqm(l,iq) - zq(l,iq))
+     &           - zmflux(l+1)*(zqm(l+1,iq) - zq(l,iq)) 
+     &           + zcondicea(ig,l)*zq(l,iq) )
+                END DO
+              end if
+            enddo
+
+c           --------------------------------------------------------
+c           Roughly Simulate Molecular mixing when CO2 is too depleted by
+c           Surface condensation (mixing starts if qco2 < qco2min )  
+c           FF 06/2004
+c           WARNING : this is now done in convadj, better (FF 02/2005)
+c           --------------------------------------------------------
+            flag=0  ! now done in convadj : must be =0
+            if (flag.eq.1) then 
+            if(ico2.gt.0) then   ! relevant only if one tracer is CO2
+             if(pq(ig,1,ico2)+(pdq(ig,1,ico2)+pdqc(ig,1,ico2))*ptimestep
+     &       .lt.qco2min) then 
+                do iq=1,nqmx
+                  zq(1,iq)=pq(ig,1,iq)
+     &                     +(pdq(ig,1,iq)+pdqc(ig,1,iq))*ptimestep
+                  Smq(1,iq) = masse(1)*zq(1,iq)
+                end do
+                Sm(1)  = masse(1)
+                do l =2,nlayermx
+                  do iq=1,nqmx
+                     zq(l,iq)=pq(ig,l,iq)
+     &                        +(pdq(ig,l,iq)+pdqc(ig,l,iq))*ptimestep
+                     smq(l,iq) = smq(l-1,iq) + masse(l)*zq(l,iq)
+                  end do 
+                  sm(l) = sm(l-1) + masse(l)
+                  if(zq(l,ico2).gt.qco2min) then 
+c                   mixmas: mass of atmosphere that must be mixed to reach qco2min
+                    mixmas = (sm(l-1)*zq(l,ico2)-Smq(l-1,ico2))
+     &                      /(zq(l,ico2)-qco2min)
+                    if((mixmas.le.sm(l)))then
+c                      OK if mixed mass less than mass of layers affected
+                       nmix=l   ! number of layer affected by mixing
+                       goto 99 
+                    end if
+                  end if
+                 end do
+ 99              continue 
+                 do iq=1,nqmx
+                   qmix=zq(nmix,iq) 
+     &             +(Smq(nmix-1,iq)-zq(nmix,iq)*Sm(nmix-1))/mixmas
+                   do l=1,nmix-1
+                      pdqc(ig,l,iq)=
+     &                  (qmix-pq(ig,l,iq))/ptimestep - pdq(ig,l,iq)
+                   end do 
+c                  layer only partly mixed :
+                   pdqc(ig,nmix,iq)=(
+     &             qmix+(Sm(nmix)-mixmas)*(zq(nmix,iq)-qmix)/masse(nmix)
+     &             -pq(ig,nmix,iq))/ptimestep -pdq(ig,nmix,iq)
+
+                 end do 
+             end if
+            end if
+
+        endif   ! (flag.eq.1)
+       end if ! if (condsub)
+      END DO  ! loop on ig 
+
+c ***************************************************************
+c   CO2 snow / clouds scheme
+c ***************************************************************
+
+      call co2snow(ngrid,nlayer,ptimestep,emisref,condsub,pplev,
+     &        zcondicea,zcondices,zfallice,pemisurf)
+
+c ***************************************************************
+c Ecriture des diagnostiques
+c ***************************************************************
+
+c     DO l=1,nlayer
+c        DO ig=1,ngrid
+c         Taux de cond en kg.m-2.pa-1.s-1
+c          tconda1(ig,l)=zcondicea(ig,l)/(pplev(ig,l)-pplev(ig,l+1))
+c          Taux de cond en kg.m-3.s-1
+c          tconda2(ig,l)=tconda1(ig,l)*pplay(ig,l)*g/(r*pt(ig,l))
+c        END DO
+c     END DO
+c     call WRITEDIAGFI(ngridmx,'tconda1',
+c    &'Taux de condensation CO2 atmospherique /Pa',
+c    & 'kg.m-2.Pa-1.s-1',3,tconda1)
+c     call WRITEDIAGFI(ngridmx,'tconda2',
+c    &'Taux de condensation CO2 atmospherique /m',
+c    & 'kg.m-3.s-1',3,tconda2)
+
+! output falling co2 ice in 1st layer:
+!      call WRITEDIAGFI(ngridmx,'fallice',
+!     &'Precipitation of co2 ice',
+!     & 'kg.m-2.s-1',2,zfallice(1,1))
+
+!! Specific stuff to bound co2 tracer values ....
+      if (bound_qco2.and.(ico2.ne.0)) then
+        do ig=1,ngridmx
+          do l=1,nlayermx
+            zqco2=pq(ig,l,ico2)
+     &            +(pdq(ig,l,ico2)+pdqc(ig,l,ico2))*ptimestep
+            if (zqco2.gt.qco2max) then
+            ! correct pdqc:
+              pdqc(ig,l,ico2)=((qco2max-pq(ig,l,ico2))/ptimestep)
+     &                               -pdq(ig,l,ico2)
+              write(*,*) "newcondens: adapting pdqc(ig,l,ico2)",
+     &                   " so that co2 conc. does not exceed",qco2max
+              write(*,*) "   ig:",ig,"  l:",l
+            endif ! of if (zqco2.gt.qco2max)
+            if (zqco2.lt.qco2mini) then
+            ! correct pdqc:
+              pdqc(ig,l,ico2)=((qco2mini-pq(ig,l,ico2))/ptimestep)
+     &                               -pdq(ig,l,ico2)
+              write(*,*) "newcondens: adapting pdqc(ig,l,ico2)",
+     &                   " so that co2 conc. is not less than",qco2mini
+              write(*,*) "   ig:",ig,"  l:",l
+            endif ! of if (zqco2.lt.qco2mini)
+          end do 
+        enddo
+      endif ! of if (bound_qco2.and.(ico2.ne.0)) then
+
+      return
+      end
+
+
+
+c *****************************************************************
+      SUBROUTINE vl1d(q,pente_max,masse,w,qm)
+c
+c    
+c     Operateur de moyenne inter-couche pour calcul de transport type
+c     Van-Leer " pseudo amont " dans la verticale
+c    q,w sont des arguments d'entree  pour le s-pg ....
+c    masse : masse de la couche Dp/g
+c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
+c    pente_max = 2 conseillee
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+
+#include "dimensions.h"
+
+c
+c
+c
+c   Arguments:
+c   ----------
+      real masse(llm),pente_max
+      REAL q(llm),qm(llm+1)
+      REAL w(llm+1)
+c
+c      Local 
+c   ---------
+c
+      INTEGER l
+c
+      real dzq(llm),dzqw(llm),adzqw(llm),dzqmax
+      real sigw, Mtot, MQtot
+      integer m 
+c     integer ismax,ismin 
+
+
+c    On oriente tout dans le sens de la pression 
+c     W > 0 WHEN DOWN !!!!!!!!!!!!!
+
+      do l=2,llm
+            dzqw(l)=q(l-1)-q(l)
+            adzqw(l)=abs(dzqw(l))
+      enddo
+
+      do l=2,llm-1
+            if(dzqw(l)*dzqw(l+1).gt.0.) then
+                dzq(l)=0.5*(dzqw(l)+dzqw(l+1))
+            else
+                dzq(l)=0.
+            endif
+            dzqmax=pente_max*min(adzqw(l),adzqw(l+1))
+            dzq(l)=sign(min(abs(dzq(l)),dzqmax),dzq(l))
+      enddo
+
+         dzq(1)=0.
+         dzq(llm)=0.
+
+       do l = 1,llm-1
+
+c         Regular scheme (transfered mass < layer mass)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          if(w(l+1).gt.0. .and. w(l+1).le.masse(l+1)) then
+             sigw=w(l+1)/masse(l+1)
+             qm(l+1)=(q(l+1)+0.5*(1.-sigw)*dzq(l+1))
+          else if(w(l+1).le.0. .and. -w(l+1).le.masse(l)) then
+             sigw=w(l+1)/masse(l)
+             qm(l+1)=(q(l)-0.5*(1.+sigw)*dzq(l))
+
+c         Extended scheme (transfered mass > layer mass)
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+          else if(w(l+1).gt.0.) then
+             m=l+1
+             Mtot = masse(m)
+             MQtot = masse(m)*q(m)
+             do while ((m.lt.llm).and.(w(l+1).gt.(Mtot+masse(m+1))))
+                m=m+1
+                Mtot = Mtot + masse(m)
+                MQtot = MQtot + masse(m)*q(m)
+             end do
+             if (m.lt.llm) then
+                sigw=(w(l+1)-Mtot)/masse(m+1)
+                qm(l+1)= (1/w(l+1))*(MQtot + (w(l+1)-Mtot)*
+     &          (q(m+1)+0.5*(1.-sigw)*dzq(m+1)) )
+             else
+                w(l+1) = Mtot
+                qm(l+1) = Mqtot / Mtot
+                write(*,*) 'top layer is disapearing !'
+                stop
+             end if
+          else      ! if(w(l+1).lt.0) 
+             m = l-1 
+             Mtot = masse(m+1)
+             MQtot = masse(m+1)*q(m+1)
+             do while ((m.gt.0).and.(-w(l+1).gt.(Mtot+masse(m))))
+                m=m-1
+                Mtot = Mtot + masse(m+1)
+                MQtot = MQtot + masse(m+1)*q(m+1)
+             end do
+             if (m.gt.0) then
+                sigw=(w(l+1)+Mtot)/masse(m)
+                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)* 
+     &          (q(m)-0.5*(1.+sigw)*dzq(m))  )
+             else
+                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)*qm(1))
+             end if   
+          end if
+       enddo
+
+c     boundary conditions (not used in newcondens !!)
+c         qm(llm+1)=0.
+c         if(w(1).gt.0.) then
+c            qm(1)=q(1)
+c         else 
+c           qm(1)=0.
+c         end if
+
+      return
+      end
Index: /trunk/mars/libf/phymars/meso_param_slope.F90
===================================================================
--- /trunk/mars/libf/phymars/meso_param_slope.F90	(revision 47)
+++ /trunk/mars/libf/phymars/meso_param_slope.F90	(revision 47)
@@ -0,0 +1,220 @@
+SUBROUTINE meso_param_slope( &
+  !
+  ! INPUTS
+  !
+               &  csza, declin, rho, latitude &
+               &  ,taudust, albedo  &
+               &  ,theta_s, psi_s &
+               &  ,fdir_0, ftot_0  &
+  !
+  ! OUTPUTS
+  !
+               &  ,ftot &
+ )
+
+
+!!*****************************************************************************************
+!
+! SUBROUTINE:
+! param_slope
+! 
+!
+! PURPOSE: 
+! computes total solar irradiance on a given Martian slope 
+!
+!
+! INPUTS:
+! csza		cosine solar zenith angle
+! declin	sun declination (rad)
+! rho		sun right ascension (rad)
+! latitude	latitude (deg)
+! taudust	dust optical depth at reference wavelength 0.67 mic. 
+! albedo	spectrally integrated surface Lambertian reflection albedo 
+! theta_s	slope inclination angle (deg)
+!			0 is horizontal, 90 is vertical
+! phi_s		slope azimuth (deg) 
+!       		0 >> Northward
+!       		90 >> Eastward
+!       		180 >> Southward
+!       		270 >> Westward
+! ftot_0	spectrally integrated total irradiance on an horizontal surface (W/m2)
+! fdir_0	spectrally integrated direct irradiance on an horizontal surface (W/m2)
+!
+!
+! OUTPUTS:
+! ftot		spectrally integrated total irradiance on the slope (W/m2)
+!
+! REFERENCE: 
+! "Fast and accurate estimation of irradiance on Martian slopes"
+! A. Spiga & F. Forget
+! .....
+!
+! AUTHOR: 
+! A. Spiga (spiga@lmd.jussieu.fr)
+! March 2008
+!
+!!*****************************************************************************************
+
+IMPLICIT NONE
+
+!!
+!! INPUT
+!!
+REAL, INTENT(IN) :: csza, declin, rho, latitude, taudust, theta_s, psi_s, albedo, ftot_0 , fdir_0 
+
+!!
+!! LOCAL
+!!
+REAL :: pi, deg2rad
+REAL :: a
+REAL :: mu_s, sigma_s
+REAL :: fdir, fscat, fscat_0, fref
+REAL, DIMENSION(4,2) :: mat_M, mat_N, mat_T
+REAL, DIMENSION(2) :: g_vector
+REAL, DIMENSION(4) :: s_vector
+REAL :: ratio
+
+!!
+!! OUTPUT
+!!
+REAL, INTENT(OUT) :: ftot
+
+!!*****************************************************************************************
+
+!
+! Prerequisite
+!
+  pi = 2.*asin(1.)
+  deg2rad = pi/180.
+  if ((theta_s > 90.) .or. (theta_s < 0.)) then
+	print *, 'please set theta_s between 0 and 90', theta_s
+	stop 
+  endif
+
+!
+! Solar Zenith angle (radian) 
+!
+  if (csza .lt. 0.01) then
+      !print *, 'sun below horizon' 
+      !fdir_0=0.
+      fdir=0.
+      fscat_0=0.
+      fscat=0.   
+      fref=0.
+  else
+
+!!
+!! Low incidence fix
+!! 
+!  if (csza .lt. 0.15) csza = 0.15
+
+!
+! 'Slope vs Sun' azimuth (radian)
+!
+  if ( ( (cos(declin)*sin(rho)) .eq. 0.0 ) &
+               .and. &
+     ( ( sin(deg2rad*latitude)*cos(declin)*cos(rho) &
+              -cos(deg2rad*latitude)*sin(declin) ) .eq. 0.0 ) ) then
+    a = deg2rad*psi_s ! some compilator need specfying value for atan2(0,0)  
+  else
+    a = deg2rad*psi_s + atan2(cos(declin)*sin(rho), &
+               sin(deg2rad*latitude)*cos(declin)*cos(rho)-cos(deg2rad*latitude)*sin(declin))
+  end if
+  
+!
+! Cosine of slope-sun phase angle 
+!
+  mu_s = csza*cos(deg2rad*theta_s) - cos(a)*sin(deg2rad*theta_s)*sqrt(1-csza**2)
+  if (mu_s .le. 0.) mu_s=0.
+
+!
+! Sky-view factor
+!
+  sigma_s=0.5*(1.+cos(deg2rad*theta_s))
+
+!
+! Direct flux on the slope
+!
+  fdir = fdir_0 * mu_s/csza
+
+!
+! Reflected flux on the slope
+!
+  fref = albedo * (1-sigma_s) * ftot_0
+
+!
+! Scattered flux on a flat surface
+!
+  fscat_0 = ftot_0 - fdir_0
+
+!
+! Scattering vector (slope vs sky)
+!
+  s_vector=(/ 1., exp(-taudust) , sin(deg2rad*theta_s), sin(deg2rad*theta_s)*exp(-taudust) /)
+
+!
+! Geometry vector (slope vs sun)
+!
+  g_vector=(/ mu_s/csza, 1. /)
+
+!
+! Coupling matrix
+!
+  if (csza .ge. 0.5) then
+	mat_M(:,1) = (/ -0.264,  1.309,  0.208, -0.828 /)
+	mat_M(:,2) = (/  1.291*sigma_s, -1.371*sigma_s, -0.581,  1.641 /)
+	mat_N(:,1) = (/  0.911, -0.777, -0.223,  0.623 /)
+	mat_N(:,2) = (/ -0.933*sigma_s,  0.822*sigma_s,  0.514, -1.195 /)
+
+  else
+	mat_M(:,1) = (/ -0.373,  0.792, -0.095,  0.398 /)
+	mat_M(:,2) = (/  1.389*sigma_s, -0.794*sigma_s, -0.325,  0.183 /)
+	mat_N(:,1) = (/  1.079,  0.275,  0.419, -1.855 /)
+	mat_N(:,2) = (/ -1.076*sigma_s, -0.357*sigma_s, -0.075,  1.844 /)
+  endif
+  !
+  mat_T = mat_M + csza*mat_N
+
+
+!
+! Scattered flux slope ratio
+!
+  if (deg2rad*theta_s <= 0.0872664626) then
+  !
+  ! low angles
+  !
+	s_vector = (/ 1., exp(-taudust) , sin(0.0872664626), sin(0.0872664626)*exp(-taudust) /)
+	ratio = DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )
+        ratio = 1. + (ratio - 1.)*deg2rad*theta_s/0.0872664626
+  else
+  !
+  ! general case
+  !
+	ratio= DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )  
+                  !
+                  ! NB: ratio= DOT_PRODUCT ( s_vector, MATMUL( mat_T, g_vector ) ) is equivalent
+  endif
+
+!
+! Scattered flux on the slope
+!
+  fscat = ratio * fscat_0
+
+
+endif !! if (csza < 0.01)
+
+!
+! Total flux on the slope
+!
+  ftot = fdir + fref + fscat
+
+!!
+!! Display results
+!!
+!  print *, 'sca component 0 ', ftot_0-fdir_0
+!  print *, 'dir component 0 ', fdir_0
+!  print *, 'scattered component ', fscat
+!  print *, 'direct component ', fdir
+!  print *, 'reflected component ', fref
+
+END SUBROUTINE meso_param_slope
Index: /trunk/mars/libf/phymars/meso_physiq.F
===================================================================
--- /trunk/mars/libf/phymars/meso_physiq.F	(revision 47)
+++ /trunk/mars/libf/phymars/meso_physiq.F	(revision 47)
@@ -0,0 +1,1809 @@
+      SUBROUTINE meso_physiq(ngrid,nlayer,nq,
+     $            firstcall,lastcall,
+     $            wday_ini,
+     $            pday,ptime,ptimestep,
+     $            pplev,pplay,pphi,
+     $            pu,pv,pt,pq,
+     $            pw,
+     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn,
+     $            wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,
+     $            wisoil,wdsoil,
+     $            wecritphys,
+     $            output_tab2d, output_tab3d,
+     $            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. 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           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"
+
+#include "meso_slope.h"
+#include "wrf_output_2d.h"
+#include "wrf_output_3d.h"
+
+
+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
+c ****WRF
+      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
+      REAL output_tab2d(ngridmx,n2d)
+      REAL output_tab3d(ngridmx,nlayer,n3d)
+      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 alpha,lay1 ! coefficients for building layers
+      integer iloop
+c ****WRF
+      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
+
+      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 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)
+      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        ~~~~~~~~~~~~
+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
+     !!!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
+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
+
+
+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)
+
+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
+         end if ! of if (tracer)
+
+      ELSE    
+         DO ig=1,ngrid
+            zdtsurf(ig)=zdtsurf(ig)+
+     s      (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 meso_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
+         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
+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
+c **WRF : OK avec le mesoscale, pas d'indices bizarres au pole
+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. 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        -------------------------------------------------------------------
+
+         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 
+      enddo
+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...'
+      RETURN
+      END
Index: /trunk/mars/libf/phymars/meso_slope.h
===================================================================
--- /trunk/mars/libf/phymars/meso_slope.h	(revision 47)
+++ /trunk/mars/libf/phymars/meso_slope.h	(revision 47)
@@ -0,0 +1,5 @@
+      COMMON/comslope/theta_sl(ngridmx),psi_sl(ngridmx)
+
+      REAL theta_sl   ! slope angle versus horizontale (deg)
+      REAL psi_sl     ! orientation of the slope (deg)
+
Index: /trunk/mars/libf/phymars/meso_testphys1d.F
===================================================================
--- /trunk/mars/libf/phymars/meso_testphys1d.F	(revision 47)
+++ /trunk/mars/libf/phymars/meso_testphys1d.F	(revision 47)
@@ -0,0 +1,687 @@
+
+      PROGRAM meso_testphys1d
+! to use  'getin'
+      USE ioipsl_getincom 
+      IMPLICIT NONE
+
+c=======================================================================
+c   subject:
+c   --------
+c   PROGRAM useful to run physical part of the martian GCM in a 1D column
+c       
+c Can be compiled with a command like (e.g. for 25 layers)
+c  "makegcm -p mars -d 25 testphys1d"
+c It requires the files "testphys1d.def" "callphys.def"
+c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
+c      and a file describing the sigma layers (e.g. "z2sig.def")
+c
+c   author: Frederic Hourdin, R.Fournier,F.Forget
+c   -------
+c   
+c   update: 12/06/2003 including chemistry (S. Lebonnois) 
+c                            and water ice (F. Montmessin)
+c 
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "dimradmars.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 "yomaer.h"
+#include "control.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "comg1d.h"
+#include "watercap.h"
+#include "logic.h"
+#include "advtrac.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unitstart      ! unite d'ecriture de "startfi"
+      INTEGER nlayer,nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day           ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(nlayermx)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(nlayermx+1) ! intermediate pressure levels (pa)
+      REAL psurf,tsurf      
+      REAL u(nlayermx),v(nlayermx)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(nlayermx)   ! temperature at the middle of the layers
+      REAL q(nlayermx,nqmx) ! tracer mixing ratio (e.g. kg/kg)
+      REAL qsurf(nqmx)      ! tracer surface budget (e.g. kg.m-2)
+      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
+      REAL co2ice           ! co2ice layer (kg.m-2)
+      REAL emis             ! surface layer
+      REAL q2(nlayermx+1)   ! Turbulent Kinetic Energy
+      REAL zlay(nlayermx)   ! altitude estimee dans les couches (km)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(nlayermx),dv(nlayermx),dtemp(nlayermx)
+      REAL dudyn(nlayermx),dvdyn(nlayermx),dtempdyn(nlayermx)
+      REAL dpsurf    
+      REAL dq(nlayermx,nqmx)
+      REAL dqdyn(nlayermx,nqmx)
+
+c   Various intermediate variables
+      INTEGER thermo
+      REAL zls
+      REAL phi(nlayermx),h(nlayermx),s(nlayermx)
+      REAL pks, ptif, w(nlayermx)
+      REAL qtotinit, mqtot(nqmx),qtot
+      INTEGER ierr, aslun
+      REAL tmp1(0:nlayermx),tmp2(0:nlayermx)
+      Logical  tracerdyn
+      integer :: nq=1 ! number of tracers
+
+      character*2 str2
+      character (len=7) :: str7
+      character(len=44) :: txt
+
+c=======================================================================
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+
+c ------------------------------------------------------
+c  Constantes prescrites ICI
+c ------------------------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Constante de la Planete Mars
+c     ----------------------------
+      rad=3397200.               ! rayon de mars (m)  ~3397200 m
+      daysec=88775.              ! duree du sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec)  ! vitesse de rotation (rad.s-1)
+      g=3.72                     ! gravite (m.s-2) ~3.72  
+      mugaz=43.49                ! Masse molaire de l'atm (g.mol-1) ~43.49
+      rcp=.256793                ! = r/cp  ~0.256793
+      r= 8.314511E+0 *1000.E+0/mugaz
+      cpp= r/rcp
+      year_day = 669           ! duree de l'annee (sols) ~668.6
+      periheli = 206.66          ! dist.min. soleil-mars (Mkm) ~206.66
+      aphelie = 249.22           ! dist.max. soleil-mars (Mkm) ~249.22
+      peri_day =  485.           ! date du perihelie (sols depuis printemps)
+      obliquit = 25.2           ! Obliquite de la planete (deg) ~25.2         
+ 
+c     Parametres Couche limite et Turbulence 
+c     --------------------------------------
+      z0 =  1.e-2                ! surface roughness (m) ~0.01 
+      emin_turb = 1.e-6          ! energie minimale ~1.e-8
+      lmixmin = 30               ! longueur de melange ~100
+ 
+c     propriete optiques des calottes et emissivite du sol
+c     ----------------------------------------------------
+      emissiv= 0.95              ! Emissivite du sol martien ~.95
+      emisice(1)=0.95            ! Emissivite calotte nord
+      emisice(2)=0.95            ! Emissivite calotte sud  
+      albedice(1)=0.5           ! Albedo calotte nord
+      albedice(2)=0.5            ! Albedo calotte sud
+      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
+      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
+      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
+      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
+      hybrid=.false.
+
+c ------------------------------------------------------
+c  Lecture des parametres dans "run.def" 
+c ------------------------------------------------------
+
+
+! check if 'run.def' file is around (otherwise reading parameters
+! from callphys.def via getin() routine won't work.
+      open(99,file='run.def',status='old',form='formatted',
+     &     iostat=ierr)
+      if (ierr.ne.0) then
+        write(*,*) 'Cannot find required file "run.def"'
+        write(*,*) '  (which should contain some input parameters'
+        write(*,*) '   along with the following line:'
+        write(*,*) '   INCLUDEDEF=callphys.def'
+        write(*,*) '   )'
+        write(*,*) ' ... might as well stop here ...'
+        stop
+      else
+        close(99)
+      endif
+
+! check if we are going to run with or without tracers
+      write(*,*) "Run with or without tracer transport ?"
+      tracer=.false. ! default value
+      call getin("tracer",tracer)
+      write(*,*) " tracer = ",tracer
+
+! while we're at it, check if there is a 'traceur.def' file
+! and preocess it, if necessary. Otherwise initialize tracer names
+      if (tracer) then
+      ! load tracer names from file 'traceur.def'
+        open(90,file='traceur.def',status='old',form='formatted',
+     &       iostat=ierr)
+        if (ierr.ne.0) then
+          write(*,*) 'Cannot find required file "traceur.def"'
+          write(*,*) ' If you want to run with tracers, I need it'
+          write(*,*) ' ... might as well stop here ...'
+          stop
+        else
+          write(*,*) "testphys1d: Reading file traceur.def"
+          ! read number of tracers:
+          read(90,*,iostat=ierr) nq
+          if (ierr.ne.0) then
+            write(*,*) "testphys1d: error reading number of tracers"
+            write(*,*) "   (first line of traceur.def) "
+            stop
+          else
+            ! check that the number of tracers is indeed nqmx
+            if (nq.ne.nqmx) then
+              write(*,*) "testphys1d: error, wrong number of tracers:"
+              write(*,*) "nq=",nq," whereas nqmx=",nqmx
+              stop
+            endif
+          endif
+        endif
+        ! read tracer names from file traceur.def
+        do iq=1,nqmx
+          read(90,*,iostat=ierr) tnom(iq)
+          if (ierr.ne.0) then
+            write(*,*) 'testphys1d: error reading tracer names...'
+            stop
+          endif
+        enddo
+        close(90)
+
+        ! initialize tracers here:
+        write(*,*) "testphys1d: initializing tracers"
+        q(:,:)=0 ! default, set everything to zero
+        qsurf(:)=0
+        ! "smarter" initialization of some tracers
+        ! (get values from "profile_*" files, if these are available)
+        do iq=1,nqmx
+          txt=""
+          write(txt,"(a)") tnom(iq)
+          write(*,*)"  tracer:",trim(txt)
+          ! CO2
+          if (txt.eq."co2") then
+            q(:,iq)=0.95   ! kg /kg of atmosphere
+            qsurf(iq)=0. ! kg/m2 (not used for CO2)
+            ! even better, look for a "profile_co2" input file
+            open(91,file='profile_co2',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayermx
+                read(91,*) q(ilayer,iq)
+              enddo
+            endif
+            close(91)
+          endif ! of if (txt.eq."co2")
+          ! WATER VAPOUR
+          if (txt.eq."h2o_vap") then
+            !look for a "profile_h2o_vap" input file
+            open(91,file='profile_h2o_vap',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayermx
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_h2o_vap file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."h2o_ice")
+          ! WATER ICE
+          if (txt.eq."h2o_ice") then
+            !look for a "profile_h2o_vap" input file
+            open(91,file='profile_h2o_ice',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayermx
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_h2o_ice file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."h2o_ice")
+          ! DUST
+          !if (txt(1:4).eq."dust") then
+          !  q(:,iq)=0.4    ! kg/kg of atmosphere
+          !  qsurf(iq)=100 ! kg/m2
+          !endif
+          ! DUST MMR
+          if (txt.eq."dust_mass") then
+            !look for a "profile_dust_mass" input file
+            open(91,file='profile_dust_mass',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayermx
+                read(91,*) q(ilayer,iq)
+!                write(*,*) "l=",ilayer," q(ilayer,iq)=",q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_dust_mass file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."dust_mass")
+          ! DUST NUMBER
+          if (txt.eq."dust_number") then
+            !look for a "profile_dust_number" input file
+            open(91,file='profile_dust_number',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayermx
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_dust_number file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."dust_number")
+        enddo ! of do iq=1,nqmx
+        ! NB: some more initializations (chemistry) is done later
+
+      else
+      ! we still need to set (dummy) tracer names for physdem1
+        nq=nqmx
+        do iq=1,nq
+          write(str7,'(a1,i2.2)')'q',iq
+          tnom(iq)=str7
+        enddo
+      endif ! of if (tracer)
+
+c  Date et heure locale du debut du run
+c  ------------------------------------
+c    Date (en sols depuis le solstice de printemps) du debut du run
+      day0 = 0 ! default value for day0
+      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
+      call getin("day0",day0)
+      day=float(day0)
+      write(*,*) " day0 = ",day0
+c  Heure de demarrage
+      time=0 ! default value for time
+      write(*,*)'Initial local time (in hours, between 0 and 24)?'
+      call getin("time",time)
+      write(*,*)" time = ",time
+      time=time/24.E+0 ! convert time (hours) to fraction of sol
+
+c  Discretisation (Definition de la grille et des pas de temps)
+c  --------------
+c
+      nlayer=nlayermx
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+
+      day_step=48 ! default value for day_step
+      PRINT *,'Number of time steps per sol ?'
+      call getin("day_step",day_step)
+      write(*,*) " day_step = ",day_step
+
+      ndt=10 ! default value for ndt
+      PRINT *,'Number of sols to run ?'
+      call getin("ndt",ndt)
+      write(*,*) " ndt = ",ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+c Pression de surface sur la planete
+c ------------------------------------
+c
+      psurf=610. ! default value for psurf
+      PRINT *,'Surface pressure (Pa) ?'
+      call getin("psurf",psurf)
+      write(*,*) " psurf = ",psurf
+c Pression de reference
+      pa=20.
+      preff=610.      
+ 
+c Proprietes des poussiere aerosol
+c --------------------------------
+      tauvis=0.2 ! default value for tauvis
+      print *,'Reference dust opacity at 700 Pa ?'
+      call getin("tauvis",tauvis)
+      write(*,*) " tauvis = ",tauvis
+ 
+c  latitude/longitude
+c  ------------------
+      lati(1)=0 ! default value for lati(1)
+      PRINT *,'latitude (in degrees) ?'
+      call getin("latitude",lati(1))
+      write(*,*) " latitude = ",lati(1)
+      lati(1)=lati(1)*pi/180.E+0
+      long(1)=0.E+0
+      long(1)=long(1)*pi/180.E+0
+
+c  Initialisation albedo / inertie du sol
+c  --------------------------------------
+c
+      albedodat(1)=0.2 ! default value for albedodat
+      PRINT *,'Albedo of bare ground ?'
+      call getin("albedo",albedodat(1))
+      write(*,*) " albedo = ",albedodat(1)
+
+      inertiedat(1,1)=400 ! default value for inertiedat
+      PRINT *,'Soil thermal inertia (SI) ?'
+      call getin("inertia",inertiedat(1,1))
+      write(*,*) " inertia = ",inertiedat(1,1)
+c
+c  pour le schema d'ondes de gravite
+c  ---------------------------------
+c
+      zmea(1)=0.E+0
+      zstd(1)=0.E+0
+      zsig(1)=0.E+0
+      zgam(1)=0.E+0
+      zthe(1)=0.E+0
+
+
+
+c   Initialisation speciales "physiq"
+c   ---------------------------------
+c   la surface de chaque maille est inutile en 1D --->
+      area(1)=1.E+0
+
+c   le geopotentiel au sol est inutile en 1D car tout est controle
+c   par la pression de surface --->
+      phisfi(1)=0.E+0
+
+c  "inifis" reproduit un certain nombre d'initialisations deja faites
+c  + lecture des clefs de callphys.def
+c  + calcul de la frequence d'appel au rayonnement
+c  + calcul des sinus et cosinus des longitude latitude
+
+!Mars possible matter with dtphys in input and include!!!
+      CALL meso_inifis(1,llm,day0,daysec,dtphys,
+     .            lati,long,area,rad,g,r,cpp)
+c   Initialisation pour prendre en compte les vents en 1-D
+c   ------------------------------------------------------
+      ptif=2.E+0*omeg*sinlat(1)
+ 
+c    vent geostrophique
+      gru=10. ! default value for gru
+      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
+      call getin("u",gru)
+      write(*,*) " u = ",gru
+      grv=0. !default value for grv
+      PRINT *,'meridional northward component of the geostrophic',
+     &' wind (m/s) ?'
+      call getin("v",grv)
+      write(*,*) " v = ",grv
+
+c     Initialisation des vents  au premier pas de temps
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c     energie cinetique turbulente
+      DO ilevel=1,nlevel
+         q2(ilevel)=0.E+0
+      ENDDO
+
+c  glace de CO2 au sol
+c  -------------------
+      co2ice=0.E+0 ! default value for co2ice
+      PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
+      call getin("co2ice",co2ice)
+      write(*,*) " co2ice = ",co2ice
+
+c
+c  emissivite
+c  ----------
+      emis=emissiv
+      IF (co2ice.eq.1.E+0) THEN
+         emis=emisice(1) ! northern hemisphere
+         IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
+      ENDIF
+
+ 
+
+c  calcul des pressions et altitudes en utilisant les niveaux sigma
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates
+c    """"""""""""""""""""
+      hybrid=.true.
+      PRINT *,'Hybrid coordinates ?'
+      call getin("hybrid",hybrid)
+      write(*,*) " hybrid = ", hybrid
+
+      CALL  disvert
+
+      DO ilevel=1,nlevel
+        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
+     &   /g
+      ENDDO
+
+
+c  profil de temperature au premier appel
+c  --------------------------------------
+      pks=psurf**rcp
+
+c altitude en km dans profile: on divise zlay par 1000
+      tmp1(0)=0.E+0
+      DO ilayer=1,nlayer
+        tmp1(ilayer)=zlay(ilayer)/1000.E+0
+      ENDDO
+
+      call profile(nlayer+1,tmp1,tmp2)
+
+      tsurf=tmp2(0)
+      DO ilayer=1,nlayer
+        temp(ilayer)=tmp2(ilayer)
+      ENDDO
+      
+
+
+! Initialize soil properties and temperature
+! ------------------------------------------
+      volcapa=1.e6 ! volumetric heat capacity
+      DO isoil=1,nsoil
+         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
+         tsoil(isoil)=tsurf  ! soil temperature
+      ENDDO
+
+! Initialize depths
+! -----------------
+      do isoil=0,nsoil-1
+        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
+      enddo
+      do isoil=1,nsoil
+        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
+      enddo
+
+c    Initialisation des traceurs
+c    ---------------------------
+
+      if (photochem.or.callthermos) then
+         write(*,*) 'Especes chimiques initialisees'
+         ! thermo=0: initialisation pour toutes les couches 
+         thermo=0
+         call inichim_newstart(q,psurf,sig,nqmx,lati,long,area,
+     $   thermo,qsurf)
+      endif
+      watercaptag(ngridmx)=.false.
+      
+
+c    Initialisation pour les sorties GRADS dans "g1d.dat" et "g1d.ctl"
+c    ----------------------------------------------------------------
+c    (effectuee avec "writeg1d" a partir de "physiq.F"
+c    ou tout autre subroutine physique, y compris celle ci).
+
+        g1d_nlayer=nlayer
+        g1d_nomfich='g1d.dat'
+        g1d_unitfich=40
+        g1d_nomctl='g1d.ctl'
+        g1d_unitctl=41
+        g1d_premier=.true.
+        g2d_premier=.true.
+
+c  Ecriture de "startfi"
+c  --------------------
+c  (Ce fichier sera aussitot relu au premier
+c   appel de "physiq", mais il est necessaire pour passer
+c   les variables purement physiques a "physiq"...
+
+      call physdem1("startfi.nc",long,lati,nsoilmx,nqmx,
+     .              dtphys,float(day0),
+     .              time,tsurf,tsoil,co2ice,emis,q2,qsurf,
+     .              area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c  BOUCLE TEMPORELLE DU MODELE 1D 
+c=======================================================================
+c
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+c        IF (idt.eq.ndt) lastcall=.true.
+        IF (idt.eq.ndt-day_step-1) then       !test
+         lastcall=.true.
+         call solarlong(day*1.0,zls)
+         write(103,*) 'Ls=',zls*180./pi
+         write(103,*) 'Lat=', lati(1)*180./pi
+         write(103,*) 'Tau=', tauvis/700*psurf
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(104,*) 'Ls=',zls*180./pi
+         write(104,*) 'Lat=', lati(1)
+         write(104,*) 'Tau=', tauvis/700*psurf
+         write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c    calcul du geopotentiel 
+c     ~~~~~~~~~~~~~~~~~~~~~
+      DO ilayer=1,nlayer
+        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+      ENDDO
+      phi(1)=pks*h(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
+     &                  *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       appel de la physique
+c       --------------------
+
+      CALL meso_physiq (1,llm,nqmx,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,phi,
+     ,     u, v,temp, q,  
+     ,     w,
+C - sorties
+     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
+
+c       evolution du vent : modele 1D
+c       -----------------------------
+ 
+c       la physique calcule les derivees temporelles de u et v.
+c       on y rajoute betement un effet Coriolis.
+c
+c       DO ilayer=1,nlayer
+c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
+c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
+c       ENDDO
+
+c       Pour certain test : pas de coriolis a l'equateur
+c       if(lati(1).eq.0.) then
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c       end if
+c      
+c
+c       Calcul du temps au pas de temps suivant
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       calcul des vitesses et temperature au pas de temps suivant
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       calcul des pressions au pas de temps suivant
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           DO ilevel=1,nlevel
+             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+!       increment tracer values
+        DO iq = 1, nqmx
+          DO ilayer=1,nlayer
+             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
+          ENDDO
+        ENDDO
+
+      ENDDO   ! fin de la boucle temporelle
+
+c    ========================================================
+c    GESTION DES SORTIE
+c    ========================================================
+
+c    fermeture pour conclure les sorties format grads dans "g1d.dat"
+c    et "g1d.ctl" (effectuee avec "writeg1d" a partir de "physiq.F"
+c    ou tout autre subroutine physique, y compris celle ci).
+
+c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
+        CALL endg1d(1,nlayer,zlay/1000.,ndt)
+
+c    ========================================================
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+c     Subroutines Bidons utilise seulement en 3D, mais
+c     necessaire a la compilation de testphys1d en 1-D
+
+      subroutine gr_fi_dyn
+      RETURN
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+
+#include "../dyn3d/disvert.F"
Index: unk/mesoscale/COMMON_GCM/ajouts/meso_callkeys.h
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_callkeys.h	(revision 46)
+++ 	(revision )
@@ -1,57 +1,0 @@
-!
-! For Fortran 77/Fortran 90 compliance always use line continuation
-! symbols '&' in columns 73 and 6
-!
-! NB: to keep commons aligned, it is better to split them in groups
-!     of given types (logical, integer, real, ...)
-
-      COMMON/callkeys_l/callrad,calldifv,calladj,callcond,callsoil      &
-     &   ,season,diurnal,lwrite,calllott,callstats,calleofdump          &
-     &   ,callnirco2,callnlte,callthermos,callconduct,calleuv           &
-     &   ,callmolvis,callmoldiff,thermochem,thermoswater,callemis       &
-     &   ,callg2d,linear,rayleigh,tracer,active,doubleq,submicron       &
-     &   ,lifting,callddevil,scavenging,sedimentation,activice,water    &
-     &   ,caps,photochem
-     
-      COMMON/callkeys_i/iradia,iaervar,iddist,ilwd,ilwb,ilwn,ncouche    &
-     &   ,dustbin,nqchem_min
-     
-      COMMON/callkeys_r/topdustref,solarcondate,semi,alphan
-     
-      LOGICAL callrad,calldifv,calladj,callcond,callsoil,               &
-     &   season,diurnal,lwrite,calllott                                 &
-     &   ,callstats,calleofdump                                         &
-     &   ,callnirco2,callnlte,callthermos,callconduct,                  &
-     &    calleuv,callmolvis,callmoldiff,thermochem,thermoswater
-
-
-      logical callemis
-      logical callg2d
-      logical linear
-
-      real topdustref
-      real semi
-      real alphan
-      real solarcondate
-
-      integer ecri_phys
-      integer iddist
-      integer iaervar
-      integer iradia
-      integer ilwd
-      integer ilwb
-      integer ilwn
-      integer ncouche
-
-      logical rayleigh
-      logical tracer
-      integer dustbin
-      logical active,doubleq,submicron,lifting,callddevil,scavenging
-      logical sedimentation,activice,water,caps
-      logical photochem
-      integer nqchem_min
-
-      integer swrtype ! type of short wave (solar wavelength) radiative
-      ! transfer to use 1: Fouquart 2: Toon.
-      parameter (swrtype=2)
-!      parameter (swrtype=2)
Index: unk/mesoscale/COMMON_GCM/ajouts/meso_dimphys.h_ref
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_dimphys.h_ref	(revision 46)
+++ 	(revision )
@@ -1,13 +1,0 @@
-!-----------------------------------------------------------------------
-!   INCLUDE 'dimphys.h'
-
-
-         INTEGER, parameter :: wiim=--xsize--
-         INTEGER, parameter :: wjjm=--ysize--
-         INTEGER, PARAMETER :: ngridmx=--physize--
-         INTEGER, parameter :: nlayermx=--zsize--
-         INTEGER, PARAMETER :: nsoilmx=--soilsize--
-	
-!-----------------------------------------------------------------------
-
-	 
Index: /trunk/mesoscale/COMMON_GCM/ajouts/meso_dustlift.F
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_dustlift.F	(revision 47)
+++ /trunk/mesoscale/COMMON_GCM/ajouts/meso_dustlift.F	(revision 47)
@@ -0,0 +1,132 @@
+      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   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
+      REAL stress_seuil
+      SAVE stress_seuil
+c      DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
+!****WRF
+!****WRF: additional ASCII file to define dust opacity
+          REAL alpha
+          INTEGER ierr
+          OPEN(99,file='stress.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+          IF(ierr.NE.0) THEN
+             stress_seuil = 0.0225
+             alpha = 1.
+             write(*,*) 'No file stress.def - set ', stress_seuil, alpha
+             !stop
+          ELSE
+             READ(99,*) stress_seuil
+             READ(99,*) alpha
+             write(*,*) 'definir seuil stress : ', stress_seuil, alpha
+             CLOSE(99)
+          ENDIF
+          alpha_lift(1) = alpha
+!****WRF
+!****WRF
+
+
+
+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/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_lift(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: unk/mesoscale/COMMON_GCM/ajouts/meso_inifis.F
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_inifis.F	(revision 46)
+++ 	(revision )
@@ -1,809 +1,0 @@
-      SUBROUTINE meso_inifis(ngrid,nlayer,nq,
-     $           wdt,
-     $           wday_ini,wdaysec,
-     $           wappel_phys,wecri_phys,
-     $           plat,plon,parea,
-     $           prad,pg,pr,pcpp,
-     $           womeg,wmugaz,
-     $           wyear_day,wperiheli,waphelie,wperi_day,wobliquit, 
-     $           wz0,wemin_turb,wlmixmin,
-     $           wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS, 
-     $           wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS,
-     $           walbedodat,wphisfi,wvolcapa, 
-     $           wzmea,wzstd,wzsig,wzgam,wzthe,
-     $           wtheta,wpsi)
-
-c=======================================================================    
-c                                                                           
-c       CAREFUL: THIS IS A VERSION TO BE USED WITH WRF !!!                  
-c                                                                           
-c       ... CHECK THE ****WRF lines                                         
-c                                                                           
-c=======================================================================  
-!
-!=======================================================================
-!
-!   purpose:
-!   -------
-!
-!   Initialisation for the physical parametrisations of the LMD 
-!   martian atmospheric general circulation modele.
-!
-!   author: Frederic Hourdin 15 / 10 /93
-!   -------
-!   modified: Sebastien Lebonnois 11/06/2003 (new callphys.def)
-!             Ehouarn Millour (oct. 2008) tracers are now identified
-!              by their names and may not be contiguously
-!              stored in the q(:,:,:,:) array
-!             E.M. (june 2009) use getin routine to load parameters
-!             adapted to the WRF use - Aymeric Spiga - Jan 2009 - Jan 2007
-!
-!
-!   arguments:
-!   ----------
-!
-!   input:
-!   ------
-!
-!    ngrid                 Size of the horizontal grid.
-!                          All internal loops are performed on that grid.
-!    nlayer                Number of vertical layers.
-!    pdayref               Day of reference for the simulation
-!    pday                  Number of days counted from the North. Spring
-!                          equinoxe.
-!
-!=======================================================================
-!
-!-----------------------------------------------------------------------
-!   declarations:
-!   -------------
-! to use  'getin'
-!! **WRF a new stuff to be checked
-      USE ioipsl_getincom 
-      IMPLICIT NONE
-#include "dimensions.h"
-#include "dimphys.h"
-#include "planete.h"
-#include "comcstfi.h"
-#include "comsaison.h"
-#include "comdiurn.h"
-#include "comgeomfi.h"
-#include "callkeys.h"
-#include "surfdat.h"
-#include "dimradmars.h"  !!new
-#include "yomaer.h"      !!new -- prob. pour remplir les proprietes
-#include "datafile.h"
-#include "meso_slope.h"
-#include "comsoil.h"     !!**WRF -- needed to fill volcapa
-
-      REAL prad,pg,pr,pcpp,pdaysec
- 
-      INTEGER ngrid,nlayer,nq
-
-      REAL womeg,wmugaz,wdaysec
-      REAL wyear_day,wperiheli,waphelie,wperi_day,wobliquit
-      REAL wz0,wemin_turb,wlmixmin
-      REAL wemissiv,wemissiceN,wemissiceS,walbediceN,walbediceS
-
-      REAL wiceradiusN,wiceradiusS,wdtemisiceN,wdtemisiceS
-      REAL walbedodat(ngrid),wphisfi(ngrid)
-      REAL wzmea(ngrid),wzstd(ngrid),wzsig(ngrid)
-      REAL wzgam(ngrid),wzthe(ngrid)
-      REAL wtheta(ngrid),wpsi(ngrid)
-      REAL wvolcapa
-      REAL wdt
-
-      REAL plat(ngrid),plon(ngrid),parea(ngridmx)
-      integer wday_ini
-      INTEGER ig,ierr
-
-      INTEGER wecri_phys, wappel_phys
- 
-!      EXTERNAL iniorbit,orbite
-      EXTERNAL SSUM
-      REAL SSUM
- 
-      CHARACTER ch1*12
-      CHARACTER ch80*80
-
-!      logical chem, h2o
-
-!      chem = .false.
-!      h2o = .false.
-
-c ****WRF
-c
-c------------------------------------------------------
-c  Fill some parameters in the 'include' files
-c  >> Do part of the job previously done by phyetat0.F
-c  >> Complete list of parameters is found in tabfi.F
-c------------------------------------------------------
-c
-c Values are defined in the module_model_constants.F WRF routine
-c      
-      ! in 'comcstfi.h'
-      rad=prad                  
-      cpp=pcpp
-      g=pg
-      r=pr
-      rcp=r/cpp
-      daysec=wdaysec  
-      omeg=womeg                
-      mugaz=wmugaz  
-      print*,"check: rad,cpp,g,r,rcp,daysec,omeg,mugaz"
-      print*,rad,cpp,g,r,rcp,daysec,omeg,mugaz
-    
-      ! in 'planet.h' 
-      year_day=wyear_day
-      periheli=wperiheli
-      aphelie=waphelie
-      peri_day=wperi_day
-      obliquit=wobliquit
-      z0=wz0
-      emin_turb=wemin_turb
-      lmixmin=wlmixmin
-      print*,"check: year_day,periheli,aphelie,peri_day,obliquit"
-      print*,year_day,periheli,aphelie,peri_day,obliquit
-      print*,"check: z0,emin_turb,lmixmin"
-      print*,z0,emin_turb,lmixmin
-
-      ! in 'surfdat.h'
-      emissiv=wemissiv
-      emisice(1)=wemissiceN
-      emisice(2)=wemissiceS
-      albedice(1)=walbediceN
-      albedice(2)=walbediceS
-      iceradius(1)=wiceradiusN
-      iceradius(2)=wiceradiusS
-      dtemisice(1)=wdtemisiceN
-      dtemisice(2)=wdtemisiceS
-      print*,"check: emissiv,emisice,albedice,iceradius,dtemisice"
-      print*,emissiv,emisice,albedice,iceradius,dtemisice
-
-c
-c Values are defined in the WPS processing
-c  
-        albedodat(:)=walbedodat(:)
-        !!!!! ***WRF inertiedat was moved, new physics !!
-        !inertiedat(:)=winertiedat(:)
-        phisfi(:)=wphisfi(:)
-        print*,"check: albedodat(1),phisfi(1)"
-        print*,albedodat(1),phisfi(1)
-        print*,"check: albedodat(end),phisfi(end)"
-        print*,albedodat(ngrid),phisfi(ngrid)
-
-        ! NB: usually, gravity wave scheme is useless in mesoscale modeling
-        ! NB: we however keep the option for coarse grid case ... 	
-        zmea(:)=wzmea(:)
-        zstd(:)=wzstd(:)
-        zsig(:)=wzsig(:)
-        zgam(:)=wzgam(:)
-        zthe(:)=wzthe(:)
-        print*,"check: gw param"
-        print*,zmea(1),zmea(ngrid)
-        print*,zstd(1),zstd(ngrid)
-        print*,zsig(1),zsig(ngrid)
-        print*,zgam(1),zgam(ngrid)
-        print*,zthe(1),zthe(ngrid)
-
-        !
-        ! in meso_slope.h
-        !
-        theta_sl(:)=wtheta(:)
-        psi_sl(:)=wpsi(:)
-        print*,"check: theta_sl(1),psi_sl(1)"
-        print*,theta_sl(1),psi_sl(1)
-        print*,"check: theta_sl(end),psi_sl(end)"
-        print*,theta_sl(ngrid),psi_sl(ngrid)
-
-        !
-        ! in comsoil.h
-        !
-        volcapa=wvolcapa
-        print*,"check: volcapa"
-        print*,volcapa 
-
-
-c ****WRF
-     
-
-!      rad=prad
-!      daysec=pdaysec
-!      dtphys=ptimestep
-!      cpp=pcpp
-!      g=pg
-!      r=pr
-!      rcp=r/cpp
-
-! --------------------------------------------------------
-!     The usual Tests
-!     --------------
-      IF (nlayer.NE.nlayermx) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimensions :'
-         PRINT*,'nlayer     = ',nlayer
-         PRINT*,'nlayermx   = ',nlayermx
-         STOP
-      ENDIF
-
-      IF (ngrid.NE.ngridmx) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimensions :'
-         PRINT*,'ngrid     = ',ngrid
-         PRINT*,'ngridmx   = ',ngridmx
-         STOP
-      ENDIF
-
-! --------------------------------------------------------------
-!  Reading the "callphys.def" file controlling some key options
-! --------------------------------------------------------------
-     
-      ! check that 'callphys.def' file is around
-      OPEN(99,file='callphys.def',status='old',form='formatted'
-     &     ,iostat=ierr)
-      CLOSE(99)
-      
-      IF(ierr.EQ.0) THEN
-         PRINT*
-         PRINT*
-         PRINT*,'--------------------------------------------'
-         PRINT*,' inifis: Parameters for the physics (callphys.def)'
-         PRINT*,'--------------------------------------------'
-
-         write(*,*) "Directory where external input files are:"
-         ! NB: default 'datafile' is set in datafile.h
-         call getin("datadir",datafile)
-         write(*,*) " datafile = ",trim(datafile)
-
-         write(*,*) "Run with or without tracer transport ?"
-         tracer=.false. ! default value
-         call getin("tracer",tracer)
-         write(*,*) " tracer = ",tracer
-
-         write(*,*) "Diurnal cycle ?"
-         write(*,*) "(if diurnal=False, diurnal averaged solar heating)"
-         diurnal=.true. ! default value
-         call getin("diurnal",diurnal)
-         write(*,*) " diurnal = ",diurnal
-
-         write(*,*) "Seasonal cycle ?"
-         write(*,*) "(if season=False, Ls stays constant, to value ",
-     &   "set in 'start'"
-         season=.true. ! default value
-         call getin("season",season)
-         write(*,*) " season = ",season
-
-         write(*,*) "Write some extra output to the screen ?"
-         lwrite=.false. ! default value
-         call getin("lwrite",lwrite)
-         write(*,*) " lwrite = ",lwrite
-
-         write(*,*) "Save statistics in file stats.nc ?"
-         !callstats=.true. ! default value
-         callstats=.false. ! default value
-         call getin("callstats",callstats)
-         write(*,*) " callstats = ",callstats
-
-         write(*,*) "Save EOF profiles in file 'profiles' for ",
-     &              "Climate Database?"
-         calleofdump=.false. ! default value
-         call getin("calleofdump",calleofdump)
-         write(*,*) " calleofdump = ",calleofdump
-
-         write(*,*) "Dust scenario: 1=constant dust (read from startfi",
-     &   " or set as tauvis); 2=Viking scenario; =3 MGS scenario,",
-     &   "=4 Mars Year 24 from TES assimilation, ",
-     &   "=24,25 or 26 :Mars Year 24,25 or 26 from TES assimilation"
-         iaervar=3 ! default value
-         call getin("iaervar",iaervar)
-         write(*,*) " iaervar = ",iaervar
-
-         write(*,*) "Reference (visible) dust opacity at 700 Pa ",
-     &   "(matters only if iaervar=1)"
-         ! NB: default value of tauvis is set/read in startfi.nc file
-         call getin("tauvis",tauvis)
-         write(*,*) " tauvis = ",tauvis
-
-         write(*,*) "Dust vertical distribution:"
-         write(*,*) "(=1 top set by topdustref parameter;",
-     & " =2 Viking scenario; =3 MGS scenario)"
-         iddist=3 ! default value
-         call getin("iddist",iddist)
-         write(*,*) " iddist = ",iddist
-
-         write(*,*) "Dust top altitude (km). (Matters only if iddist=1)"
-         topdustref= 90.0 ! default value
-         call getin("topdustref",topdustref)
-         write(*,*) " topdustref = ",topdustref
-
-         write(*,*) "call radiative transfer ?"
-         callrad=.true. ! default value
-         call getin("callrad",callrad)
-         write(*,*) " callrad = ",callrad
-
-         write(*,*) "call NLTE radiative schemes ?",
-     &              "(matters only if callrad=T)"
-         callnlte=.false. ! default value
-         call getin("callnlte",callnlte)
-         write(*,*) " callnlte = ",callnlte
-         
-         write(*,*) "call CO2 NIR absorption ?",
-     &              "(matters only if callrad=T)"
-         callnirco2=.false. ! default value
-         call getin("callnirco2",callnirco2)
-         write(*,*) " callnirco2 = ",callnirco2
-         
-         write(*,*) "call turbulent vertical diffusion ?"
-         calldifv=.true. ! default value
-         call getin("calldifv",calldifv)
-         write(*,*) " calldifv = ",calldifv
-
-         write(*,*) "call convective adjustment ?"
-         calladj=.true. ! default value
-         call getin("calladj",calladj)
-         write(*,*) " calladj = ",calladj
-         
-
-         write(*,*) "call CO2 condensation ?"
-         callcond=.true. ! default value
-         call getin("callcond",callcond)
-         write(*,*) " callcond = ",callcond
-
-         write(*,*)"call thermal conduction in the soil ?"
-         callsoil=.true. ! default value
-         call getin("callsoil",callsoil)
-         write(*,*) " callsoil = ",callsoil
-         
-
-         write(*,*)"call Lott's gravity wave/subgrid topography ",
-     &             "scheme ?"
-         calllott=.true. ! default value
-         call getin("calllott",calllott)
-         write(*,*)" calllott = ",calllott
-
-
-         write(*,*)"rad.transfer is computed every iradia",
-     &             " physical timestep"
-         iradia=1 ! default value
-         call getin("iradia",iradia)
-         write(*,*)" iradia = ",iradia
-         
-
-         write(*,*)"Output of the exchange coefficient mattrix ?",
-     &             "(for diagnostics only)"
-         callg2d=.false. ! default value
-         call getin("callg2d",callg2d)
-         write(*,*)" callg2d = ",callg2d
-
-         write(*,*)"Rayleigh scattering : (should be .false. for now)"
-         rayleigh=.false.
-         call getin("rayleigh",rayleigh)
-         write(*,*)" rayleigh = ",rayleigh
-
-
-! TRACERS:
-
-         write(*,*)"Transported dust ? (if >0, use 'dustbin' dust bins)"
-         dustbin=0 ! default value
-         call getin("dustbin",dustbin)
-         write(*,*)" dustbin = ",dustbin
-
-         write(*,*)"Radiatively active dust ? (matters if dustbin>0)"
-         active=.false. ! default value
-         call getin("active",active)
-         write(*,*)" active = ",active
-
-! Test of incompatibility:
-! if active is used, then dustbin should be > 0
-
-         if (active.and.(dustbin.lt.1)) then
-           print*,'if active is used, then dustbin should > 0'
-           stop
-         endif
-
-         write(*,*)"use mass and number mixing ratios to predict",
-     &             " dust size ?"
-         doubleq=.false. ! default value
-         call getin("doubleq",doubleq)
-         write(*,*)" doubleq = ",doubleq
-
-         submicron=.false. ! default value
-         call getin("submicron",submicron)
-         write(*,*)" submicron = ",submicron
-
-! Test of incompatibility:
-! if doubleq is used, then dustbin should be 2
-
-         if (doubleq.and.(dustbin.ne.2)) then
-           print*,'if doubleq is used, then dustbin should be 2'
-           stop
-         endif
-         if (doubleq.and.submicron.and.(nqmx.LT.3)) then
-           print*,'If doubleq is used with a submicron tracer,'
-           print*,' then the number of tracers has to be'
-           print*,' larger than 3.'
-           stop
-         endif
-
-         write(*,*)"dust lifted by GCM surface winds ?"
-         lifting=.false. ! default value
-         call getin("lifting",lifting)
-         write(*,*)" lifting = ",lifting
-
-! Test of incompatibility:
-! if lifting is used, then dustbin should be > 0
-
-         if (lifting.and.(dustbin.lt.1)) then
-           print*,'if lifting is used, then dustbin should > 0'
-           stop
-         endif
-
-         write(*,*)" dust lifted by dust devils ?"
-         callddevil=.false. !default value
-         call getin("callddevil",callddevil)
-         write(*,*)" callddevil = ",callddevil
-         
-
-! Test of incompatibility:
-! if dustdevil is used, then dustbin should be > 0
-
-         if (callddevil.and.(dustbin.lt.1)) then
-           print*,'if dustdevil is used, then dustbin should > 0'
-           stop
-         endif
-
-         write(*,*)"Dust scavenging by CO2 snowfall ?"
-         scavenging=.false. ! default value
-         call getin("scavenging",scavenging)
-         write(*,*)" scavenging = ",scavenging
-         
-
-! Test of incompatibility:
-! if scavenging is used, then dustbin should be > 0
-
-         if (scavenging.and.(dustbin.lt.1)) then
-           print*,'if scavenging is used, then dustbin should > 0'
-           stop
-         endif
-
-         write(*,*) "Gravitationnal sedimentation ?"
-         sedimentation=.true. ! default value
-         call getin("sedimentation",sedimentation)
-         write(*,*) " sedimentation = ",sedimentation
-
-         write(*,*) "Radiatively active transported atmospheric ",
-     &              "water ice ?"
-         activice=.false. ! default value
-         call getin("activice",activice)
-         write(*,*) " activice = ",activice
-
-         write(*,*) "Compute water cycle ?"
-         water=.false. ! default value
-         call getin("water",water)
-         write(*,*) " water = ",water
-
-! Test of incompatibility:
-
-         if (activice.and..not.water) then
-           print*,'if activice is used, water should be used too'
-           stop
-         endif
-
-         if (water.and..not.tracer) then
-           print*,'if water is used, tracer should be used too'
-           stop
-         endif
-
-! Test of incompatibility:
-
-         write(*,*) "Permanent water caps at poles ?",
-     &               " .true. is RECOMMENDED"
-         write(*,*) "(with .true., North cap is a source of water ",
-     &   "and South pole is a cold trap)"
-         caps=.true. ! default value
-         call getin("caps",caps)
-         write(*,*) " caps = ",caps
-
-         write(*,*) "photochemistry: include chemical species"
-         photochem=.false. ! default value
-         call getin("photochem",photochem)
-         write(*,*) " photochem = ",photochem
-
-
-! THERMOSPHERE
-
-         write(*,*) "call thermosphere ?"
-         callthermos=.false. ! default value
-         call getin("callthermos",callthermos)
-         write(*,*) " callthermos = ",callthermos
-         
-
-         write(*,*) " water included without cycle ",
-     &              "(only if water=.false.)"
-         thermoswater=.false. ! default value
-         call getin("thermoswater",thermoswater)
-         write(*,*) " thermoswater = ",thermoswater
-
-         write(*,*) "call thermal conduction ?",
-     &    " (only if callthermos=.true.)"
-         callconduct=.false. ! default value
-         call getin("callconduct",callconduct)
-         write(*,*) " callconduct = ",callconduct
-
-         write(*,*) "call EUV heating ?",
-     &   " (only if callthermos=.true.)"
-         calleuv=.false.  ! default value
-         call getin("calleuv",calleuv)
-         write(*,*) " calleuv = ",calleuv
-
-         write(*,*) "call molecular viscosity ?",
-     &   " (only if callthermos=.true.)"
-         callmolvis=.false. ! default value
-         call getin("callmolvis",callmolvis)
-         write(*,*) " callmolvis = ",callmolvis
-
-         write(*,*) "call molecular diffusion ?",
-     &   " (only if callthermos=.true.)"
-         callmoldiff=.false. ! default value
-         call getin("callmoldiff",callmoldiff)
-         write(*,*) " callmoldiff = ",callmoldiff
-         
-
-         write(*,*) "call thermospheric photochemistry ?",
-     &   " (only if callthermos=.true.)"
-         thermochem=.false. ! default value
-         call getin("thermochem",thermochem)
-         write(*,*) " thermochem = ",thermochem
-
-         write(*,*) "date for solar flux calculation:",
-     &   " (1985 < date < 2002)"
-         write(*,*) "(Solar min=1996.4 ave=1993.4 max=1990.6)"
-         solarcondate=1993.4 ! default value
-         call getin("solarcondate",solarcondate)
-         write(*,*) " solarcondate = ",solarcondate
-         
-
-         if (.not.callthermos) then
-           if (thermoswater) then
-             print*,'if thermoswater is set, callthermos must be true'
-             stop
-           endif          
-           if (callconduct) then
-             print*,'if callconduct is set, callthermos must be true'
-             stop
-           endif        
-           if (calleuv) then
-             print*,'if calleuv is set, callthermos must be true'
-             stop
-           endif         
-           if (callmolvis) then
-             print*,'if callmolvis is set, callthermos must be true'
-             stop
-           endif        
-           if (callmoldiff) then
-             print*,'if callmoldiff is set, callthermos must be true'
-             stop
-           endif          
-           if (thermochem) then
-             print*,'if thermochem is set, callthermos must be true'
-             stop
-           endif          
-        endif
-
-! Test of incompatibility:
-! if photochem is used, then water should be used too
-
-         if (photochem.and..not.water) then
-           print*,'if photochem is used, water should be used too'
-           stop
-         endif
-
-! if callthermos is used, then thermoswater should be used too 
-! (if water not used already)
-
-         if (callthermos .and. .not.water) then
-           if (callthermos .and. .not.thermoswater) then
-             print*,'if callthermos is used, water or thermoswater 
-     &               should be used too'
-             stop
-           endif
-         endif
-
-         PRINT*,'--------------------------------------------'
-         PRINT*
-         PRINT*
-      ELSE
-         write(*,*)
-         write(*,*) 'Cannot read file callphys.def. Is it here ?'
-         stop
-      ENDIF
-
-8000  FORMAT(t5,a12,l8)
-8001  FORMAT(t5,a12,i8)
-
-
-
-c ****WRF
-c*****************************************************
-c Since it comes from WRF settings, we have to
-c fill dtphys in the include file 
-c It must be set now, because it is used afterwards
-c
-c Opportunity is taken to fill ecri_phys as well
-c*****************************************************
-        dtphys=wdt*float(wappel_phys)
-        print*,'Physical timestep (s) ',dtphys
-        ecri_phys=wecri_phys
-        print*,'Physical frequency for writing ',ecri_phys
-c
-c ****WRF
-
-
-      PRINT*
-      PRINT*,'inifis: daysec',daysec
-      PRINT*
-      PRINT*,'inifis: The radiative transfer is computed:'
-      PRINT*,'           each ',iradia,' physical time-step'
-      PRINT*,'        or each ',iradia*dtphys,' seconds'
-      PRINT*
-! --------------------------------------------------------------
-!  Managing the Longwave radiative transfer
-! --------------------------------------------------------------
-
-!     In most cases, the run just use the following values :
-!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      callemis=.true.     
-!     ilwd=10*int(daysec/dtphys) ! bug before 22/10/01       
-      ilwd=1
-      ilwn=1 !2
-      ilwb=1 !2
-      linear=.true.        
-      ncouche=3
-      alphan=0.4
-      semi=0
-
-!     BUT people working hard on the LW may want to read them in 'radia.def' 
-!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-      OPEN(99,file='radia.def',status='old',form='formatted'
-     .     ,iostat=ierr)
-      IF(ierr.EQ.0) THEN
-         write(*,*) 'inifis: Reading radia.def !!!'
-         READ(99,fmt='(a)') ch1
-         READ(99,*) callemis
-         WRITE(*,8000) ch1,callemis
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) iradia
-         WRITE(*,8001) ch1,iradia
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) ilwd
-         WRITE(*,8001) ch1,ilwd
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) ilwn
-         WRITE(*,8001) ch1,ilwn
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) linear
-         WRITE(*,8000) ch1,linear
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) ncouche
-         WRITE(*,8001) ch1,ncouche
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) alphan
-         WRITE(*,*) ch1,alphan
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) ilwb
-         WRITE(*,8001) ch1,ilwb
-
-
-         READ(99,fmt='(a)') ch1
-         READ(99,'(l1)') callg2d
-         WRITE(*,8000) ch1,callg2d
-
-         READ(99,fmt='(a)') ch1
-         READ(99,*) semi
-         WRITE(*,*) ch1,semi
-      end if
-      CLOSE(99)
-
-!-----------------------------------------------------------------------
-!     Some more initialization:
-!     ------------------------
-
-      ! in 'comgeomfi.h' 
-      CALL SCOPY(ngrid,plon,1,long,1)
-      CALL SCOPY(ngrid,plat,1,lati,1)
-      CALL SCOPY(ngrid,parea,1,area,1)
-      totarea=SSUM(ngridmx,area,1)
-
-      ! in 'comdiurn.h'
-      DO ig=1,ngrid
-         sinlat(ig)=sin(plat(ig))
-         coslat(ig)=cos(plat(ig))
-         sinlon(ig)=sin(plon(ig))
-         coslon(ig)=cos(plon(ig))
-      ENDDO
-
-      pi=2.*asin(1.) ! NB: pi is a common in comcstfi.h
-
-!     managing the tracers, and tests:
-!     -------------------------------
-!     Ehouarn: removed; as these tests are now done in initracer.F
-!      if(tracer) then
-!
-!!          when photochem is used, nqchem_min is the rank
-!!          of the first chemical species
-!
-!! Ehouarn: nqchem_min is now meaningless and no longer used
-!!       nqchem_min = 1
-!       if (photochem .or. callthermos) then
-!         chem = .true.
-!       end if
-!
-!       if (water .or. thermoswater) h2o = .true.
-!
-!!          TESTS
-!
-!       print*,'inifis: TRACERS:'
-!       write(*,*) "    chem=",chem,"    h2o=",h2o
-!!       write(*,*) "   doubleq=",doubleq
-!!       write(*,*) "   dustbin=",dustbin
-!
-!       if ((doubleq).and.(h2o).and.
-!     $     (chem)) then
-!         print*,' 2 dust tracers (doubleq)'
-!         print*,' 1 water vapour tracer'
-!         print*,' 1 water ice tracer'
-!         print*,nqmx-4,' chemistry tracers'
-!       endif
-!
-!       if ((doubleq).and.(h2o).and.
-!     $     .not.(chem)) then
-!         print*,' 2 dust tracers (doubleq)'
-!         print*,' 1 water vapour tracer'
-!         print*,' 1 water ice tracer'
-!         if (nqmx.LT.4) then
-!           print*,'nqmx should be at least equal to'
-!           print*,'4 with these options.'
-!           stop
-!         endif
-!       endif
-!
-!       if (.not.(doubleq).and.(h2o).and.
-!     $     (chem)) then
-!         if (dustbin.gt.0) then
-!           print*,dustbin,' dust bins'
-!         endif
-!         print*,nqmx-2-dustbin,' chemistry tracers'
-!         print*,' 1 water vapour tracer'
-!         print*,' 1 water ice tracer'
-!       endif
-!
-!       if (.not.(doubleq).and.(h2o).and.
-!     $     .not.(chem)) then
-!         if (dustbin.gt.0) then
-!           print*,dustbin,' dust bins'
-!         endif
-!         print*,' 1 water vapour tracer'
-!         print*,' 1 water ice tracer'
-!         if (nqmx.gt.(dustbin+2)) then
-!           print*,'nqmx should be ',(dustbin+2),
-!     $            ' with these options...'
-!		   print*,'(or check callphys.def)'
-!         endif
-!         if (nqmx.lt.(dustbin+2)) then
-!           write(*,*) "inifis: nqmx.lt.(dustbin+2)"
-!           stop
-!         endif
-!       endif
-!
-!      endif ! of if (tracer)
-!
-!      RETURN
-      END
Index: unk/mesoscale/COMMON_GCM/ajouts/meso_newcondens.F
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_newcondens.F	(revision 46)
+++ 	(revision )
@@ -1,877 +1,0 @@
-      SUBROUTINE meso_newcondens(ngrid,nlayer,nq,ptimestep,
-     $                  pcapcal,pplay,pplev,ptsrf,pt,
-     $                  pphi,pdt,pdu,pdv,pdtsrf,pu,pv,pq,pdq,
-     $                  piceco2,psolaralb,pemisurf,
-     $                  pdtc,pdtsrfc,pdpsrf,pduc,pdvc,pdqc,
-     $                  fluxsurf_sw,zls)
-                                                   
-       IMPLICIT NONE
-c=======================================================================
-c   subject:
-c   --------
-c   Condensation/sublimation of CO2 ice on the ground and in the
-c   atmosphere 
-c   (Scheme described in Forget et al., Icarus, 1998)
-c
-c   author:   Francois Forget     1994-1996
-c   ------
-c
-c   input:
-c   ----- 
-c    ngrid                 nombre de points de verticales
-c                          (toutes les boucles de la physique sont au
-c                          moins vectorisees sur ngrid)
-c    nlayer                nombre de couches
-c    pplay(ngrid,nlayer)   Pressure levels 
-c    pplev(ngrid,nlayer+1) Pressure levels 
-c    pt(ngrid,nlayer)      temperature (en K)
-c    ptsrf(ngrid)          temperature de surface
-c 
-c                    \
-c    pdt(ngrid,nlayermx)   \  derivee temporelle physique avant condensation
-c                     /  ou sublimation pour  pt,ptsrf
-c    pdtsrf(ngrid)   /
-c
-c   output:
-c   -------
-c
-c    pdpsrf(ngrid)   \  derivee temporelle physique (contribution de
-c    pdtc(ngrid,nlayermx) /  la condensation ou sublimation) pour Ps,pt,ptsrf
-c    pdtsrfc(ngrid) /
-c
-c   Entree/sortie
-c   -------------
-c    
-c    piceco2(ngrid) :      quantite de glace co2 au sol (kg/m2)
-c    psolaralb(ngrid,2) :  albedo au sol
-c    pemisurf(ngrid)     :  emissivite du sol             
-
-c
-c=======================================================================
-c
-c    0.  Declarations :
-c    ------------------
-c
-#include "dimensions.h"
-#include "dimphys.h"
-#include "comcstfi.h"
-#include "surfdat.h"
-#include "comgeomfi.h"
-#include "comvert.h"
-#include "paramet.h"
-#include "callkeys.h"
-#include "tracer.h"
-
-c-----------------------------------------------------------------------
-c    Arguments :
-c    ---------
-      INTEGER ngrid, nlayer, nq
-
-      REAL ptimestep 
-      REAL pplay(ngrid,nlayer),pplev(ngrid,nlayer+1)
-      REAL pcapcal(ngrid)
-      REAL pt(ngrid,nlayer)
-      REAL ptsrf(ngrid)
-      REAL pphi(ngrid,nlayer)
-      REAL pdt(ngrid,nlayer),pdtsrf(ngrid),pdtc(ngrid,nlayer)
-      REAL pdtsrfc(ngrid),pdpsrf(ngrid)
-      REAL piceco2(ngrid),psolaralb(ngrid,2),pemisurf(ngrid)
-
-      REAL pu(ngrid,nlayer) ,  pv(ngrid,nlayer)
-      REAL pdu(ngrid,nlayer) , pdv(ngrid,nlayer)
-      REAL pduc(ngrid,nlayer) , pdvc(ngrid,nlayer)
-      REAL pq(ngridmx,nlayer,nq),pdq(ngrid,nlayer,nq)
-      REAL pdqc(ngrid,nlayer,nq)
-      REAL fluxsurf_sw(ngrid,2) ! added to calculate flux dependent albedo 
-      real zls ! solar longitude (rad)
-c
-c    Local variables :
-c    -----------------
-
-c   variables used for albedo parametrization       
-c --------------------------------------------      
-      INTEGER i,j
-      REAL Fluxmean(jjp1)
-      INTEGER l,ig,iq,icap,nmix
-      LOGICAL transparency, fluxdependent
-c   flag transparency if you want to make the co2ice semi-transparent       
-      PARAMETER(transparency=.true.)
-c   flag fluxdependent if you want the co2ice albedo to be dependent on
-c   the incident solar flux      
-      PARAMETER(fluxdependent=.false.)
-      REAL slopy,alpha,constA,constB,constT,albediceF_new(ngridmx)
-      REAL zt(ngridmx,nlayermx)
-      REAL zcpi
-      REAL ztcond (ngridmx,nlayermx)
-      REAL ztcondsol(ngridmx) 
-      REAL zdiceco2(ngridmx)
-      REAL zcondicea(ngridmx,nlayermx)
-      REAL zcondices(ngridmx)
-      REAL zfallice(ngridmx,nlayermx+1) , zfallheat
-      REAL zmflux(nlayermx+1)
-      REAL zu(nlayermx),zv(nlayermx)
-      REAL zq(nlayermx,nqmx),zq1(nlayermx)
-      REAL ztsrf(ngridmx)
-      REAL ztc(nlayermx), ztm(nlayermx+1) 
-      REAL zum(nlayermx+1) , zvm(nlayermx+1)
-      REAL zqm(nlayermx+1,nqmx),zqm1(nlayermx+1)
-      REAL masse(nlayermx),w(nlayermx+1)
-      REAL Sm(nlayermx),Smq(nlayermx,nqmx),mixmas,qmix
-      LOGICAL condsub(ngridmx)
-
-c variable speciale diagnostique
-      real tconda1(ngridmx,nlayermx)
-      real tconda2(ngridmx,nlayermx)
-c     REAL zdiceco2a(ngridmx) ! for diagnostic only
-      real zdtsig (ngridmx,nlayermx)
-      real zdt (ngridmx,nlayermx)
-      real vmr_co2(ngridmx,nlayermx) ! co2 volume mixing ratio
-! improved_ztcond flag: If set to .true. (AND running with a 'co2' tracer)
-! then condensation temperature is computed using partial pressure of CO2
-      logical,parameter :: improved_ztcond=.true.
-! Bound co2 (tracer) values...
-      logical,parameter :: bound_qco2=.false.
-      real,parameter :: qco2max=1.1
-      real,parameter :: qco2mini=0.1
-      real :: zqco2
-
-c   local saved variables
-      integer ico2
-      real qco2min,qco2,mmean
-      save ico2,qco2min
-      REAL emisref(ngridmx)
-      REAL latcond,tcond1mb
-      REAL acond,bcond,ccond,cpice
-!      REAL albediceF(ngridmx)
-      SAVE emisref
-      SAVE latcond,acond,bcond,ccond,cpice
-!      SAVE albediceF
-      real m_co2, m_noco2, A , B
-      save A, B, m_co2, m_noco2
-
-      LOGICAL firstcall !,firstcall2
-      SAVE firstcall !,firstcall2
-!      REAL SSUM
-!      EXTERNAL SSUM
-
-      DATA latcond,tcond1mb/5.9e5,136.27/
-      DATA cpice /1000./
-      DATA firstcall/.true./
-!      DATA firstcall2/.true./
-
-      integer flag
-
-c----------------------------------------------------------------------
-
-c   Initialisation
-c   --------------
-c
-      IF (firstcall) THEN
-         bcond=1./tcond1mb
-         ccond=cpp/(g*latcond)
-         acond=r/latcond
-
-         firstcall=.false.
-         write(*,*) 'Newcondens: improved_ztcond=',improved_ztcond
-         write(*,*) 'Newcondens: bound_qco2=',bound_qco2
-         PRINT*,'In newcondens:Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond
-         PRINT*,'acond,bcond,ccond',acond,bcond,ccond
-
-         ico2=0
-
-         if (tracer) then
-c          Prepare Special treatment if one of the tracer is CO2 gas
-           do iq=1,nqmx
-             if (noms(iq).eq."co2") then
-                ico2=iq
-                m_co2 = 44.01E-3  ! CO2 molecular mass (kg/mol)   
-                m_noco2 = 33.37E-3  ! Non condensible mol mass (kg/mol)   
-c               Compute A and B coefficient use to compute
-c               mean molecular mass Mair defined by
-c               1/Mair = q(ico2)/m_co2 + (1-q(ico2))/m_noco2
-c               1/Mair = A*q(ico2) + B
-                A =(1/m_co2 - 1/m_noco2)
-                B=1/m_noco2
-             endif
-           enddo
-c          minimum CO2 mix. ratio below which mixing occur with layer above: 
-           qco2min =0.75  
-         end if
-      ENDIF
-      zcpi=1./cpp
-c
-c======================================================================
-c    Calcul of CO2 condensation sublimation 
-c    ============================================================
-c  
-c    Used variable :
-c       piceco2(ngrid)   :  amount of co2 ice on the ground (kg/m2)
-c       zcondicea(ngrid,l):  condensation rate in layer  l  (kg/m2/s)
-c       zcondices(ngrid):  condensation rate on the ground (kg/m2/s)
-c       zfallice(ngrid,l):amount of ice falling from layer l (kg/m2/s)
-c                           
-c       pdtc(ngrid,nlayermx)  : dT/dt due to cond/sub
-c
-c
-c     Tendencies set to 0 (except pdtc)
-c     -------------------------------------
-      DO l=1,nlayer
-         DO ig=1,ngrid
-           zcondicea(ig,l) = 0.
-           zfallice(ig,l) = 0.
-           pduc(ig,l)  = 0
-           pdvc(ig,l)  = 0
-         END DO
-      END DO
-         
-      DO iq=1,nqmx         
-      DO l=1,nlayer
-         DO ig=1,ngrid
-           pdqc(ig,l,iq)  = 0
-         END DO
-      END DO
-      END DO
-
-      DO ig=1,ngrid
-         zfallice(ig,nlayer+1) = 0.
-         zcondices(ig) = 0.
-         pdtsrfc(ig) = 0.
-         pdpsrf(ig) = 0.
-         condsub(ig) = .false.
-         zdiceco2(ig) = 0.
-      ENDDO
-      zfallheat=0
-
-c     *************************
-c     ATMOSPHERIC CONDENSATION
-c     *************************
-
-c     Compute CO2 Volume mixing ratio
-c     -------------------------------
-      if (improved_ztcond.and.(ico2.ne.0)) then
-         DO l=1,nlayer
-            DO ig=1,ngrid
-              qco2=pq(ig,l,ico2)+pdq(ig,l,ico2)*ptimestep
-c             Mean air molecular mass = 1/(q(ico2)/m_co2 + (1-q(ico2))/m_noco2)
-              mmean=1/(A*qco2 +B)
-              vmr_co2(ig,l) = qco2*mmean/m_co2 
-            ENDDO
-         ENDDO
-      else
-         DO l=1,nlayer
-            DO ig=1,ngrid
-              vmr_co2(ig,l)=0.95
-            ENDDO
-         ENDDO
-      end if
-
-c     forecast of atmospheric temperature zt and frost temperature ztcond
-c     --------------------------------------------------------------------
-
-      DO l=1,nlayer
-         DO ig=1,ngrid
-            zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
-!            ztcond(ig,l)=1./(bcond-acond*log(.0095*pplay(ig,l)))
-            ztcond(ig,l)=
-     &         1./(bcond-acond*log(.01*vmr_co2(ig,l)*pplay(ig,l)))
-            if (pplay(ig,l).lt.1e-4) ztcond(ig,l)=0.0 !mars Monica
-         ENDDO
-      ENDDO
- 
-c      Condensation/sublimation in the atmosphere
-c      ------------------------------------------
-c      (calcul of zcondicea , zfallice and pdtc)
-c
-      DO l=nlayer , 1, -1
-         DO ig=1,ngrid
-           pdtc(ig,l)=0.
-           IF((zt(ig,l).LT.ztcond(ig,l)).or.(zfallice(ig,l+1).gt.0))THEN
-               condsub(ig)=.true.
-               IF (zfallice(ig,l+1).gt.0) then  
-                 zfallheat=zfallice(ig,l+1)*
-     &           (pphi(ig,l+1)-pphi(ig,l) +
-     &          cpice*(ztcond(ig,l+1)-ztcond(ig,l)))/latcond
-               ELSE
-                   zfallheat=0.
-               ENDIF
-               pdtc(ig,l)=(ztcond(ig,l) - zt(ig,l))/ptimestep
-               zcondicea(ig,l)=(pplev(ig,l)-pplev(ig,l+1))
-     &                        *ccond*pdtc(ig,l)- zfallheat
-c              Case when the ice from above sublimes entirely
-c              """""""""""""""""""""""""""""""""""""""""""""""
-               IF (zfallice(ig,l+1).lt.- zcondicea(ig,l)) then
-                  pdtc(ig,l)=(-zfallice(ig,l+1)+zfallheat)/
-     &              (ccond*(pplev(ig,l)-pplev(ig,l+1)))
-                  zcondicea(ig,l)= -zfallice(ig,l+1)
-               END IF
-
-               zfallice(ig,l) = zcondicea(ig,l)+zfallice(ig,l+1)
-            END IF
-         ENDDO
-      ENDDO
-
-c     *************************
-c       SURFACE  CONDENSATION
-c     *************************
-
-c     forecast of ground temperature ztsrf and frost temperature ztcondsol
-c     --------------------------------------------------------------------
-      DO ig=1,ngrid
-         ztcondsol(ig)=
-     &          1./(bcond-acond*log(.01*vmr_co2(ig,1)*pplev(ig,1)))
-         ztsrf(ig) = ptsrf(ig) + pdtsrf(ig)*ptimestep
-      ENDDO
-
-c
-c      Condensation/sublimation on the ground 
-c      --------------------------------------
-c      (calcul of zcondices , pdtsrfc)
-c
-      DO ig=1,ngrid
-         IF(ig.GT.ngrid/2+1) THEN
-            icap=2
-         ELSE
-            icap=1
-         ENDIF
-       
-c
-c        Loop on where we have  condensation/ sublimation 
-         IF ((ztsrf(ig) .LT. ztcondsol(ig)) .OR.   ! ground cond 
-     $       (zfallice(ig,1).NE.0.) .OR.           ! falling snow
-     $      ((ztsrf(ig) .GT. ztcondsol(ig)) .AND.  ! ground sublim.
-     $      ((piceco2(ig)+zfallice(ig,1)*ptimestep) .NE. 0.))) THEN
-            condsub(ig) = .true. 
-
-            IF (zfallice(ig,1).gt.0) then  
-                 zfallheat=zfallice(ig,1)*
-     &           (pphi(ig,1)- phisfi(ig) +
-     &           cpice*(ztcond(ig,1)-ztcondsol(ig)))/(latcond*ptimestep)
-            ELSE
-                 zfallheat=0.
-            ENDIF
-
-c           condensation or partial sublimation of CO2 ice
-c           """""""""""""""""""""""""""""""""""""""""""""""
-            zcondices(ig)=pcapcal(ig)*(ztcondsol(ig)-ztsrf(ig)) 
-     &      /(latcond*ptimestep)         - zfallheat
-            pdtsrfc(ig) = (ztcondsol(ig) - ztsrf(ig))/ptimestep
-       
-c           If the entire CO_2 ice layer sublimes
-c           """"""""""""""""""""""""""""""""""""""""""""""""""""
-c           (including what has just condensed in the atmosphere)
-
-            IF((piceco2(ig)/ptimestep+zfallice(ig,1)).LE.
-     &          -zcondices(ig))THEN
-               zcondices(ig) = -piceco2(ig)/ptimestep - zfallice(ig,1) 
-               pdtsrfc(ig)=(latcond/pcapcal(ig))*
-     &         (zcondices(ig)+zfallheat)
-            END IF
-
-c           Changing CO2 ice amount and pressure :
-c           """"""""""""""""""""""""""""""""""""
-
-            zdiceco2(ig) = zcondices(ig) + zfallice(ig,1)
-            piceco2(ig) = piceco2(ig) + zdiceco2(ig)*ptimestep
-            pdpsrf(ig) = -zdiceco2(ig)*g
-
-            IF(ABS(pdpsrf(ig)*ptimestep).GT.pplev(ig,1)) THEN
-               PRINT*,'STOP in condens'
-               PRINT*,'condensing more than total mass'
-               PRINT*,'Grid point ',ig
-               PRINT*,'Ps = ',pplev(ig,1)
-               PRINT*,'d Ps = ',pdpsrf(ig)
-               STOP
-            ENDIF
-         END IF ! if there is condensation/sublimmation
-      ENDDO ! of DO ig=1,ngrid
-
-c  ********************************************************************
-c  Surface albedo and emissivity of the surface below the snow (emisref)
-c  ********************************************************************
-c     Prepare the case where albedo varies with insolation:
-c     ----------------------------------------------------
-!      if (fluxdependent) then
-!
-c       Calcul du flux moyen (zonal mean)
-!        do j=1,jjp1
-!           Fluxmean(j)=0      
-!           do i=1,iim
-!               ig=1+(j-2)*iim +i
-!               if(j.eq.1) ig=1
-!               if(j.eq.jjp1) ig=ngrid
-!               Fluxmean(j)=Fluxmean(j)+fluxsurf_sw(ig,1)
-!     $            +fluxsurf_sw(ig,2)
-!           enddo
-!           Fluxmean(j)=Fluxmean(j)/float(iim)
-!        enddo
-!
-c       const A and B used to calculate the albedo which depends on solar flux 
-c       albedice=constA+constB*Flux
-c       constT = time step to calculate the solar flux when flux decreases         
-!         constA=0.26
-c        constA=0.33
-c        constA=0.186
-!         constB=0.00187
-!         constT=10
-!      endif ! of if (fluxdependent)
-
-!     Check that amont of CO2 ice is not problematic
-      DO ig=1,ngrid
-           if(.not.piceco2(ig).ge.0.) THEN
-              if(piceco2(ig).le.-5.e-8) print*,
-     $         'WARNING newcondens piceco2(',ig,')=', piceco2(ig)
-               piceco2(ig)=0.
-           endif
-      ENDDO
-      
-!     Set albedo and emissivity of the surface
-!     ----------------------------------------
-      CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref)
-
-c     Calcul de l'albedo
-c     ------------------
-!         do ig =1,ngrid
-!           IF(ig.GT.ngrid/2+1) THEN
-!              icap=2
-!           ELSE
-!              icap=1
-!           ENDIF
-!           IF(firstcall2) THEN
-!           albediceF(ig)=albedice(icap)
-!           ENDIF
-c       if there is still co2ice        ccccccccccccccccccccccc
-!           if (piceco2(ig).gt.0) then
-!              emisref(ig) = emisice(icap)
-
-c     if flux dependent albedo is used 
-c     --------------------------------
-!             if (fluxdependent) then
-!                j=INT((ig-2)/iim)+2
-!                if(ig.eq.1) j=1
-!                if(ig.eq.ngrid) j=jjp1
-c                albediceF_new(ig)=MIN(constA+constB*Fluxmean(j),
-c     $          constA+constB*250)
-!                  albediceF_new(ig)=constA+constB*Fluxmean(j)
-!                if (albediceF(ig).gt.albediceF_new(ig)) then
-!                   albediceF(ig)=albediceF(ig)+ ptimestep/(daysec*
-!     $             constT)*(albediceF_new(ig)-albediceF(ig))
-!                else
-!                   albediceF(ig)=albediceF_new(ig)
-!                endif
-c               if part of the ice is transparent
-c               slopy = pente de la droite:  alpha = y*co2ice/1620
-c               pour une valeur superieur a une epaisseur de glace donnee
-c               ici, epaisseur limite = 10cm
-!                if (transparency) then
-!                slopy=1/(1620*0.10)
-!                alpha=MIN(slopy*piceco2(ig),1.)
-!                psolaralb(ig,1) = alpha*albediceF(ig)
-!     $                           +(1-alpha)*albedodat(ig) 
-!                psolaralb(ig,2) = psolaralb(ig,1) 
-!                else
-!                psolaralb(ig,1) = albediceF(ig) 
-!                psolaralb(ig,2) = psolaralb(ig,1) 
-!                endif
-!             else
-c           transparency set to true and fluxdependent set to false            
-!                if (transparency) then
-!                slopy=1/(1620*0.10)
-!                alpha=MIN(slopy*piceco2(ig),1.)
-!                psolaralb(ig,1) = alpha*albedice(icap)
-!     $                           +(1-alpha)*albedodat(ig) 
-!                psolaralb(ig,2) = psolaralb(ig,1) 
-!                else
-c           simplest case: transparency and flux dependent set to false
-!                psolaralb(ig,1) = albedice(icap)
-!                psolaralb(ig,2) = albedice(icap)
-!                endif
-!             endif    
-c         no more co2ice, albedo = ground albedo
-!           else
-!              psolaralb(ig,1) = albedodat(ig)
-!              psolaralb(ig,2) = albedodat(ig)
-!              emisref(ig) = emissiv
-!              pemisurf(ig) = emissiv
-!           endif
-!         end do ! end of the ig loop
-
-! set pemisurf() to emissiv when there is bare surface (needed for co2snow)
-      DO ig=1,ngrid
-        if (piceco2(ig).eq.0) then
-          pemisurf(ig)=emissiv
-        endif
-      ENDDO
-
-!         firstcall2=.false.
-c ***************************************************************
-c  Correction to account for redistribution between sigma or hybrid 
-c  layers when changing surface pressure (and warming/cooling
-c  of the CO2 currently changing phase).
-c *************************************************************
-
-      DO ig=1,ngrid
-        if (condsub(ig)) then
-           do l=1,nlayer
-             ztc(l)  =zt(ig,l)   +pdtc(ig,l)  *ptimestep
-             zu(l)   =pu(ig,l)   +pdu( ig,l)  *ptimestep
-             zv(l)   =pv(ig,l)   +pdv( ig,l)  *ptimestep
-            do iq=1,nqmx
-             zq(l,iq)=pq(ig,l,iq)+pdq(ig,l,iq)*ptimestep
-            enddo
-           end do
-
-c  Mass fluxes through the sigma levels (kg.m-2.s-1)  (>0 when up)
-c  """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
-
-            zmflux(1) = -zcondices(ig)
-            DO l=1,nlayer
-             zmflux(l+1) = zmflux(l) -zcondicea(ig,l)
-     &        + (bp(l)-bp(l+1))*(zfallice(ig,1)-zmflux(1))
-c zmflux set to 0 if very low to avoid: top layer is disappearing in v1ld  
-          if (abs(zmflux(l+1)).lt.1E-13.OR.bp(l+1).eq.0.) zmflux(l+1)=0.
-            END DO
-
-c Mass of each layer
-c ------------------ 
-            DO l=1,nlayer
-              masse(l)=(pplev(ig,l) - pplev(ig,l+1))/g
-            END DO
-
-
-c  Corresponding fluxes for T,U,V,Q
-c  """"""""""""""""""""""""""""""""
-
-c           averaging operator for TRANSPORT  
-c           """"""""""""""""""""""""""""""""
-c           Value transfert at the surface interface when condensation
-c           sublimation:
-            ztm(1) = ztsrf(ig) + pdtsrfc(ig)*ptimestep
-            zum(1) = 0  
-            zvm(1) = 0  
-            do iq=1,nqmx
-              zqm(1,iq)=0. ! most tracer do not condense !
-            enddo
-c           Special case if one of the tracer is CO2 gas
-            if (ico2.ne.0) zqm(1,ico2)=1. ! flux is 100% CO2
-
-c           Van Leer scheme:
-            DO l=1,nlayer+1
-                w(l)=-zmflux(l)*ptimestep
-            END DO
-            call vl1d(ztc,2.,masse,w,ztm) 
-            call vl1d(zu ,2.,masse,w,zum) 
-            call vl1d(zv ,2.,masse,w,zvm) 
-            do iq=1,nqmx
-             do l=1,nlayer
-              zq1(l)=zq(l,iq)
-             enddo
-             zqm1(1)=zqm(1,iq)
-             call vl1d(zq1,2.,masse,w,zqm1)
-             do l=2,nlayer
-              zq( l,iq)=zq1(l)
-              zqm(l,iq)=zqm1(l)
-             enddo
-            enddo
-
-c           Surface condensation affects low winds
-            if (zmflux(1).lt.0) then 
-                zum(1)= zu(1) *  (w(1)/masse(1))
-                zvm(1)= zv(1) *  (w(1)/masse(1))
-                if (w(1).gt.masse(1)) then ! ensure numerical stability
-                  zum(1)= (zu(1)-zum(2))*masse(1)/w(1) + zum(2)
-                  zvm(1)= (zv(1)-zvm(2))*masse(1)/w(1) + zvm(2)
-                end if
-            end if
-                    
-            ztm(nlayer+1)= ztc(nlayer) ! should not be used, but... 
-            zum(nlayer+1)= zu(nlayer)  ! should not be used, but...
-            zvm(nlayer+1)= zv(nlayer)  ! should not be used, but...
-            do iq=1,nqmx
-             zqm(nlayer+1,iq)= zq(nlayer,iq)
-            enddo
- 
-CCCC
-CCCC *** WRF comments
-CCCC
-cc           Tendencies on T, U, V, Q 
-cc           """"""""""""""""""""""""
-!            DO l=1,nlayer
-! 
-!c             Tendencies on T
-!                zdtsig(ig,l) = (1/masse(l)) *
-!     &        ( zmflux(l)*(ztm(l) - ztc(l)) 
-!     &        - zmflux(l+1)*(ztm(l+1) - ztc(l))
-!     &        + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l))  )
-!                pdtc(ig,l) =  pdtc(ig,l) + zdtsig(ig,l)
-!
-!c             Tendencies on U
-!                pduc(ig,l)   = (1/masse(l)) *
-!     &        ( zmflux(l)*(zum(l) - zu(l))
-!     &        - zmflux(l+1)*(zum(l+1) - zu(l)) )
-!
-!
-!c             Tendencies on V
-!                pdvc(ig,l)   = (1/masse(l)) *
-!     &        ( zmflux(l)*(zvm(l) - zv(l))
-!     &        - zmflux(l+1)*(zvm(l+1) - zv(l)) )
-!
-!            END DO
-
-c           Tendencies on Q
-            do iq=1,nqmx
-!              if (noms(iq).eq.'co2') then 
-              if (iq.eq.ico2) then 
-c               SPECIAL Case when the tracer IS CO2 :
-                DO l=1,nlayer
-                  pdqc(ig,l,iq)= (1/masse(l)) *
-     &           ( zmflux(l)*(zqm(l,iq) - zq(l,iq))
-     &           - zmflux(l+1)*(zqm(l+1,iq) - zq(l,iq)) 
-     &           + zcondicea(ig,l)*(zq(l,iq)-1.) )
-                END DO
-              else
-                DO l=1,nlayer
-                  pdqc(ig,l,iq)= (1/masse(l)) *
-     &           ( zmflux(l)*(zqm(l,iq) - zq(l,iq))
-     &           - zmflux(l+1)*(zqm(l+1,iq) - zq(l,iq)) 
-     &           + zcondicea(ig,l)*zq(l,iq) )
-                END DO
-              end if
-            enddo
-
-c           --------------------------------------------------------
-c           Roughly Simulate Molecular mixing when CO2 is too depleted by
-c           Surface condensation (mixing starts if qco2 < qco2min )  
-c           FF 06/2004
-c           WARNING : this is now done in convadj, better (FF 02/2005)
-c           --------------------------------------------------------
-            flag=0  ! now done in convadj : must be =0
-            if (flag.eq.1) then 
-            if(ico2.gt.0) then   ! relevant only if one tracer is CO2
-             if(pq(ig,1,ico2)+(pdq(ig,1,ico2)+pdqc(ig,1,ico2))*ptimestep
-     &       .lt.qco2min) then 
-                do iq=1,nqmx
-                  zq(1,iq)=pq(ig,1,iq)
-     &                     +(pdq(ig,1,iq)+pdqc(ig,1,iq))*ptimestep
-                  Smq(1,iq) = masse(1)*zq(1,iq)
-                end do
-                Sm(1)  = masse(1)
-                do l =2,nlayermx
-                  do iq=1,nqmx
-                     zq(l,iq)=pq(ig,l,iq)
-     &                        +(pdq(ig,l,iq)+pdqc(ig,l,iq))*ptimestep
-                     smq(l,iq) = smq(l-1,iq) + masse(l)*zq(l,iq)
-                  end do 
-                  sm(l) = sm(l-1) + masse(l)
-                  if(zq(l,ico2).gt.qco2min) then 
-c                   mixmas: mass of atmosphere that must be mixed to reach qco2min
-                    mixmas = (sm(l-1)*zq(l,ico2)-Smq(l-1,ico2))
-     &                      /(zq(l,ico2)-qco2min)
-                    if((mixmas.le.sm(l)))then
-c                      OK if mixed mass less than mass of layers affected
-                       nmix=l   ! number of layer affected by mixing
-                       goto 99 
-                    end if
-                  end if
-                 end do
- 99              continue 
-                 do iq=1,nqmx
-                   qmix=zq(nmix,iq) 
-     &             +(Smq(nmix-1,iq)-zq(nmix,iq)*Sm(nmix-1))/mixmas
-                   do l=1,nmix-1
-                      pdqc(ig,l,iq)=
-     &                  (qmix-pq(ig,l,iq))/ptimestep - pdq(ig,l,iq)
-                   end do 
-c                  layer only partly mixed :
-                   pdqc(ig,nmix,iq)=(
-     &             qmix+(Sm(nmix)-mixmas)*(zq(nmix,iq)-qmix)/masse(nmix)
-     &             -pq(ig,nmix,iq))/ptimestep -pdq(ig,nmix,iq)
-
-                 end do 
-             end if
-            end if
-
-        endif   ! (flag.eq.1)
-       end if ! if (condsub)
-      END DO  ! loop on ig 
-
-c ***************************************************************
-c   CO2 snow / clouds scheme
-c ***************************************************************
-
-      call co2snow(ngrid,nlayer,ptimestep,emisref,condsub,pplev,
-     &        zcondicea,zcondices,zfallice,pemisurf)
-
-c ***************************************************************
-c Ecriture des diagnostiques
-c ***************************************************************
-
-c     DO l=1,nlayer
-c        DO ig=1,ngrid
-c         Taux de cond en kg.m-2.pa-1.s-1
-c          tconda1(ig,l)=zcondicea(ig,l)/(pplev(ig,l)-pplev(ig,l+1))
-c          Taux de cond en kg.m-3.s-1
-c          tconda2(ig,l)=tconda1(ig,l)*pplay(ig,l)*g/(r*pt(ig,l))
-c        END DO
-c     END DO
-c     call WRITEDIAGFI(ngridmx,'tconda1',
-c    &'Taux de condensation CO2 atmospherique /Pa',
-c    & 'kg.m-2.Pa-1.s-1',3,tconda1)
-c     call WRITEDIAGFI(ngridmx,'tconda2',
-c    &'Taux de condensation CO2 atmospherique /m',
-c    & 'kg.m-3.s-1',3,tconda2)
-
-! output falling co2 ice in 1st layer:
-!      call WRITEDIAGFI(ngridmx,'fallice',
-!     &'Precipitation of co2 ice',
-!     & 'kg.m-2.s-1',2,zfallice(1,1))
-
-!! Specific stuff to bound co2 tracer values ....
-      if (bound_qco2.and.(ico2.ne.0)) then
-        do ig=1,ngridmx
-          do l=1,nlayermx
-            zqco2=pq(ig,l,ico2)
-     &            +(pdq(ig,l,ico2)+pdqc(ig,l,ico2))*ptimestep
-            if (zqco2.gt.qco2max) then
-            ! correct pdqc:
-              pdqc(ig,l,ico2)=((qco2max-pq(ig,l,ico2))/ptimestep)
-     &                               -pdq(ig,l,ico2)
-              write(*,*) "newcondens: adapting pdqc(ig,l,ico2)",
-     &                   " so that co2 conc. does not exceed",qco2max
-              write(*,*) "   ig:",ig,"  l:",l
-            endif ! of if (zqco2.gt.qco2max)
-            if (zqco2.lt.qco2mini) then
-            ! correct pdqc:
-              pdqc(ig,l,ico2)=((qco2mini-pq(ig,l,ico2))/ptimestep)
-     &                               -pdq(ig,l,ico2)
-              write(*,*) "newcondens: adapting pdqc(ig,l,ico2)",
-     &                   " so that co2 conc. is not less than",qco2mini
-              write(*,*) "   ig:",ig,"  l:",l
-            endif ! of if (zqco2.lt.qco2mini)
-          end do 
-        enddo
-      endif ! of if (bound_qco2.and.(ico2.ne.0)) then
-
-      return
-      end
-
-
-
-c *****************************************************************
-      SUBROUTINE vl1d(q,pente_max,masse,w,qm)
-c
-c    
-c     Operateur de moyenne inter-couche pour calcul de transport type
-c     Van-Leer " pseudo amont " dans la verticale
-c    q,w sont des arguments d'entree  pour le s-pg ....
-c    masse : masse de la couche Dp/g
-c    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
-c    pente_max = 2 conseillee
-c
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-
-#include "dimensions.h"
-
-c
-c
-c
-c   Arguments:
-c   ----------
-      real masse(llm),pente_max
-      REAL q(llm),qm(llm+1)
-      REAL w(llm+1)
-c
-c      Local 
-c   ---------
-c
-      INTEGER l
-c
-      real dzq(llm),dzqw(llm),adzqw(llm),dzqmax
-      real sigw, Mtot, MQtot
-      integer m 
-c     integer ismax,ismin 
-
-
-c    On oriente tout dans le sens de la pression 
-c     W > 0 WHEN DOWN !!!!!!!!!!!!!
-
-      do l=2,llm
-            dzqw(l)=q(l-1)-q(l)
-            adzqw(l)=abs(dzqw(l))
-      enddo
-
-      do l=2,llm-1
-            if(dzqw(l)*dzqw(l+1).gt.0.) then
-                dzq(l)=0.5*(dzqw(l)+dzqw(l+1))
-            else
-                dzq(l)=0.
-            endif
-            dzqmax=pente_max*min(adzqw(l),adzqw(l+1))
-            dzq(l)=sign(min(abs(dzq(l)),dzqmax),dzq(l))
-      enddo
-
-         dzq(1)=0.
-         dzq(llm)=0.
-
-       do l = 1,llm-1
-
-c         Regular scheme (transfered mass < layer mass)
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          if(w(l+1).gt.0. .and. w(l+1).le.masse(l+1)) then
-             sigw=w(l+1)/masse(l+1)
-             qm(l+1)=(q(l+1)+0.5*(1.-sigw)*dzq(l+1))
-          else if(w(l+1).le.0. .and. -w(l+1).le.masse(l)) then
-             sigw=w(l+1)/masse(l)
-             qm(l+1)=(q(l)-0.5*(1.+sigw)*dzq(l))
-
-c         Extended scheme (transfered mass > layer mass)
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-          else if(w(l+1).gt.0.) then
-             m=l+1
-             Mtot = masse(m)
-             MQtot = masse(m)*q(m)
-             do while ((m.lt.llm).and.(w(l+1).gt.(Mtot+masse(m+1))))
-                m=m+1
-                Mtot = Mtot + masse(m)
-                MQtot = MQtot + masse(m)*q(m)
-             end do
-             if (m.lt.llm) then
-                sigw=(w(l+1)-Mtot)/masse(m+1)
-                qm(l+1)= (1/w(l+1))*(MQtot + (w(l+1)-Mtot)*
-     &          (q(m+1)+0.5*(1.-sigw)*dzq(m+1)) )
-             else
-                w(l+1) = Mtot
-                qm(l+1) = Mqtot / Mtot
-                write(*,*) 'top layer is disapearing !'
-                stop
-             end if
-          else      ! if(w(l+1).lt.0) 
-             m = l-1 
-             Mtot = masse(m+1)
-             MQtot = masse(m+1)*q(m+1)
-             do while ((m.gt.0).and.(-w(l+1).gt.(Mtot+masse(m))))
-                m=m-1
-                Mtot = Mtot + masse(m+1)
-                MQtot = MQtot + masse(m+1)*q(m+1)
-             end do
-             if (m.gt.0) then
-                sigw=(w(l+1)+Mtot)/masse(m)
-                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)* 
-     &          (q(m)-0.5*(1.+sigw)*dzq(m))  )
-             else
-                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)*qm(1))
-             end if   
-          end if
-       enddo
-
-c     boundary conditions (not used in newcondens !!)
-c         qm(llm+1)=0.
-c         if(w(1).gt.0.) then
-c            qm(1)=q(1)
-c         else 
-c           qm(1)=0.
-c         end if
-
-      return
-      end
Index: unk/mesoscale/COMMON_GCM/ajouts/meso_param_slope.F90
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_param_slope.F90	(revision 46)
+++ 	(revision )
@@ -1,220 +1,0 @@
-SUBROUTINE meso_param_slope( &
-  !
-  ! INPUTS
-  !
-               &  csza, declin, rho, latitude &
-               &  ,taudust, albedo  &
-               &  ,theta_s, psi_s &
-               &  ,fdir_0, ftot_0  &
-  !
-  ! OUTPUTS
-  !
-               &  ,ftot &
- )
-
-
-!!*****************************************************************************************
-!
-! SUBROUTINE:
-! param_slope
-! 
-!
-! PURPOSE: 
-! computes total solar irradiance on a given Martian slope 
-!
-!
-! INPUTS:
-! csza		cosine solar zenith angle
-! declin	sun declination (rad)
-! rho		sun right ascension (rad)
-! latitude	latitude (deg)
-! taudust	dust optical depth at reference wavelength 0.67 mic. 
-! albedo	spectrally integrated surface Lambertian reflection albedo 
-! theta_s	slope inclination angle (deg)
-!			0 is horizontal, 90 is vertical
-! phi_s		slope azimuth (deg) 
-!       		0 >> Northward
-!       		90 >> Eastward
-!       		180 >> Southward
-!       		270 >> Westward
-! ftot_0	spectrally integrated total irradiance on an horizontal surface (W/m2)
-! fdir_0	spectrally integrated direct irradiance on an horizontal surface (W/m2)
-!
-!
-! OUTPUTS:
-! ftot		spectrally integrated total irradiance on the slope (W/m2)
-!
-! REFERENCE: 
-! "Fast and accurate estimation of irradiance on Martian slopes"
-! A. Spiga & F. Forget
-! .....
-!
-! AUTHOR: 
-! A. Spiga (spiga@lmd.jussieu.fr)
-! March 2008
-!
-!!*****************************************************************************************
-
-IMPLICIT NONE
-
-!!
-!! INPUT
-!!
-REAL, INTENT(IN) :: csza, declin, rho, latitude, taudust, theta_s, psi_s, albedo, ftot_0 , fdir_0 
-
-!!
-!! LOCAL
-!!
-REAL :: pi, deg2rad
-REAL :: a
-REAL :: mu_s, sigma_s
-REAL :: fdir, fscat, fscat_0, fref
-REAL, DIMENSION(4,2) :: mat_M, mat_N, mat_T
-REAL, DIMENSION(2) :: g_vector
-REAL, DIMENSION(4) :: s_vector
-REAL :: ratio
-
-!!
-!! OUTPUT
-!!
-REAL, INTENT(OUT) :: ftot
-
-!!*****************************************************************************************
-
-!
-! Prerequisite
-!
-  pi = 2.*asin(1.)
-  deg2rad = pi/180.
-  if ((theta_s > 90.) .or. (theta_s < 0.)) then
-	print *, 'please set theta_s between 0 and 90', theta_s
-	stop 
-  endif
-
-!
-! Solar Zenith angle (radian) 
-!
-  if (csza .lt. 0.01) then
-      !print *, 'sun below horizon' 
-      !fdir_0=0.
-      fdir=0.
-      fscat_0=0.
-      fscat=0.   
-      fref=0.
-  else
-
-!!
-!! Low incidence fix
-!! 
-!  if (csza .lt. 0.15) csza = 0.15
-
-!
-! 'Slope vs Sun' azimuth (radian)
-!
-  if ( ( (cos(declin)*sin(rho)) .eq. 0.0 ) &
-               .and. &
-     ( ( sin(deg2rad*latitude)*cos(declin)*cos(rho) &
-              -cos(deg2rad*latitude)*sin(declin) ) .eq. 0.0 ) ) then
-    a = deg2rad*psi_s ! some compilator need specfying value for atan2(0,0)  
-  else
-    a = deg2rad*psi_s + atan2(cos(declin)*sin(rho), &
-               sin(deg2rad*latitude)*cos(declin)*cos(rho)-cos(deg2rad*latitude)*sin(declin))
-  end if
-  
-!
-! Cosine of slope-sun phase angle 
-!
-  mu_s = csza*cos(deg2rad*theta_s) - cos(a)*sin(deg2rad*theta_s)*sqrt(1-csza**2)
-  if (mu_s .le. 0.) mu_s=0.
-
-!
-! Sky-view factor
-!
-  sigma_s=0.5*(1.+cos(deg2rad*theta_s))
-
-!
-! Direct flux on the slope
-!
-  fdir = fdir_0 * mu_s/csza
-
-!
-! Reflected flux on the slope
-!
-  fref = albedo * (1-sigma_s) * ftot_0
-
-!
-! Scattered flux on a flat surface
-!
-  fscat_0 = ftot_0 - fdir_0
-
-!
-! Scattering vector (slope vs sky)
-!
-  s_vector=(/ 1., exp(-taudust) , sin(deg2rad*theta_s), sin(deg2rad*theta_s)*exp(-taudust) /)
-
-!
-! Geometry vector (slope vs sun)
-!
-  g_vector=(/ mu_s/csza, 1. /)
-
-!
-! Coupling matrix
-!
-  if (csza .ge. 0.5) then
-	mat_M(:,1) = (/ -0.264,  1.309,  0.208, -0.828 /)
-	mat_M(:,2) = (/  1.291*sigma_s, -1.371*sigma_s, -0.581,  1.641 /)
-	mat_N(:,1) = (/  0.911, -0.777, -0.223,  0.623 /)
-	mat_N(:,2) = (/ -0.933*sigma_s,  0.822*sigma_s,  0.514, -1.195 /)
-
-  else
-	mat_M(:,1) = (/ -0.373,  0.792, -0.095,  0.398 /)
-	mat_M(:,2) = (/  1.389*sigma_s, -0.794*sigma_s, -0.325,  0.183 /)
-	mat_N(:,1) = (/  1.079,  0.275,  0.419, -1.855 /)
-	mat_N(:,2) = (/ -1.076*sigma_s, -0.357*sigma_s, -0.075,  1.844 /)
-  endif
-  !
-  mat_T = mat_M + csza*mat_N
-
-
-!
-! Scattered flux slope ratio
-!
-  if (deg2rad*theta_s <= 0.0872664626) then
-  !
-  ! low angles
-  !
-	s_vector = (/ 1., exp(-taudust) , sin(0.0872664626), sin(0.0872664626)*exp(-taudust) /)
-	ratio = DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )
-        ratio = 1. + (ratio - 1.)*deg2rad*theta_s/0.0872664626
-  else
-  !
-  ! general case
-  !
-	ratio= DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )  
-                  !
-                  ! NB: ratio= DOT_PRODUCT ( s_vector, MATMUL( mat_T, g_vector ) ) is equivalent
-  endif
-
-!
-! Scattered flux on the slope
-!
-  fscat = ratio * fscat_0
-
-
-endif !! if (csza < 0.01)
-
-!
-! Total flux on the slope
-!
-  ftot = fdir + fref + fscat
-
-!!
-!! Display results
-!!
-!  print *, 'sca component 0 ', ftot_0-fdir_0
-!  print *, 'dir component 0 ', fdir_0
-!  print *, 'scattered component ', fscat
-!  print *, 'direct component ', fdir
-!  print *, 'reflected component ', fref
-
-END SUBROUTINE meso_param_slope
Index: unk/mesoscale/COMMON_GCM/ajouts/meso_physiq.F
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_physiq.F	(revision 46)
+++ 	(revision )
@@ -1,1809 +1,0 @@
-      SUBROUTINE meso_physiq(ngrid,nlayer,nq,
-     $            firstcall,lastcall,
-     $            wday_ini,
-     $            pday,ptime,ptimestep,
-     $            pplev,pplay,pphi,
-     $            pu,pv,pt,pq,
-     $            pw,
-     $            pdu,pdv,pdt,pdq,pdpsrf,tracerdyn,
-     $            wtsurf,wtsoil,wemis,wq2,wqsurf,wco2ice,
-     $            wisoil,wdsoil,
-     $            wecritphys,
-     $            output_tab2d, output_tab3d,
-     $            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. 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           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"
-
-#include "meso_slope.h"
-#include "wrf_output_2d.h"
-#include "wrf_output_3d.h"
-
-
-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
-c ****WRF
-      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
-      REAL output_tab2d(ngridmx,n2d)
-      REAL output_tab3d(ngridmx,nlayer,n3d)
-      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 alpha,lay1 ! coefficients for building layers
-      integer iloop
-c ****WRF
-      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
-
-      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 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)
-      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        ~~~~~~~~~~~~
-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
-     !!!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
-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
-
-
-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)
-
-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
-         end if ! of if (tracer)
-
-      ELSE    
-         DO ig=1,ngrid
-            zdtsurf(ig)=zdtsurf(ig)+
-     s      (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 meso_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
-         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
-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
-c **WRF : OK avec le mesoscale, pas d'indices bizarres au pole
-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. 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        -------------------------------------------------------------------
-
-         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 
-      enddo
-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...'
-      RETURN
-      END
Index: /trunk/mesoscale/COMMON_GCM/ajouts/meso_readtesassim.F90
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_readtesassim.F90	(revision 47)
+++ /trunk/mesoscale/COMMON_GCM/ajouts/meso_readtesassim.F90	(revision 47)
@@ -0,0 +1,297 @@
+subroutine readtesassim(ngrid,nlayer,zday,pplev,tauref)
+
+! Reading of the dust assimilation file
+
+implicit none
+
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comgeomfi.h"
+#include "netcdf.inc"
+#include "datafile.h"
+#include "callkeys.h"
+
+integer, intent(in) :: ngrid,nlayer
+real, intent(in) :: zday ! date in martian days
+real, dimension(ngrid,nlayer+1), intent(in) :: pplev
+real, dimension(ngrid), intent(out) :: tauref
+
+! Local variables
+
+real :: realday
+integer nid,nvarid,ierr
+integer ltloop,lsloop,iloop,jloop,varloop,ig
+real, dimension(2) :: taubuf
+real tau1(4),tau
+real alt(4)
+integer latp(4),lonp(4)
+integer yinf,ysup,xinf,xsup,tinf,tsup
+real latinf,latsup,loninf,lonsup
+real latintmp,lonintmp,latdeg,londeg
+real colat,dlat,dlon,colattmp
+logical, save :: firstcall=.true.
+logical :: timeflag
+real,save :: radeg,pi
+integer :: timedim,londim,latdim
+real, dimension(:), allocatable, save :: lat,lon,time
+real, dimension(:,:,:), allocatable, save :: tautes
+integer, save :: timelen,lonlen,latlen
+character(len=33) :: filename
+
+realday=mod(zday,669.)
+
+if (firstcall) then
+   firstcall=.false.
+
+   pi=acos(-1.)
+   radeg=180/pi
+   
+   ! assimilated dust file: (NB: iaervar is a common in "callkeys.h")
+   ! iaervar=4 means read dust_tes.nc file
+   ! iaervar=24 means read dust_tes_MY24.nc file
+   ! iaervar=25 means read dust_tes_MY25.nc file
+   ! iaervar=26 means read dust_tes_MY26.nc file
+   if (iaervar.eq.4) then
+     filename="dust_tes.nc"
+   else if (iaervar.eq.24) then
+     filename="dust_tes_MY24.nc" ! which currently is identical to dust_tes.nc
+   else if (iaervar.eq.25) then
+     filename="dust_tes_MY25.nc" 
+   else if (iaervar.eq.26) then
+     filename="dust_tes_MY26.nc"
+   else if ((iaervar.eq.6).or.(iaervar.eq.7)) then ! modified TES scenario
+     filename="modifieddust.nc"
+   endif
+   
+   ! Note: datafile() is defined in "datafile.h"
+   ierr=NF_OPEN(trim(datafile)//"/"//trim(filename),NF_NOWRITE,nid)
+   IF (ierr.NE.NF_NOERR) THEN
+     write(*,*)'Problem opening ',trim(filename),' (in phymars/readtesassim.F90)'
+     write(*,*)'It should be in :',trim(datafile),'/'
+     write(*,*)'1) You can change this directory address in '
+     write(*,*)'   file phymars/datafile.h'
+     write(*,*)'2) If necessary, dust.nc (and other datafiles)'
+     write(*,*)'   can be obtained online on:'
+     write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+     CALL ABORT
+   ENDIF
+
+   ierr=NF_INQ_DIMID(nid,"Time",timedim)
+   ierr=NF_INQ_DIMLEN(nid,timedim,timelen)
+   ierr=NF_INQ_DIMID(nid,"latitude",latdim)
+   ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
+   ierr=NF_INQ_DIMID(nid,"longitude",londim)
+   ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
+
+   allocate(tautes(lonlen,latlen,timelen))
+   allocate(lat(latlen), lon(lonlen), time(timelen))
+
+   ierr = NF_INQ_VARID (nid, "dustop",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tautes)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, tautes)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <dustop> not found"
+      stop
+   ENDIF
+   ierr = NF_INQ_VARID (nid, "Time",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, time)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <Time> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "latitude",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lat)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lat)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <latitude> not found"
+      stop
+   ENDIF
+
+   ierr = NF_INQ_VARID (nid, "longitude",nvarid)
+#ifdef NC_DOUBLE
+   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lon)
+#else
+   ierr = NF_GET_VAR_REAL(nid, nvarid, lon)
+#endif
+   IF (ierr .NE. NF_NOERR) THEN
+      PRINT*, "Error: Readtesassim <longitude> not found"
+      stop
+   ENDIF
+
+endif ! of if (firstcall)
+
+do ig=1,ngrid
+
+! Find the four nearest points, arranged as follows:
+!                               1 2
+!                               3 4
+
+   latdeg=lati(ig)*radeg  ! latitude, in degrees
+   londeg=long(ig)*radeg  ! longitude, in degrees east
+   colat=90-latdeg        ! colatitude, in degrees
+
+ ! Find encompassing latitudes
+   if (colat<(90-lat(1))) then ! between north pole and lat(1)
+      ysup=1
+      yinf=1
+   else if (colat>=90-(lat(latlen))) then ! between south pole and lat(laten)
+      ysup=latlen
+      yinf=latlen
+   else ! general case
+      do iloop=2,latlen
+         if(colat<(90-lat(iloop))) then
+           ysup=iloop-1
+           yinf=iloop
+           exit
+         endif
+      enddo
+   endif
+
+   latinf=lat(yinf)
+   latsup=lat(ysup)
+
+
+ ! Find encompassing longitudes
+   ! Note: in input file, lon(1)=-180.
+   if (londeg>lon(lonlen)) then
+      xsup=1
+      xinf=lonlen
+      loninf=lon(xsup)
+      lonsup=180.0 ! since lon(1)=-180.0
+   else
+      do iloop=2,lonlen
+         if(londeg<lon(iloop)) then
+              xsup=iloop
+              xinf=iloop-1
+              exit
+         endif
+      enddo
+      loninf=lon(xinf)
+      lonsup=lon(xsup)
+   endif
+
+   if ((xsup.gt.lonlen).OR.(yinf.gt.latlen).OR.(xinf.lt.1)&
+     .OR.(ysup.lt.1)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on x or y in ts_gcm"
+      write (*,*) "xinf: ",xinf
+      write (*,*) "xsup: ",xsup
+      write (*,*) "yinf: ",yinf
+      write (*,*) "ysup: ",ysup
+      stop
+   endif
+
+!   loninf=lon(xinf)
+!   lonsup=lon(xsup)
+!   latinf=lat(yinf)
+!   latsup=lat(ysup)
+
+! The four neighbouring points are arranged as follows:
+!                               1 2
+!                               3 4
+
+   latp(1)=ysup
+   latp(2)=ysup
+   latp(3)=yinf
+   latp(4)=yinf
+
+   lonp(1)=xinf
+   lonp(2)=xsup
+   lonp(3)=xinf
+   lonp(4)=xsup
+
+! Linear interpolation on time, for all four neighbouring points
+
+   if ((realday<time(1)).or.(realday>time(timelen))) then
+      tinf=timelen
+      tsup=1
+      timeflag=.true.
+   else 
+      do iloop=2,timelen
+         if (realday<time(iloop)) then
+            tinf=iloop-1
+            tsup=iloop
+            exit
+         endif
+      enddo
+   endif
+
+! Bilinear interpolation on the four nearest points
+
+   if ((colat<(90-lat(1))).OR.(colat>(90-lat(latlen))).OR.(latsup==latinf)) then
+      dlat=0
+   else
+      dlat=((90-latinf)-colat)/((90-latinf)-(90-latsup))
+   endif
+
+   if (lonsup==loninf) then
+      dlon=0
+   else
+      dlon=(londeg-loninf)/(lonsup-loninf)
+   endif
+
+   do iloop=1,4
+      taubuf(1)=tautes(lonp(iloop),latp(iloop),tinf)
+      taubuf(2)=tautes(lonp(iloop),latp(iloop),tsup)
+      if (timeflag) then
+         if (realday>time(timelen)) then
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)+(669-time(tinf))) 
+         else
+            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*realday/(time(tsup)+(669-time(tinf)))
+         endif
+      else
+         tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)-time(tinf))
+      endif
+      if (tau1(iloop)<0) then
+          write (*,*) "Readtesassim: SYSTEM ERROR on tau"
+          write (*,*) "utime ",realday
+          write (*,*) "time(tinf) ",time(tinf)
+          write (*,*) "time(tsup) ",time(tsup)
+          write (*,*) "tau1 ",taubuf(1)
+          write (*,*) "tau2 ",taubuf(2)
+          write (*,*) "tau ",tau1(iloop)
+          stop
+      endif
+   enddo
+   timeflag=.false.
+
+   if ((dlat>1).OR.(dlon>1) .OR. (dlat<0) .OR. (dlon<0)) then
+      write (*,*) "Readtesassim: SYSTEM ERROR on dlat or dlon in ts_gcm"
+      write (*,*) "dlat: ",dlat
+      write (*,*) "lat: ",latdeg
+      write (*,*) "dlon: ",dlon
+      write (*,*) "lon: ",londeg
+      stop
+   endif
+
+   tau= dlat*(dlon*(tau1(2)+tau1(3)-tau1(1)-tau1(4))+tau1(1)-tau1(3)) +dlon*(tau1(4)-tau1(3))+tau1(3)
+
+! Multiply by correction coefficient (value depends on SW radiative transfer)
+! NB: swrtype is set in callkeys.h
+   if (swrtype.eq.1) then ! Fouquart 
+     tauref(ig)=tau*0.825
+   else
+     if (swrtype.eq.2) then ! Toon
+       tauref(ig)=tau*1.3
+        ! special case for enhanced flushing storm scenario
+        if ((iaervar.eq.7).and.(tauref(ig).gt.1.1*1.3)) then
+          tauref(ig)=2.0*tauref(ig)
+        endif
+     else
+       write(*,*) "readtesassim: wrong value for flag swrtype !"
+       stop
+     endif
+   endif ! of if (swrtype.eq.1)
+enddo
+
+end
Index: unk/mesoscale/COMMON_GCM/ajouts/meso_slope.h
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_slope.h	(revision 46)
+++ 	(revision )
@@ -1,5 +1,0 @@
-      COMMON/comslope/theta_sl(ngridmx),psi_sl(ngridmx)
-
-      REAL theta_sl   ! slope angle versus horizontale (deg)
-      REAL psi_sl     ! orientation of the slope (deg)
-
Index: unk/mesoscale/COMMON_GCM/ajouts/meso_testphys1d.F
===================================================================
--- /trunk/mesoscale/COMMON_GCM/ajouts/meso_testphys1d.F	(revision 46)
+++ 	(revision )
@@ -1,687 +1,0 @@
-
-      PROGRAM meso_testphys1d
-! to use  'getin'
-      USE ioipsl_getincom 
-      IMPLICIT NONE
-
-c=======================================================================
-c   subject:
-c   --------
-c   PROGRAM useful to run physical part of the martian GCM in a 1D column
-c       
-c Can be compiled with a command like (e.g. for 25 layers)
-c  "makegcm -p mars -d 25 testphys1d"
-c It requires the files "testphys1d.def" "callphys.def"
-c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
-c      and a file describing the sigma layers (e.g. "z2sig.def")
-c
-c   author: Frederic Hourdin, R.Fournier,F.Forget
-c   -------
-c   
-c   update: 12/06/2003 including chemistry (S. Lebonnois) 
-c                            and water ice (F. Montmessin)
-c 
-c=======================================================================
-
-#include "dimensions.h"
-#include "dimphys.h"
-#include "dimradmars.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 "yomaer.h"
-#include "control.h"
-#include "comvert.h"
-#include "netcdf.inc"
-#include "comg1d.h"
-#include "watercap.h"
-#include "logic.h"
-#include "advtrac.h"
-
-c --------------------------------------------------------------
-c  Declarations
-c --------------------------------------------------------------
-c
-      INTEGER unitstart      ! unite d'ecriture de "startfi"
-      INTEGER nlayer,nlevel,nsoil,ndt
-      INTEGER ilayer,ilevel,isoil,idt,iq
-      LOGICAl firstcall,lastcall
-c
-      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
-      REAL day           ! date durant le run
-      REAL time             ! time (0<time<1 ; time=0.5 a midi)
-      REAL play(nlayermx)   ! Pressure at the middle of the layers (Pa)
-      REAL plev(nlayermx+1) ! intermediate pressure levels (pa)
-      REAL psurf,tsurf      
-      REAL u(nlayermx),v(nlayermx)  ! zonal, meridional wind
-      REAL gru,grv   ! prescribed "geostrophic" background wind
-      REAL temp(nlayermx)   ! temperature at the middle of the layers
-      REAL q(nlayermx,nqmx) ! tracer mixing ratio (e.g. kg/kg)
-      REAL qsurf(nqmx)      ! tracer surface budget (e.g. kg.m-2)
-      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
-      REAL co2ice           ! co2ice layer (kg.m-2)
-      REAL emis             ! surface layer
-      REAL q2(nlayermx+1)   ! Turbulent Kinetic Energy
-      REAL zlay(nlayermx)   ! altitude estimee dans les couches (km)
-
-c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
-      REAL du(nlayermx),dv(nlayermx),dtemp(nlayermx)
-      REAL dudyn(nlayermx),dvdyn(nlayermx),dtempdyn(nlayermx)
-      REAL dpsurf    
-      REAL dq(nlayermx,nqmx)
-      REAL dqdyn(nlayermx,nqmx)
-
-c   Various intermediate variables
-      INTEGER thermo
-      REAL zls
-      REAL phi(nlayermx),h(nlayermx),s(nlayermx)
-      REAL pks, ptif, w(nlayermx)
-      REAL qtotinit, mqtot(nqmx),qtot
-      INTEGER ierr, aslun
-      REAL tmp1(0:nlayermx),tmp2(0:nlayermx)
-      Logical  tracerdyn
-      integer :: nq=1 ! number of tracers
-
-      character*2 str2
-      character (len=7) :: str7
-      character(len=44) :: txt
-
-c=======================================================================
-
-c=======================================================================
-c INITIALISATION
-c=======================================================================
-
-c ------------------------------------------------------
-c  Constantes prescrites ICI
-c ------------------------------------------------------
-
-      pi=2.E+0*asin(1.E+0)
-
-c     Constante de la Planete Mars
-c     ----------------------------
-      rad=3397200.               ! rayon de mars (m)  ~3397200 m
-      daysec=88775.              ! duree du sol (s)  ~88775 s
-      omeg=4.*asin(1.)/(daysec)  ! vitesse de rotation (rad.s-1)
-      g=3.72                     ! gravite (m.s-2) ~3.72  
-      mugaz=43.49                ! Masse molaire de l'atm (g.mol-1) ~43.49
-      rcp=.256793                ! = r/cp  ~0.256793
-      r= 8.314511E+0 *1000.E+0/mugaz
-      cpp= r/rcp
-      year_day = 669           ! duree de l'annee (sols) ~668.6
-      periheli = 206.66          ! dist.min. soleil-mars (Mkm) ~206.66
-      aphelie = 249.22           ! dist.max. soleil-mars (Mkm) ~249.22
-      peri_day =  485.           ! date du perihelie (sols depuis printemps)
-      obliquit = 25.2           ! Obliquite de la planete (deg) ~25.2         
- 
-c     Parametres Couche limite et Turbulence 
-c     --------------------------------------
-      z0 =  1.e-2                ! surface roughness (m) ~0.01 
-      emin_turb = 1.e-6          ! energie minimale ~1.e-8
-      lmixmin = 30               ! longueur de melange ~100
- 
-c     propriete optiques des calottes et emissivite du sol
-c     ----------------------------------------------------
-      emissiv= 0.95              ! Emissivite du sol martien ~.95
-      emisice(1)=0.95            ! Emissivite calotte nord
-      emisice(2)=0.95            ! Emissivite calotte sud  
-      albedice(1)=0.5           ! Albedo calotte nord
-      albedice(2)=0.5            ! Albedo calotte sud
-      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
-      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
-      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
-      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
-      hybrid=.false.
-
-c ------------------------------------------------------
-c  Lecture des parametres dans "run.def" 
-c ------------------------------------------------------
-
-
-! check if 'run.def' file is around (otherwise reading parameters
-! from callphys.def via getin() routine won't work.
-      open(99,file='run.def',status='old',form='formatted',
-     &     iostat=ierr)
-      if (ierr.ne.0) then
-        write(*,*) 'Cannot find required file "run.def"'
-        write(*,*) '  (which should contain some input parameters'
-        write(*,*) '   along with the following line:'
-        write(*,*) '   INCLUDEDEF=callphys.def'
-        write(*,*) '   )'
-        write(*,*) ' ... might as well stop here ...'
-        stop
-      else
-        close(99)
-      endif
-
-! check if we are going to run with or without tracers
-      write(*,*) "Run with or without tracer transport ?"
-      tracer=.false. ! default value
-      call getin("tracer",tracer)
-      write(*,*) " tracer = ",tracer
-
-! while we're at it, check if there is a 'traceur.def' file
-! and preocess it, if necessary. Otherwise initialize tracer names
-      if (tracer) then
-      ! load tracer names from file 'traceur.def'
-        open(90,file='traceur.def',status='old',form='formatted',
-     &       iostat=ierr)
-        if (ierr.ne.0) then
-          write(*,*) 'Cannot find required file "traceur.def"'
-          write(*,*) ' If you want to run with tracers, I need it'
-          write(*,*) ' ... might as well stop here ...'
-          stop
-        else
-          write(*,*) "testphys1d: Reading file traceur.def"
-          ! read number of tracers:
-          read(90,*,iostat=ierr) nq
-          if (ierr.ne.0) then
-            write(*,*) "testphys1d: error reading number of tracers"
-            write(*,*) "   (first line of traceur.def) "
-            stop
-          else
-            ! check that the number of tracers is indeed nqmx
-            if (nq.ne.nqmx) then
-              write(*,*) "testphys1d: error, wrong number of tracers:"
-              write(*,*) "nq=",nq," whereas nqmx=",nqmx
-              stop
-            endif
-          endif
-        endif
-        ! read tracer names from file traceur.def
-        do iq=1,nqmx
-          read(90,*,iostat=ierr) tnom(iq)
-          if (ierr.ne.0) then
-            write(*,*) 'testphys1d: error reading tracer names...'
-            stop
-          endif
-        enddo
-        close(90)
-
-        ! initialize tracers here:
-        write(*,*) "testphys1d: initializing tracers"
-        q(:,:)=0 ! default, set everything to zero
-        qsurf(:)=0
-        ! "smarter" initialization of some tracers
-        ! (get values from "profile_*" files, if these are available)
-        do iq=1,nqmx
-          txt=""
-          write(txt,"(a)") tnom(iq)
-          write(*,*)"  tracer:",trim(txt)
-          ! CO2
-          if (txt.eq."co2") then
-            q(:,iq)=0.95   ! kg /kg of atmosphere
-            qsurf(iq)=0. ! kg/m2 (not used for CO2)
-            ! even better, look for a "profile_co2" input file
-            open(91,file='profile_co2',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayermx
-                read(91,*) q(ilayer,iq)
-              enddo
-            endif
-            close(91)
-          endif ! of if (txt.eq."co2")
-          ! WATER VAPOUR
-          if (txt.eq."h2o_vap") then
-            !look for a "profile_h2o_vap" input file
-            open(91,file='profile_h2o_vap',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayermx
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_h2o_vap file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."h2o_ice")
-          ! WATER ICE
-          if (txt.eq."h2o_ice") then
-            !look for a "profile_h2o_vap" input file
-            open(91,file='profile_h2o_ice',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayermx
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_h2o_ice file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."h2o_ice")
-          ! DUST
-          !if (txt(1:4).eq."dust") then
-          !  q(:,iq)=0.4    ! kg/kg of atmosphere
-          !  qsurf(iq)=100 ! kg/m2
-          !endif
-          ! DUST MMR
-          if (txt.eq."dust_mass") then
-            !look for a "profile_dust_mass" input file
-            open(91,file='profile_dust_mass',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayermx
-                read(91,*) q(ilayer,iq)
-!                write(*,*) "l=",ilayer," q(ilayer,iq)=",q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_dust_mass file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."dust_mass")
-          ! DUST NUMBER
-          if (txt.eq."dust_number") then
-            !look for a "profile_dust_number" input file
-            open(91,file='profile_dust_number',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayermx
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_dust_number file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."dust_number")
-        enddo ! of do iq=1,nqmx
-        ! NB: some more initializations (chemistry) is done later
-
-      else
-      ! we still need to set (dummy) tracer names for physdem1
-        nq=nqmx
-        do iq=1,nq
-          write(str7,'(a1,i2.2)')'q',iq
-          tnom(iq)=str7
-        enddo
-      endif ! of if (tracer)
-
-c  Date et heure locale du debut du run
-c  ------------------------------------
-c    Date (en sols depuis le solstice de printemps) du debut du run
-      day0 = 0 ! default value for day0
-      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
-      call getin("day0",day0)
-      day=float(day0)
-      write(*,*) " day0 = ",day0
-c  Heure de demarrage
-      time=0 ! default value for time
-      write(*,*)'Initial local time (in hours, between 0 and 24)?'
-      call getin("time",time)
-      write(*,*)" time = ",time
-      time=time/24.E+0 ! convert time (hours) to fraction of sol
-
-c  Discretisation (Definition de la grille et des pas de temps)
-c  --------------
-c
-      nlayer=nlayermx
-      nlevel=nlayer+1
-      nsoil=nsoilmx
-
-      day_step=48 ! default value for day_step
-      PRINT *,'Number of time steps per sol ?'
-      call getin("day_step",day_step)
-      write(*,*) " day_step = ",day_step
-
-      ndt=10 ! default value for ndt
-      PRINT *,'Number of sols to run ?'
-      call getin("ndt",ndt)
-      write(*,*) " ndt = ",ndt
-
-      ndt=ndt*day_step     
-      dtphys=daysec/day_step  
-c Pression de surface sur la planete
-c ------------------------------------
-c
-      psurf=610. ! default value for psurf
-      PRINT *,'Surface pressure (Pa) ?'
-      call getin("psurf",psurf)
-      write(*,*) " psurf = ",psurf
-c Pression de reference
-      pa=20.
-      preff=610.      
- 
-c Proprietes des poussiere aerosol
-c --------------------------------
-      tauvis=0.2 ! default value for tauvis
-      print *,'Reference dust opacity at 700 Pa ?'
-      call getin("tauvis",tauvis)
-      write(*,*) " tauvis = ",tauvis
- 
-c  latitude/longitude
-c  ------------------
-      lati(1)=0 ! default value for lati(1)
-      PRINT *,'latitude (in degrees) ?'
-      call getin("latitude",lati(1))
-      write(*,*) " latitude = ",lati(1)
-      lati(1)=lati(1)*pi/180.E+0
-      long(1)=0.E+0
-      long(1)=long(1)*pi/180.E+0
-
-c  Initialisation albedo / inertie du sol
-c  --------------------------------------
-c
-      albedodat(1)=0.2 ! default value for albedodat
-      PRINT *,'Albedo of bare ground ?'
-      call getin("albedo",albedodat(1))
-      write(*,*) " albedo = ",albedodat(1)
-
-      inertiedat(1,1)=400 ! default value for inertiedat
-      PRINT *,'Soil thermal inertia (SI) ?'
-      call getin("inertia",inertiedat(1,1))
-      write(*,*) " inertia = ",inertiedat(1,1)
-c
-c  pour le schema d'ondes de gravite
-c  ---------------------------------
-c
-      zmea(1)=0.E+0
-      zstd(1)=0.E+0
-      zsig(1)=0.E+0
-      zgam(1)=0.E+0
-      zthe(1)=0.E+0
-
-
-
-c   Initialisation speciales "physiq"
-c   ---------------------------------
-c   la surface de chaque maille est inutile en 1D --->
-      area(1)=1.E+0
-
-c   le geopotentiel au sol est inutile en 1D car tout est controle
-c   par la pression de surface --->
-      phisfi(1)=0.E+0
-
-c  "inifis" reproduit un certain nombre d'initialisations deja faites
-c  + lecture des clefs de callphys.def
-c  + calcul de la frequence d'appel au rayonnement
-c  + calcul des sinus et cosinus des longitude latitude
-
-!Mars possible matter with dtphys in input and include!!!
-      CALL meso_inifis(1,llm,day0,daysec,dtphys,
-     .            lati,long,area,rad,g,r,cpp)
-c   Initialisation pour prendre en compte les vents en 1-D
-c   ------------------------------------------------------
-      ptif=2.E+0*omeg*sinlat(1)
- 
-c    vent geostrophique
-      gru=10. ! default value for gru
-      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
-      call getin("u",gru)
-      write(*,*) " u = ",gru
-      grv=0. !default value for grv
-      PRINT *,'meridional northward component of the geostrophic',
-     &' wind (m/s) ?'
-      call getin("v",grv)
-      write(*,*) " v = ",grv
-
-c     Initialisation des vents  au premier pas de temps
-      DO ilayer=1,nlayer
-         u(ilayer)=gru
-         v(ilayer)=grv
-      ENDDO
-
-c     energie cinetique turbulente
-      DO ilevel=1,nlevel
-         q2(ilevel)=0.E+0
-      ENDDO
-
-c  glace de CO2 au sol
-c  -------------------
-      co2ice=0.E+0 ! default value for co2ice
-      PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
-      call getin("co2ice",co2ice)
-      write(*,*) " co2ice = ",co2ice
-
-c
-c  emissivite
-c  ----------
-      emis=emissiv
-      IF (co2ice.eq.1.E+0) THEN
-         emis=emisice(1) ! northern hemisphere
-         IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
-      ENDIF
-
- 
-
-c  calcul des pressions et altitudes en utilisant les niveaux sigma
-c  ----------------------------------------------------------------
-
-c    Vertical Coordinates
-c    """"""""""""""""""""
-      hybrid=.true.
-      PRINT *,'Hybrid coordinates ?'
-      call getin("hybrid",hybrid)
-      write(*,*) " hybrid = ", hybrid
-
-      CALL  disvert
-
-      DO ilevel=1,nlevel
-        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-      ENDDO
-
-      DO ilayer=1,nlayer
-        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-      ENDDO
-
-      DO ilayer=1,nlayer
-        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
-     &   /g
-      ENDDO
-
-
-c  profil de temperature au premier appel
-c  --------------------------------------
-      pks=psurf**rcp
-
-c altitude en km dans profile: on divise zlay par 1000
-      tmp1(0)=0.E+0
-      DO ilayer=1,nlayer
-        tmp1(ilayer)=zlay(ilayer)/1000.E+0
-      ENDDO
-
-      call profile(nlayer+1,tmp1,tmp2)
-
-      tsurf=tmp2(0)
-      DO ilayer=1,nlayer
-        temp(ilayer)=tmp2(ilayer)
-      ENDDO
-      
-
-
-! Initialize soil properties and temperature
-! ------------------------------------------
-      volcapa=1.e6 ! volumetric heat capacity
-      DO isoil=1,nsoil
-         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
-         tsoil(isoil)=tsurf  ! soil temperature
-      ENDDO
-
-! Initialize depths
-! -----------------
-      do isoil=0,nsoil-1
-        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
-      enddo
-      do isoil=1,nsoil
-        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
-      enddo
-
-c    Initialisation des traceurs
-c    ---------------------------
-
-      if (photochem.or.callthermos) then
-         write(*,*) 'Especes chimiques initialisees'
-         ! thermo=0: initialisation pour toutes les couches 
-         thermo=0
-         call inichim_newstart(q,psurf,sig,nqmx,lati,long,area,
-     $   thermo,qsurf)
-      endif
-      watercaptag(ngridmx)=.false.
-      
-
-c    Initialisation pour les sorties GRADS dans "g1d.dat" et "g1d.ctl"
-c    ----------------------------------------------------------------
-c    (effectuee avec "writeg1d" a partir de "physiq.F"
-c    ou tout autre subroutine physique, y compris celle ci).
-
-        g1d_nlayer=nlayer
-        g1d_nomfich='g1d.dat'
-        g1d_unitfich=40
-        g1d_nomctl='g1d.ctl'
-        g1d_unitctl=41
-        g1d_premier=.true.
-        g2d_premier=.true.
-
-c  Ecriture de "startfi"
-c  --------------------
-c  (Ce fichier sera aussitot relu au premier
-c   appel de "physiq", mais il est necessaire pour passer
-c   les variables purement physiques a "physiq"...
-
-      call physdem1("startfi.nc",long,lati,nsoilmx,nqmx,
-     .              dtphys,float(day0),
-     .              time,tsurf,tsoil,co2ice,emis,q2,qsurf,
-     .              area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
-c=======================================================================
-c  BOUCLE TEMPORELLE DU MODELE 1D 
-c=======================================================================
-c
-      firstcall=.true.
-      lastcall=.false.
-
-      DO idt=1,ndt
-c        IF (idt.eq.ndt) lastcall=.true.
-        IF (idt.eq.ndt-day_step-1) then       !test
-         lastcall=.true.
-         call solarlong(day*1.0,zls)
-         write(103,*) 'Ls=',zls*180./pi
-         write(103,*) 'Lat=', lati(1)*180./pi
-         write(103,*) 'Tau=', tauvis/700*psurf
-         write(103,*) 'RunEnd - Atmos. Temp. File'
-         write(103,*) 'RunEnd - Atmos. Temp. File'
-         write(104,*) 'Ls=',zls*180./pi
-         write(104,*) 'Lat=', lati(1)
-         write(104,*) 'Tau=', tauvis/700*psurf
-         write(104,*) 'RunEnd - Atmos. Temp. File'
-        ENDIF
-
-c    calcul du geopotentiel 
-c     ~~~~~~~~~~~~~~~~~~~~~
-      DO ilayer=1,nlayer
-        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
-        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
-      ENDDO
-      phi(1)=pks*h(1)*(1.E+0-s(1))
-      DO ilayer=2,nlayer
-         phi(ilayer)=phi(ilayer-1)+
-     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
-     &                  *(s(ilayer-1)-s(ilayer))
-
-      ENDDO
-
-c       appel de la physique
-c       --------------------
-
-      CALL meso_physiq (1,llm,nqmx,
-     ,     firstcall,lastcall,
-     ,     day,time,dtphys,
-     ,     plev,play,phi,
-     ,     u, v,temp, q,  
-     ,     w,
-C - sorties
-     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
-
-c       evolution du vent : modele 1D
-c       -----------------------------
- 
-c       la physique calcule les derivees temporelles de u et v.
-c       on y rajoute betement un effet Coriolis.
-c
-c       DO ilayer=1,nlayer
-c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
-c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
-c       ENDDO
-
-c       Pour certain test : pas de coriolis a l'equateur
-c       if(lati(1).eq.0.) then
-          DO ilayer=1,nlayer
-             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
-             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
-          ENDDO
-c       end if
-c      
-c
-c       Calcul du temps au pas de temps suivant
-c       ---------------------------------------
-        firstcall=.false.
-        time=time+dtphys/daysec
-        IF (time.gt.1.E+0) then
-            time=time-1.E+0
-            day=day+1
-        ENDIF
-
-c       calcul des vitesses et temperature au pas de temps suivant
-c       ----------------------------------------------------------
-
-        DO ilayer=1,nlayer
-           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
-           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
-           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
-        ENDDO
-
-c       calcul des pressions au pas de temps suivant
-c       ----------------------------------------------------------
-
-           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
-           DO ilevel=1,nlevel
-             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-           ENDDO
-           DO ilayer=1,nlayer
-             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-           ENDDO
-
-!       increment tracer values
-        DO iq = 1, nqmx
-          DO ilayer=1,nlayer
-             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
-          ENDDO
-        ENDDO
-
-      ENDDO   ! fin de la boucle temporelle
-
-c    ========================================================
-c    GESTION DES SORTIE
-c    ========================================================
-
-c    fermeture pour conclure les sorties format grads dans "g1d.dat"
-c    et "g1d.ctl" (effectuee avec "writeg1d" a partir de "physiq.F"
-c    ou tout autre subroutine physique, y compris celle ci).
-
-c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
-        CALL endg1d(1,nlayer,zlay/1000.,ndt)
-
-c    ========================================================
-      END
- 
-c***********************************************************************
-c***********************************************************************
-c     Subroutines Bidons utilise seulement en 3D, mais
-c     necessaire a la compilation de testphys1d en 1-D
-
-      subroutine gr_fi_dyn
-      RETURN
-      END
- 
-c***********************************************************************
-c***********************************************************************
-
-#include "../dyn3d/disvert.F"
Index: unk/mesoscale/COMMON_GCM/meso_dustlift.F
===================================================================
--- /trunk/mesoscale/COMMON_GCM/meso_dustlift.F	(revision 46)
+++ 	(revision )
@@ -1,132 +1,0 @@
-      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   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
-      REAL stress_seuil
-      SAVE stress_seuil
-c      DATA stress_seuil/0.0225/   ! stress seuil soulevement (N.m2)
-!****WRF
-!****WRF: additional ASCII file to define dust opacity
-          REAL alpha
-          INTEGER ierr
-          OPEN(99,file='stress.def',status='old',form='formatted'
-     .     ,iostat=ierr)
-          IF(ierr.NE.0) THEN
-             stress_seuil = 0.0225
-             alpha = 1.
-             write(*,*) 'No file stress.def - set ', stress_seuil, alpha
-             !stop
-          ELSE
-             READ(99,*) stress_seuil
-             READ(99,*) alpha
-             write(*,*) 'definir seuil stress : ', stress_seuil, alpha
-             CLOSE(99)
-          ENDIF
-          alpha_lift(1) = alpha
-!****WRF
-!****WRF
-
-
-
-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/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_lift(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: unk/mesoscale/COMMON_GCM/readtesassim.F90
===================================================================
--- /trunk/mesoscale/COMMON_GCM/readtesassim.F90	(revision 46)
+++ 	(revision )
@@ -1,297 +1,0 @@
-subroutine readtesassim(ngrid,nlayer,zday,pplev,tauref)
-
-! Reading of the dust assimilation file
-
-implicit none
-
-#include "dimensions.h"
-#include "dimphys.h"
-#include "comgeomfi.h"
-#include "netcdf.inc"
-#include "datafile.h"
-#include "callkeys.h"
-
-integer, intent(in) :: ngrid,nlayer
-real, intent(in) :: zday ! date in martian days
-real, dimension(ngrid,nlayer+1), intent(in) :: pplev
-real, dimension(ngrid), intent(out) :: tauref
-
-! Local variables
-
-real :: realday
-integer nid,nvarid,ierr
-integer ltloop,lsloop,iloop,jloop,varloop,ig
-real, dimension(2) :: taubuf
-real tau1(4),tau
-real alt(4)
-integer latp(4),lonp(4)
-integer yinf,ysup,xinf,xsup,tinf,tsup
-real latinf,latsup,loninf,lonsup
-real latintmp,lonintmp,latdeg,londeg
-real colat,dlat,dlon,colattmp
-logical, save :: firstcall=.true.
-logical :: timeflag
-real,save :: radeg,pi
-integer :: timedim,londim,latdim
-real, dimension(:), allocatable, save :: lat,lon,time
-real, dimension(:,:,:), allocatable, save :: tautes
-integer, save :: timelen,lonlen,latlen
-character(len=33) :: filename
-
-realday=mod(zday,669.)
-
-if (firstcall) then
-   firstcall=.false.
-
-   pi=acos(-1.)
-   radeg=180/pi
-   
-   ! assimilated dust file: (NB: iaervar is a common in "callkeys.h")
-   ! iaervar=4 means read dust_tes.nc file
-   ! iaervar=24 means read dust_tes_MY24.nc file
-   ! iaervar=25 means read dust_tes_MY25.nc file
-   ! iaervar=26 means read dust_tes_MY26.nc file
-   if (iaervar.eq.4) then
-     filename="dust_tes.nc"
-   else if (iaervar.eq.24) then
-     filename="dust_tes_MY24.nc" ! which currently is identical to dust_tes.nc
-   else if (iaervar.eq.25) then
-     filename="dust_tes_MY25.nc" 
-   else if (iaervar.eq.26) then
-     filename="dust_tes_MY26.nc"
-   else if ((iaervar.eq.6).or.(iaervar.eq.7)) then ! modified TES scenario
-     filename="modifieddust.nc"
-   endif
-   
-   ! Note: datafile() is defined in "datafile.h"
-   ierr=NF_OPEN(trim(datafile)//"/"//trim(filename),NF_NOWRITE,nid)
-   IF (ierr.NE.NF_NOERR) THEN
-     write(*,*)'Problem opening ',trim(filename),' (in phymars/readtesassim.F90)'
-     write(*,*)'It should be in :',trim(datafile),'/'
-     write(*,*)'1) You can change this directory address in '
-     write(*,*)'   file phymars/datafile.h'
-     write(*,*)'2) If necessary, dust.nc (and other datafiles)'
-     write(*,*)'   can be obtained online on:'
-     write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
-     CALL ABORT
-   ENDIF
-
-   ierr=NF_INQ_DIMID(nid,"Time",timedim)
-   ierr=NF_INQ_DIMLEN(nid,timedim,timelen)
-   ierr=NF_INQ_DIMID(nid,"latitude",latdim)
-   ierr=NF_INQ_DIMLEN(nid,latdim,latlen)
-   ierr=NF_INQ_DIMID(nid,"longitude",londim)
-   ierr=NF_INQ_DIMLEN(nid,londim,lonlen)
-
-   allocate(tautes(lonlen,latlen,timelen))
-   allocate(lat(latlen), lon(lonlen), time(timelen))
-
-   ierr = NF_INQ_VARID (nid, "dustop",nvarid)
-#ifdef NC_DOUBLE
-   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tautes)
-#else
-   ierr = NF_GET_VAR_REAL(nid, nvarid, tautes)
-#endif
-   IF (ierr .NE. NF_NOERR) THEN
-      PRINT*, "Error: Readtesassim <dustop> not found"
-      stop
-   ENDIF
-   ierr = NF_INQ_VARID (nid, "Time",nvarid)
-#ifdef NC_DOUBLE
-   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
-#else
-   ierr = NF_GET_VAR_REAL(nid, nvarid, time)
-#endif
-   IF (ierr .NE. NF_NOERR) THEN
-      PRINT*, "Error: Readtesassim <Time> not found"
-      stop
-   ENDIF
-
-   ierr = NF_INQ_VARID (nid, "latitude",nvarid)
-#ifdef NC_DOUBLE
-   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lat)
-#else
-   ierr = NF_GET_VAR_REAL(nid, nvarid, lat)
-#endif
-   IF (ierr .NE. NF_NOERR) THEN
-      PRINT*, "Error: Readtesassim <latitude> not found"
-      stop
-   ENDIF
-
-   ierr = NF_INQ_VARID (nid, "longitude",nvarid)
-#ifdef NC_DOUBLE
-   ierr = NF_GET_VAR_DOUBLE(nid, nvarid, lon)
-#else
-   ierr = NF_GET_VAR_REAL(nid, nvarid, lon)
-#endif
-   IF (ierr .NE. NF_NOERR) THEN
-      PRINT*, "Error: Readtesassim <longitude> not found"
-      stop
-   ENDIF
-
-endif ! of if (firstcall)
-
-do ig=1,ngrid
-
-! Find the four nearest points, arranged as follows:
-!                               1 2
-!                               3 4
-
-   latdeg=lati(ig)*radeg  ! latitude, in degrees
-   londeg=long(ig)*radeg  ! longitude, in degrees east
-   colat=90-latdeg        ! colatitude, in degrees
-
- ! Find encompassing latitudes
-   if (colat<(90-lat(1))) then ! between north pole and lat(1)
-      ysup=1
-      yinf=1
-   else if (colat>=90-(lat(latlen))) then ! between south pole and lat(laten)
-      ysup=latlen
-      yinf=latlen
-   else ! general case
-      do iloop=2,latlen
-         if(colat<(90-lat(iloop))) then
-           ysup=iloop-1
-           yinf=iloop
-           exit
-         endif
-      enddo
-   endif
-
-   latinf=lat(yinf)
-   latsup=lat(ysup)
-
-
- ! Find encompassing longitudes
-   ! Note: in input file, lon(1)=-180.
-   if (londeg>lon(lonlen)) then
-      xsup=1
-      xinf=lonlen
-      loninf=lon(xsup)
-      lonsup=180.0 ! since lon(1)=-180.0
-   else
-      do iloop=2,lonlen
-         if(londeg<lon(iloop)) then
-              xsup=iloop
-              xinf=iloop-1
-              exit
-         endif
-      enddo
-      loninf=lon(xinf)
-      lonsup=lon(xsup)
-   endif
-
-   if ((xsup.gt.lonlen).OR.(yinf.gt.latlen).OR.(xinf.lt.1)&
-     .OR.(ysup.lt.1)) then
-      write (*,*) "Readtesassim: SYSTEM ERROR on x or y in ts_gcm"
-      write (*,*) "xinf: ",xinf
-      write (*,*) "xsup: ",xsup
-      write (*,*) "yinf: ",yinf
-      write (*,*) "ysup: ",ysup
-      stop
-   endif
-
-!   loninf=lon(xinf)
-!   lonsup=lon(xsup)
-!   latinf=lat(yinf)
-!   latsup=lat(ysup)
-
-! The four neighbouring points are arranged as follows:
-!                               1 2
-!                               3 4
-
-   latp(1)=ysup
-   latp(2)=ysup
-   latp(3)=yinf
-   latp(4)=yinf
-
-   lonp(1)=xinf
-   lonp(2)=xsup
-   lonp(3)=xinf
-   lonp(4)=xsup
-
-! Linear interpolation on time, for all four neighbouring points
-
-   if ((realday<time(1)).or.(realday>time(timelen))) then
-      tinf=timelen
-      tsup=1
-      timeflag=.true.
-   else 
-      do iloop=2,timelen
-         if (realday<time(iloop)) then
-            tinf=iloop-1
-            tsup=iloop
-            exit
-         endif
-      enddo
-   endif
-
-! Bilinear interpolation on the four nearest points
-
-   if ((colat<(90-lat(1))).OR.(colat>(90-lat(latlen))).OR.(latsup==latinf)) then
-      dlat=0
-   else
-      dlat=((90-latinf)-colat)/((90-latinf)-(90-latsup))
-   endif
-
-   if (lonsup==loninf) then
-      dlon=0
-   else
-      dlon=(londeg-loninf)/(lonsup-loninf)
-   endif
-
-   do iloop=1,4
-      taubuf(1)=tautes(lonp(iloop),latp(iloop),tinf)
-      taubuf(2)=tautes(lonp(iloop),latp(iloop),tsup)
-      if (timeflag) then
-         if (realday>time(timelen)) then
-            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)+(669-time(tinf))) 
-         else
-            tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*realday/(time(tsup)+(669-time(tinf)))
-         endif
-      else
-         tau1(iloop)=taubuf(1)+(taubuf(2)-taubuf(1))*(realday-time(tinf))/(time(tsup)-time(tinf))
-      endif
-      if (tau1(iloop)<0) then
-          write (*,*) "Readtesassim: SYSTEM ERROR on tau"
-          write (*,*) "utime ",realday
-          write (*,*) "time(tinf) ",time(tinf)
-          write (*,*) "time(tsup) ",time(tsup)
-          write (*,*) "tau1 ",taubuf(1)
-          write (*,*) "tau2 ",taubuf(2)
-          write (*,*) "tau ",tau1(iloop)
-          stop
-      endif
-   enddo
-   timeflag=.false.
-
-   if ((dlat>1).OR.(dlon>1) .OR. (dlat<0) .OR. (dlon<0)) then
-      write (*,*) "Readtesassim: SYSTEM ERROR on dlat or dlon in ts_gcm"
-      write (*,*) "dlat: ",dlat
-      write (*,*) "lat: ",latdeg
-      write (*,*) "dlon: ",dlon
-      write (*,*) "lon: ",londeg
-      stop
-   endif
-
-   tau= dlat*(dlon*(tau1(2)+tau1(3)-tau1(1)-tau1(4))+tau1(1)-tau1(3)) +dlon*(tau1(4)-tau1(3))+tau1(3)
-
-! Multiply by correction coefficient (value depends on SW radiative transfer)
-! NB: swrtype is set in callkeys.h
-   if (swrtype.eq.1) then ! Fouquart 
-     tauref(ig)=tau*0.825
-   else
-     if (swrtype.eq.2) then ! Toon
-       tauref(ig)=tau*1.3
-        ! special case for enhanced flushing storm scenario
-        if ((iaervar.eq.7).and.(tauref(ig).gt.1.1*1.3)) then
-          tauref(ig)=2.0*tauref(ig)
-        endif
-     else
-       write(*,*) "readtesassim: wrong value for flag swrtype !"
-       stop
-     endif
-   endif ! of if (swrtype.eq.1)
-enddo
-
-end
